*IF DEF,CONTROL,AND,DEF,ATMOS,AND,DEF,OCEAN INITA2O1.2
C ******************************COPYRIGHT****************************** GTS2F400.4609
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4610
C GTS2F400.4611
C Use, duplication or disclosure of this code is subject to the GTS2F400.4612
C restrictions as set forth in the contract. GTS2F400.4613
C GTS2F400.4614
C Meteorological Office GTS2F400.4615
C London Road GTS2F400.4616
C BRACKNELL GTS2F400.4617
C Berkshire UK GTS2F400.4618
C RG12 2SZ GTS2F400.4619
C GTS2F400.4620
C If no contract has been raised with this copy of the code, the use, GTS2F400.4621
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4622
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4623
C Modelling at the above address. GTS2F400.4624
C ******************************COPYRIGHT****************************** GTS2F400.4625
C GTS2F400.4626
CLL Routine: INIT_A2O ------------------------------------------------- INITA2O1.3
CLL INITA2O1.4
CLL Purpose: Initialises address pointers needed by SWAP_A2O and INITA2O1.5
CLL SWAP_O2A when running in coupled mode. Subroutine INITA2O1.6
CLL FINDPTR is used, in this instance searching the STASHlist INITA2O1.7
CLL on section/item codes and STASHmacro tagging information. INITA2O1.8
CLL Atmosphere/ocean coupling fields are tagged with a 10 or INITA2O1.9
CLL 11 depending on the sense of the transfer. INITA2O1.10
CLL INITA2O1.11
CLL Tested under compiler: cft77 INITA2O1.12
CLL Tested under OS version: UNICOS 5.1 INITA2O1.13
CLL INITA2O1.14
CLL Author: T.C.Johns INITA2O1.15
CLL INITA2O1.16
CLL Code version no: 1.4 Date: 12 May 1992 INITA2O1.17
CLL INITA2O1.18
CLL Model Modification history from model version 3.0: INITA2O1.19
CLL version date INITA2O1.20
CLL 3.2 18/06/93 : Changes for dynamic allocation (TCJ). @DYALLOC.1339
CLL 3.5 June 95 Submodels project GSS2F305.113
CLL Added internal model to FINDPTR args GSS2F305.114
CLL S.J.Swarbrick GSS2F305.115
CLL 3.5 05/06/95 Chgs to SI array. RTHBarnes GRB4F305.261
CLL 4.2 22/11/96 Chgs to allow uncompressed ocean dumps. SI GSI0F402.1
CLL 4.3 30/01/97 Correction: change local sizes IMT,etc to global GRR0F403.256
CLL domain sizes AOCPL_IMT,etc. R.Rawlins. GRR0F403.257
CLL 4.5 1/07/98 Include code to pass atmospheric surface CO2 CCN1F405.24
CLL C.D.Jones CCN1F405.25
CLL INITA2O1.21
CLL Programming standard: UM Doc Paper 3, version 2 (7/9/90) INITA2O1.22
CLL INITA2O1.23
CLL Logical components covered: C11 INITA2O1.24
CLL INITA2O1.25
CLL Project task: C0 INITA2O1.26
CLL INITA2O1.27
CLL External documentation: INITA2O1.28
CLL Unified Model Doc Paper C0 - The top-level control system INITA2O1.29
CLL INITA2O1.30
CLL ------------------------------------------------------------------- INITA2O1.31
C*L Interface and arguments: ------------------------------------------ INITA2O1.32
C INITA2O1.33
SUBROUTINE INIT_A2O ( 1,19@DYALLOC.1340
*CALL ARGSIZE
@DYALLOC.1341
*CALL ARGD1
@DYALLOC.1342
*CALL ARGSTS
@DYALLOC.1343
*CALL ARGDUMA
@DYALLOC.1344
*CALL ARGDUMO
@DYALLOC.1345
*CALL ARGPTRA
@DYALLOC.1346
*CALL ARGPTRO
@DYALLOC.1347
*CALL ARGAOCPL
@DYALLOC.1348
* ICODE,CMESSAGE ) @DYALLOC.1349
C INITA2O1.35
IMPLICIT NONE INITA2O1.36
C @DYALLOC.1350
*CALL CSUBMODL
GSS2F305.116
*CALL CNTLATM
CCN1F405.26
*CALL TYPSIZE
@DYALLOC.1351
*CALL TYPD1
@DYALLOC.1352
*CALL TYPSTS
@DYALLOC.1353
*CALL TYPDUMA
@DYALLOC.1354
*CALL TYPDUMO
@DYALLOC.1355
*CALL TYPPTRA
@DYALLOC.1356
*CALL TYPPTRO
@DYALLOC.1357
*CALL TYPAOCPL
@DYALLOC.1358
C INITA2O1.37
INTEGER ICODE ! OUT - Error return code INITA2O1.38
CHARACTER*(*) CMESSAGE ! OUT - Error return message INITA2O1.39
C*---------------------------------------------------------------------- INITA2O1.40
C Common blocks INITA2O1.41
C INITA2O1.42
*CALL CAOPTR
@DYALLOC.1359
*CALL C_MDI
INITA2O1.47
*CALL STPARAM
INITA2O1.48
C INITA2O1.49
C Subroutines called INITA2O1.50
C INITA2O1.51
EXTERNAL FINDPTR INITA2O1.52
C INITA2O1.53
C Local variables INITA2O1.54
C INITA2O1.55
INTEGER INITA2O1.56
& PROCESS_CODE, ! Processing code INITA2O1.57
& FREQ_CODE, ! Frequency code INITA2O1.58
& START,END,PERIOD, ! Start, end and period step INITA2O1.59
& GRIDPT_CODE,WEIGHT_CODE, ! Gridpt and weighting codes INITA2O1.60
& BOTTOM_LEVEL,TOP_LEVEL, ! Bottom and top input level INITA2O1.61
& GRID_N,GRID_S,GRID_W,GRID_E, ! Grid corner definitions INITA2O1.62
& STASHMACRO_TAG, ! STASHmacro tag number INITA2O1.63
& I,J ! Working indices INITA2O1.64
& ,IM_IDENT ! internal model identifier GRB4F305.262
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.263
CL---------------------------------------------------------------------- INITA2O1.65
CL 0. Set grid definition information (undefined as search is on INITA2O1.66
CL STASHmacro tag number) INITA2O1.67
CL INITA2O1.68
PROCESS_CODE=IMDI INITA2O1.69
FREQ_CODE=IMDI INITA2O1.70
START=IMDI INITA2O1.71
END=IMDI INITA2O1.72
PERIOD=IMDI INITA2O1.73
GRIDPT_CODE=IMDI INITA2O1.74
WEIGHT_CODE=IMDI INITA2O1.75
BOTTOM_LEVEL=IMDI INITA2O1.76
TOP_LEVEL=IMDI INITA2O1.77
GRID_N=IMDI INITA2O1.78
GRID_S=IMDI INITA2O1.79
GRID_E=IMDI INITA2O1.80
GRID_W=IMDI INITA2O1.81
GRB4F305.264
C Set up internal model identifier and STASH index GRB4F305.265
im_ident = atmos_im GRB4F305.266
im_index = internal_model_index(im_ident) GRB4F305.267
GRB4F305.268
CL---------------------------------------------------------------------- INITA2O1.82
CL 1. Get address for each field from its STASH section/item code INITA2O1.83
CL and STASHmacro tag if a diagnostic, or from its primary pointer INITA2O1.84
CL if prognostic or ancillary field INITA2O1.85
CL Atmosphere -> Ocean (tag=10) INITA2O1.86
CL INITA2O1.87
STASHMACRO_TAG=10 INITA2O1.88
INITA2O1.89
CL 1.1 Surface windstress on atmos grid - x-component INITA2O1.90
CALL FINDPTR
(ATMOS_IM, 3,219, GSS2F305.117
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.92
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.93
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.94
& STASHMACRO_TAG,IMDI,JA_TAUX, @DYALLOC.1360
*CALL ARGSIZE
@DYALLOC.1361
*CALL ARGSTS
@DYALLOC.1362
& ICODE,CMESSAGE) @DYALLOC.1363
IF (JA_TAUX.EQ.0) THEN INITA2O1.98
ICODE=3219 INITA2O1.99
CMESSAGE="INIT_A2O: Coupling field not enabled - taux atmos" INITA2O1.100
ENDIF INITA2O1.101
IF (ICODE.GT.0) GOTO 999 INITA2O1.102
INITA2O1.103
CL 1.2 Surface windstress on ocean grid - x-component INITA2O1.104
JO_TAUX=joc_taux INITA2O1.105
IF (JO_TAUX.EQ.0) THEN INITA2O1.106
ICODE=150 INITA2O1.107
CMESSAGE="INIT_A2O: Coupling field not enabled - taux ocean" INITA2O1.108
ENDIF INITA2O1.109
IF (ICODE.GT.0) GOTO 999 INITA2O1.110
INITA2O1.111
CL 1.3 Surface windstress on atmos grid - y-component INITA2O1.112
CALL FINDPTR
(ATMOS_IM, 3,220, GSS2F305.118
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.114
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.115
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.116
& STASHMACRO_TAG,IMDI,JA_TAUY, @DYALLOC.1364
*CALL ARGSIZE
@DYALLOC.1365
*CALL ARGSTS
@DYALLOC.1366
& ICODE,CMESSAGE) @DYALLOC.1367
IF (JA_TAUY.EQ.0) THEN INITA2O1.120
ICODE=3220 INITA2O1.121
CMESSAGE="INIT_A2O: Coupling field not enabled - tauy atmos" INITA2O1.122
ENDIF INITA2O1.123
IF (ICODE.GT.0) GOTO 999 INITA2O1.124
INITA2O1.125
CL 1.4 Surface windstress on ocean grid - y-component INITA2O1.126
JO_TAUY=joc_tauy INITA2O1.127
IF (JO_TAUY.EQ.0) THEN INITA2O1.128
ICODE=151 INITA2O1.129
CMESSAGE="INIT_A2O: Coupling field not enabled - tauy ocean" INITA2O1.130
ENDIF INITA2O1.131
IF (ICODE.GT.0) GOTO 999 INITA2O1.132
INITA2O1.133
CL 1.5 Windmixing power on atmos grid INITA2O1.134
CALL FINDPTR
(ATMOS_IM, 3,224, GSS2F305.119
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.136
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.137
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.138
& STASHMACRO_TAG,IMDI,JA_WINDMIX, @DYALLOC.1368
*CALL ARGSIZE
@DYALLOC.1369
*CALL ARGSTS
@DYALLOC.1370
& ICODE,CMESSAGE) @DYALLOC.1371
IF (JA_WINDMIX.EQ.0) THEN INITA2O1.142
ICODE=3224 INITA2O1.143
CMESSAGE="INIT_A2O: Coupling field not enabled - Windmixing atm" INITA2O1.144
ENDIF INITA2O1.145
IF (ICODE.GT.0) GOTO 999 INITA2O1.146
INITA2O1.147
CL 1.6 Windmixing power on ocean grid INITA2O1.148
JO_WINDMIX=joc_wme INITA2O1.149
IF (JO_WINDMIX.EQ.0) THEN INITA2O1.150
ICODE=152 INITA2O1.151
CMESSAGE="INIT_A2O: Coupling field not enabled - Windmixing ocn" INITA2O1.152
ENDIF INITA2O1.153
IF (ICODE.GT.0) GOTO 999 INITA2O1.154
INITA2O1.155
CL 1.7 Net integrated downward solar on atmos grid INITA2O1.156
CALL FINDPTR
(ATMOS_IM, 1,203, GSS2F305.120
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.158
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.159
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.160
& STASHMACRO_TAG,IMDI,JA_SOLAR, @DYALLOC.1372
*CALL ARGSIZE
@DYALLOC.1373
*CALL ARGSTS
@DYALLOC.1374
& ICODE,CMESSAGE) @DYALLOC.1375
IF (JA_SOLAR.EQ.0) THEN INITA2O1.164
ICODE=1203 INITA2O1.165
CMESSAGE="INIT_A2O: Coupling field not enabled - Net solar" INITA2O1.166
ENDIF INITA2O1.167
IF (ICODE.GT.0) GOTO 999 INITA2O1.168
INITA2O1.169
CL 1.8 Net downward blueband solar on atmos grid INITA2O1.170
CALL FINDPTR
(ATMOS_IM, 1,204, GSS2F305.121
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.172
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.173
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.174
& STASHMACRO_TAG,IMDI,JA_BLUE, @DYALLOC.1376
*CALL ARGSIZE
@DYALLOC.1377
*CALL ARGSTS
@DYALLOC.1378
& ICODE,CMESSAGE) @DYALLOC.1379
IF (JA_BLUE.EQ.0) THEN INITA2O1.178
ICODE=1204 INITA2O1.179
CMESSAGE="INIT_A2O: Coupling field not enabled - Blue solar atm" INITA2O1.180
ENDIF INITA2O1.181
IF (ICODE.GT.0) GOTO 999 INITA2O1.182
INITA2O1.183
CL 1.9 Net downward blueband solar on ocean grid INITA2O1.184
JO_BLUE=joc_solar INITA2O1.185
IF (JO_BLUE.EQ.0) THEN INITA2O1.186
ICODE=161 INITA2O1.187
CMESSAGE="INIT_A2O: Coupling field not enabled - Blue solar ocn" INITA2O1.188
ENDIF INITA2O1.189
IF (ICODE.GT.0) GOTO 999 INITA2O1.190
INITA2O1.191
CL 1.10 Surface evaporation over sea weighted by fractional leads INITA2O1.192
CALL FINDPTR
(ATMOS_IM, 3,232, GSS2F305.122
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.194
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.195
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.196
& STASHMACRO_TAG,IMDI,JA_EVAP, @DYALLOC.1380
*CALL ARGSIZE
@DYALLOC.1381
*CALL ARGSTS
@DYALLOC.1382
& ICODE,CMESSAGE) @DYALLOC.1383
IF (JA_EVAP.EQ.0) THEN INITA2O1.200
ICODE=3232 INITA2O1.201
CMESSAGE="INIT_A2O: Coupling field not enabled - Evap over sea" INITA2O1.202
ENDIF INITA2O1.203
IF (ICODE.GT.0) GOTO 999 INITA2O1.204
INITA2O1.205
CL 1.11 Net downward longwave on atmos grid INITA2O1.206
CALL FINDPTR
(ATMOS_IM, 2,203, GSS2F305.123
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.208
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.209
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.210
& STASHMACRO_TAG,IMDI,JA_LONGWAVE, @DYALLOC.1384
*CALL ARGSIZE
@DYALLOC.1385
*CALL ARGSTS
@DYALLOC.1386
& ICODE,CMESSAGE) @DYALLOC.1387
IF (JA_LONGWAVE.EQ.0) THEN INITA2O1.214
ICODE=2203 INITA2O1.215
CMESSAGE="INIT_A2O: Coupling field not enabled - Longwave" INITA2O1.216
ENDIF INITA2O1.217
IF (ICODE.GT.0) GOTO 999 INITA2O1.218
INITA2O1.219
CL 1.12 Sensible heat on atmos grid, area mean over open sea INITA2O1.220
CALL FINDPTR
(ATMOS_IM, 3,228, GSS2F305.124
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.222
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.223
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.224
& STASHMACRO_TAG,IMDI,JA_SENSIBLE, @DYALLOC.1388
*CALL ARGSIZE
@DYALLOC.1389
*CALL ARGSTS
@DYALLOC.1390
& ICODE,CMESSAGE) @DYALLOC.1391
IF (JA_SENSIBLE.EQ.0) THEN INITA2O1.228
ICODE=3228 INITA2O1.229
CMESSAGE="INIT_A2O: Coupling field not enabled - Sensible heat" INITA2O1.230
ENDIF INITA2O1.231
IF (ICODE.GT.0) GOTO 999 INITA2O1.232
INITA2O1.233
CL 1.13 Non-penetrative heat flux into ocean INITA2O1.234
JO_HEATFLUX=joc_heat INITA2O1.235
IF (JO_HEATFLUX.EQ.0) THEN INITA2O1.236
ICODE=162 INITA2O1.237
CMESSAGE="INIT_A2O: Coupling field not enabled - Non-pen heat" INITA2O1.238
ENDIF INITA2O1.239
IF (ICODE.GT.0) GOTO 999 INITA2O1.240
INITA2O1.241
CL 1.14 Large-scale snowfall rate on atmos grid INITA2O1.242
CALL FINDPTR
(ATMOS_IM, 4,204, GSS2F305.125
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.244
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.245
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.246
& STASHMACRO_TAG,IMDI,JA_LSSNOW, @DYALLOC.1392
*CALL ARGSIZE
@DYALLOC.1393
*CALL ARGSTS
@DYALLOC.1394
& ICODE,CMESSAGE) @DYALLOC.1395
IF (JA_LSSNOW.EQ.0) THEN INITA2O1.250
ICODE=4204 INITA2O1.251
CMESSAGE="INIT_A2O: Coupling field not enabled - LS Snow" INITA2O1.252
ENDIF INITA2O1.253
IF (ICODE.GT.0) GOTO 999 INITA2O1.254
INITA2O1.255
CL 1.15 Convective snowfall rate on atmos grid INITA2O1.256
CALL FINDPTR
(ATMOS_IM, 5,206, GSS2F305.126
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.258
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.259
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.260
& STASHMACRO_TAG,IMDI,JA_CVSNOW, @DYALLOC.1396
*CALL ARGSIZE
@DYALLOC.1397
*CALL ARGSTS
@DYALLOC.1398
& ICODE,CMESSAGE) @DYALLOC.1399
IF (JA_CVSNOW.EQ.0) THEN INITA2O1.264
ICODE=5206 INITA2O1.265
CMESSAGE="INIT_A2O: Coupling field not enabled - Conv Snow" INITA2O1.266
ENDIF INITA2O1.267
IF (ICODE.GT.0) GOTO 999 INITA2O1.268
INITA2O1.269
CL 1.16 Large-scale rainfall rate on atmos grid INITA2O1.270
CALL FINDPTR
(ATMOS_IM, 4,203, GSS2F305.127
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.272
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.273
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.274
& STASHMACRO_TAG,IMDI,JA_LSRAIN, @DYALLOC.1400
*CALL ARGSIZE
@DYALLOC.1401
*CALL ARGSTS
@DYALLOC.1402
& ICODE,CMESSAGE) @DYALLOC.1403
IF (JA_LSRAIN.EQ.0) THEN INITA2O1.278
ICODE=4203 INITA2O1.279
CMESSAGE="INIT_A2O: Coupling field not enabled - LS Rain" INITA2O1.280
ENDIF INITA2O1.281
IF (ICODE.GT.0) GOTO 999 INITA2O1.282
INITA2O1.283
CL 1.17 Convective rainfall rate on atmos grid INITA2O1.284
CALL FINDPTR
(ATMOS_IM, 5,205, GSS2F305.128
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.286
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.287
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.288
& STASHMACRO_TAG,IMDI,JA_CVRAIN, @DYALLOC.1404
*CALL ARGSIZE
@DYALLOC.1405
*CALL ARGSTS
@DYALLOC.1406
& ICODE,CMESSAGE) @DYALLOC.1407
IF (JA_CVRAIN.EQ.0) THEN INITA2O1.292
ICODE=5205 INITA2O1.293
CMESSAGE="INIT_A2O: Coupling field not enabled - Conv Rain" INITA2O1.294
ENDIF INITA2O1.295
IF (ICODE.GT.0) GOTO 999 INITA2O1.296
INITA2O1.297
CL 1.18 Net precipitation-evaporation rate on ocean grid INITA2O1.298
JO_PMINUSE=joc_ple INITA2O1.299
IF (JO_PMINUSE.EQ.0) THEN INITA2O1.300
ICODE=165 INITA2O1.301
CMESSAGE="INIT_A2O: Coupling field not enabled - P minus E" INITA2O1.302
ENDIF INITA2O1.303
IF (ICODE.GT.0) GOTO 999 INITA2O1.304
INITA2O1.305
INITA2O1.306
*IF DEF,SEAICE INITA2O1.307
INITA2O1.308
CL 1.19 Seaice fractional conc. on atmos grid - this is an ancillary INITA2O1.309
CL field in atmosphere-only configuration so use primary pointer. INITA2O1.310
INITA2O1.311
JA_AICE=JICE_FRACTION INITA2O1.312
IF (JA_AICE.EQ.0) THEN INITA2O1.313
CMESSAGE="INIT_A2O: Coupling field not enabled - Seaice conc." INITA2O1.314
ENDIF INITA2O1.315
IF (ICODE.GT.0) GOTO 999 INITA2O1.316
INITA2O1.317
CL 1.20 Sublimation on atmos grid INITA2O1.318
INITA2O1.319
STASHMACRO_TAG=10 INITA2O1.320
CALL FINDPTR
(ATMOS_IM, 3,231, GSS2F305.129
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.322
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.323
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.324
& STASHMACRO_TAG,IMDI,JA_SUBLIM, @DYALLOC.1408
*CALL ARGSIZE
@DYALLOC.1409
*CALL ARGSTS
@DYALLOC.1410
& ICODE,CMESSAGE) @DYALLOC.1411
IF (JA_SUBLIM.EQ.0) THEN INITA2O1.328
ICODE=3231 INITA2O1.329
CMESSAGE="INIT_A2O: Coupling field not enabled - Sublimation" INITA2O1.330
ENDIF INITA2O1.331
IF (ICODE.GT.0) GOTO 999 INITA2O1.332
INITA2O1.333
CL 1.21 BOTMELT on atmos grid INITA2O1.334
CALL FINDPTR
(ATMOS_IM, 3,201, GSS2F305.130
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.336
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.337
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.338
& STASHMACRO_TAG,IMDI,JA_BOTMELT, @DYALLOC.1412
*CALL ARGSIZE
@DYALLOC.1413
*CALL ARGSTS
@DYALLOC.1414
& ICODE,CMESSAGE) @DYALLOC.1415
IF (JA_BOTMELT.EQ.0) THEN INITA2O1.342
ICODE=3201 INITA2O1.343
CMESSAGE="INIT_A2O: Coupling field not enabled - BOTMELT" INITA2O1.344
ENDIF INITA2O1.345
IF (ICODE.GT.0) GOTO 999 INITA2O1.346
INITA2O1.347
CL 1.22 TOPMELT on atmos grid INITA2O1.348
CALL FINDPTR
(ATMOS_IM, 3,235, GSS2F305.131
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.350
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.351
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.352
& STASHMACRO_TAG,IMDI,JA_TOPMELT, @DYALLOC.1416
*CALL ARGSIZE
@DYALLOC.1417
*CALL ARGSTS
@DYALLOC.1418
& ICODE,CMESSAGE) @DYALLOC.1419
IF (JA_TOPMELT.EQ.0) THEN INITA2O1.356
ICODE=3235 INITA2O1.357
CMESSAGE="INIT_A2O: Coupling field not enabled - TOPMELT" INITA2O1.358
ENDIF INITA2O1.359
IF (ICODE.GT.0) GOTO 999 INITA2O1.360
INITA2O1.361
CL 1.23 Snowfall rate on ocean grid INITA2O1.362
JO_SNOWFALL=joc_snowrate INITA2O1.363
IF (JO_SNOWFALL.EQ.0) THEN INITA2O1.364
ICODE=171 INITA2O1.365
CMESSAGE="INIT_A2O: Coupling field not enabled - Snowfall rate" INITA2O1.366
ENDIF INITA2O1.367
IF (ICODE.GT.0) GOTO 999 INITA2O1.368
INITA2O1.369
CL 1.24 Sublimation rate on ocean grid INITA2O1.370
JO_SUBLIM=joc_sublim INITA2O1.371
IF (JO_SUBLIM.EQ.0) THEN INITA2O1.372
ICODE=172 INITA2O1.373
CMESSAGE="INIT_A2O: Coupling field not enabled - Sublim rate" INITA2O1.374
ENDIF INITA2O1.375
IF (ICODE.GT.0) GOTO 999 INITA2O1.376
INITA2O1.377
CL 1.25 Diffusive heatflux through ice on ocean grid INITA2O1.378
JO_BOTMELT=joc_botmelt INITA2O1.379
IF (JO_BOTMELT.EQ.0) THEN INITA2O1.380
ICODE=191 INITA2O1.381
CMESSAGE="INIT_A2O: Coupling field not enabled - BOTMELT" INITA2O1.382
ENDIF INITA2O1.383
IF (ICODE.GT.0) GOTO 999 INITA2O1.384
INITA2O1.385
CL 1.26 Top melting heat flux on ocean grid INITA2O1.386
JO_TOPMELT=joc_topmelt INITA2O1.387
IF (JO_TOPMELT.EQ.0) THEN INITA2O1.388
ICODE=190 INITA2O1.389
CMESSAGE="INIT_A2O: Coupling field not enabled - TOPMELT" INITA2O1.390
ENDIF INITA2O1.391
IF (ICODE.GT.0) GOTO 999 INITA2O1.392
INITA2O1.393
*ENDIF INITA2O1.394
*IF DEF,RIVERS INITA2O1.395
INITA2O1.396
CL 1.27 SLOW runoff on atmos grid INITA2O1.397
CALL FINDPTR
(ATMOS_IM, 8,205, GSS2F305.132
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.399
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.400
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.401
& STASHMACRO_TAG,IMDI,JA_SLOWRUNOFF, @DYALLOC.1420
*CALL ARGSIZE
@DYALLOC.1421
*CALL ARGSTS
@DYALLOC.1422
& ICODE,CMESSAGE) @DYALLOC.1423
IF (JA_SLOWRUNOFF.EQ.0) THEN INITA2O1.405
ICODE=8205 INITA2O1.406
CMESSAGE="INIT_A2O: Coupling field not enabled - SLOW runoff" INITA2O1.407
ENDIF INITA2O1.408
IF (ICODE.GT.0) GOTO 999 INITA2O1.409
INITA2O1.410
CL 1.28 FAST runoff on atmos grid INITA2O1.411
CALL FINDPTR
(ATMOS_IM, 8,204, GSS2F305.133
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, INITA2O1.413
& GRIDPT_CODE,WEIGHT_CODE, INITA2O1.414
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, INITA2O1.415
& STASHMACRO_TAG,IMDI,JA_FASTRUNOFF, @DYALLOC.1424
*CALL ARGSIZE
@DYALLOC.1425
*CALL ARGSTS
@DYALLOC.1426
& ICODE,CMESSAGE) @DYALLOC.1427
IF (JA_FASTRUNOFF.EQ.0) THEN INITA2O1.419
ICODE=8204 INITA2O1.420
CMESSAGE="INIT_A2O: Coupling field not enabled - FAST runoff" INITA2O1.421
ENDIF INITA2O1.422
IF (ICODE.GT.0) GOTO 999 INITA2O1.423
INITA2O1.424
CL 1.29 Ocean entry point index field (primary data field) INITA2O1.425
JA_OCENTPTS=SI(93,0,im_index) GRB4F305.269
IF (JA_OCENTPTS.EQ.0) THEN INITA2O1.427
ICODE=93 INITA2O1.428
CMESSAGE="INIT_A2O: Coupling field not enabled - OC entry pts" INITA2O1.429
ENDIF INITA2O1.430
IF (ICODE.GT.0) GOTO 999 INITA2O1.431
INITA2O1.432
CL 1.30 Total river outflow on ocean grid INITA2O1.433
JO_RIVEROUT=joc_river INITA2O1.434
IF (JO_RIVEROUT.EQ.0) THEN INITA2O1.435
ICODE=166 INITA2O1.436
CMESSAGE="INIT_A2O: Coupling field not enabled - river outflow" INITA2O1.437
ENDIF INITA2O1.438
IF (ICODE.GT.0) GOTO 999 INITA2O1.439
INITA2O1.440
*ENDIF INITA2O1.441
IF (L_CO2_INTERACTIVE) THEN CCN1F405.27
CL 1.31 Atmospheric level 1 CO2 concentration CCN1F405.28
CALL FINDPTR
(ATMOS_IM, 0,252, CCN1F405.29
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, CCN1F405.30
& GRIDPT_CODE,WEIGHT_CODE, CCN1F405.31
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, CCN1F405.32
& STASHMACRO_TAG,IMDI,JA_co2, CCN1F405.33
*CALL ARGSIZE
CCN1F405.34
*CALL ARGSTS
CCN1F405.35
& ICODE,CMESSAGE) CCN1F405.36
CCN1F405.37
IF (JA_co2.EQ.0) THEN CCN1F405.38
ICODE=252 CCN1F405.39
CMESSAGE="INIT_A2O: Coupling field not enabled - CO2 atmos" CCN1F405.40
ENDIF CCN1F405.41
IF (ICODE.GT.0) GOTO 999 CCN1F405.42
CCN1F405.43
CL 1.32 Atmospheric level 1 CO2 concentration CCN1F405.44
JO_co2=joc_atmco2 CCN1F405.45
CCN1F405.46
IF (JO_co2.EQ.0) THEN CCN1F405.47
ICODE=200 CCN1F405.48
CMESSAGE="INIT_A2O: Coupling field not enabled - CO2 ocean" CCN1F405.49
ENDIF CCN1F405.50
IF (ICODE.GT.0) GOTO 999 CCN1F405.51
ENDIF CCN1F405.52
INITA2O1.442
CL---------------------------------------------------------------------- INITA2O1.443
CL 2. Ocean -> Atmosphere (tag=11) INITA2O1.444
CL INITA2O1.445
STASHMACRO_TAG=11 INITA2O1.446
INITA2O1.447
CL 2.1 Surface temp on atmos grid INITA2O1.448
JA_TSTAR=JTSTAR INITA2O1.449
IF (JA_TSTAR.EQ.0) THEN INITA2O1.450
ICODE=24 INITA2O1.451
CMESSAGE="INIT_A2O: Coupling field not enabled - SST atmos" INITA2O1.452
ENDIF INITA2O1.453
IF (ICODE.GT.0) GOTO 999 INITA2O1.454
INITA2O1.455
CL Surface temp on ocean grid GSI0F402.2
JO_TSTAR=JOC_TRACER(1,2) GSI0F402.3
IF (JO_TSTAR.EQ.0) THEN GSI0F402.4
ICODE=101 GSI0F402.5
CMESSAGE="INIT_A2O: Coupling field not enabled - SST ocean" GSI0F402.6
ENDIF GSI0F402.7
IF (ICODE.GT.0) GOTO 999 GSI0F402.8
GSI0F402.9
CL 2.2 Surface zonal current on atmos grid INITA2O1.456
JA_UCURR=JU_SEA INITA2O1.457
IF (JA_UCURR.EQ.0) THEN INITA2O1.458
ICODE=28 INITA2O1.459
CMESSAGE="INIT_A2O: Coupling field not enabled - U-curr atmos" INITA2O1.460
ENDIF INITA2O1.461
IF (ICODE.GT.0) GOTO 999 INITA2O1.462
INITA2O1.463
CL Surface zonal current on ocean grid GSI0F402.10
JO_UCURR=JOC_U(2) GSI0F402.11
IF (JO_UCURR.EQ.0) THEN GSI0F402.12
ICODE=121 GSI0F402.13
CMESSAGE="INIT_A2O: Coupling field not enabled - U-curr ocean" GSI0F402.14
ENDIF GSI0F402.15
IF (ICODE.GT.0) GOTO 999 GSI0F402.16
GSI0F402.17
CL 2.3 Surface meridional current on atmos grid INITA2O1.464
JA_VCURR=JV_SEA INITA2O1.465
IF (JA_VCURR.EQ.0) THEN INITA2O1.466
ICODE=29 INITA2O1.467
CMESSAGE="INIT_A2O: Coupling field not enabled - V-curr atmos" INITA2O1.468
ENDIF GSI0F402.18
IF (ICODE.GT.0) GOTO 999 GSI0F402.19
GSI0F402.20
CL Surface meridional current on ocean grid GSI0F402.21
JO_VCURR=JOC_V(2) GSI0F402.22
IF (JO_VCURR.EQ.0) THEN GSI0F402.23
ICODE=122 GSI0F402.24
CMESSAGE="INIT_A2O: Coupling field not enabled - V-curr ocean" GSI0F402.25
ENDIF INITA2O1.469
IF (ICODE.GT.0) GOTO 999 INITA2O1.470
INITA2O1.471
*IF DEF,SEAICE INITA2O1.472
INITA2O1.473
CL 2.4 Seaice conc. on ocean grid INITA2O1.474
JO_AICE=joc_icecon INITA2O1.475
IF (JO_AICE.EQ.0) THEN INITA2O1.476
ICODE=146 INITA2O1.477
CMESSAGE="INIT_A2O: Coupling field not enabled - seaice ocean" INITA2O1.478
ENDIF INITA2O1.479
IF (ICODE.GT.0) GOTO 999 INITA2O1.480
INITA2O1.481
CL 2.5 Ice depth on ocean grid INITA2O1.482
JO_ICEDEPTH=joc_icedep INITA2O1.483
IF (JO_ICEDEPTH.EQ.0) THEN INITA2O1.484
ICODE=147 INITA2O1.485
CMESSAGE="INIT_A2O: Coupling field not enabled - icedepth ocean" INITA2O1.486
ENDIF INITA2O1.487
IF (ICODE.GT.0) GOTO 999 INITA2O1.488
INITA2O1.489
CL 2.6 Ice depth on atmos grid INITA2O1.490
JA_ICEDEPTH=JICE_THICKNESS INITA2O1.491
IF (JA_ICEDEPTH.EQ.0) THEN INITA2O1.492
ICODE=32 INITA2O1.493
CMESSAGE="INIT_A2O: Coupling field not enabled - icedepth atmos" INITA2O1.494
ENDIF INITA2O1.495
IF (ICODE.GT.0) GOTO 999 INITA2O1.496
INITA2O1.497
CL 2.7 Snow depth on ocean grid INITA2O1.498
JO_SNOWDEPTH=joc_snow INITA2O1.499
IF (JO_SNOWDEPTH.EQ.0) THEN INITA2O1.500
ICODE=141 INITA2O1.501
CMESSAGE="INIT_A2O: Coupling field not enabled - snodepth ocean" INITA2O1.502
ENDIF INITA2O1.503
IF (ICODE.GT.0) GOTO 999 INITA2O1.504
INITA2O1.505
CL 2.8 Snow depth on atmos grid INITA2O1.506
JA_SNOWDEPTH=JSNODEP INITA2O1.507
IF (JA_SNOWDEPTH.EQ.0) THEN INITA2O1.508
ICODE=23 INITA2O1.509
CMESSAGE="INIT_A2O: Coupling field not enabled - snodepth atmos" INITA2O1.510
ENDIF INITA2O1.511
IF (ICODE.GT.0) GOTO 999 INITA2O1.512
INITA2O1.513
*ENDIF INITA2O1.514
IF (L_CO2_INTERACTIVE) THEN CCN1F405.53
CL 2.9 Ocean CO2 flux on ocean grid CCN1F405.54
CALL FINDPTR
(OCEAN_IM, 30,249, CCN1F405.55
& PROCESS_CODE,FREQ_CODE,START,END,PERIOD, CCN1F405.56
& GRIDPT_CODE,WEIGHT_CODE, CCN1F405.57
& BOTTOM_LEVEL,TOP_LEVEL,GRID_N,GRID_S,GRID_W,GRID_E, CCN1F405.58
& STASHMACRO_TAG,IMDI,JO_co2flux, CCN1F405.59
*CALL ARGSIZE
CCN1F405.60
*CALL ARGSTS
CCN1F405.61
& ICODE,CMESSAGE) CCN1F405.62
IF (JO_co2flux.EQ.0) THEN CCN1F405.63
ICODE=30249 CCN1F405.64
CMESSAGE="INIT_A2O: Coupling field not enabled - co2flx, ocn" CCN1F405.65
ENDIF CCN1F405.66
IF (ICODE.GT.0) GOTO 999 CCN1F405.67
CCN1F405.68
CL Ocean CO2 flux on atmos grid CCN1F405.69
JA_co2flux=J_CO2FLUX CCN1F405.70
IF (JA_co2flux.EQ.0) THEN CCN1F405.71
ICODE=250 CCN1F405.72
CMESSAGE="INIT_A2O: Coupling field not enabled - co2flx, atm" CCN1F405.73
ENDIF CCN1F405.74
IF (ICODE.GT.0) GOTO 999 CCN1F405.75
ENDIF CCN1F405.76
*IF DEF,TRANGRID INITA2O1.515
C INITA2O1.516
CL---------------------------------------------------------------------- INITA2O1.517
CL 3. Calculate gridline coordinates on all grids using dump INITA2O1.518
CL information on grid spacing and position INITA2O1.519
C INITA2O1.520
IF (GLOBAL_OCEAN.AND..NOT.CYCLIC_OCEAN) THEN INITA2O1.521
ICODE=24 INITA2O1.522
CMESSAGE='INIT_A2O: A coupled global ocean must be cyclic' INITA2O1.523
GOTO 999 INITA2O1.524
ELSEIF (.NOT.GLOBAL_OCEAN.AND.CYCLIC_OCEAN) THEN INITA2O1.525
ICODE=25 INITA2O1.526
CMESSAGE='INIT_A2O: ' INITA2O1.527
& //'A coupled limited-area ocean must not be cyclic' INITA2O1.528
GOTO 999 INITA2O1.529
ENDIF INITA2O1.530
IF (A_REALHD(5).NE.O_REALHD(5).OR.A_REALHD(6).NE.O_REALHD(6)) INITA2O1.531
&THEN INITA2O1.532
ICODE=26 INITA2O1.533
CMESSAGE='INIT_A2O: ' INITA2O1.534
& //'Coupled atmosphere and ocean must have coincident poles' INITA2O1.535
GOTO 999 INITA2O1.536
ENDIF INITA2O1.537
IF (L_CO2_INTERACTIVE) THEN CCN1F405.77
ICODE=27 CCN1F405.78
CMESSAGE = "INIT_A2O: wrong grids for CO2 passing" CCN1F405.79
ENDIF CCN1F405.80
*IF -DEF,GLOBAL INITA2O1.538
ICODE=26 INITA2O1.539
CMESSAGE='INIT_A2O: A coupled atmosphere must be global' INITA2O1.540
GOTO 999 INITA2O1.541
*ENDIF INITA2O1.542
IF (L_CO2_INTERACTIVE.AND..NOT.CYCLIC_OCEAN) THEN CCN1F405.81
ICODE=28 CCN1F405.82
CMESSAGE = "INIT_A2O: CO2 coupling requires a cyclic ocean" CCN1F405.83
ENDIF CCN1F405.84
C *** The global alternative can be removed when we are sure that the INITA2O1.543
C *** ocean dump headers have been correctly created INITA2O1.544
IF (GLOBAL_OCEAN) THEN INITA2O1.545
XUO(1)=O_REALHD(4)+0.5*O_REALHD(1) INITA2O1.546
ELSE INITA2O1.547
XUO(1)=O_REALHD(8) INITA2O1.548
ENDIF INITA2O1.549
XUO(0)=XUO(1)-O_COLDEPC(1) INITA2O1.550
XTO(1)=XUO(1)-0.5*O_COLDEPC(1) INITA2O1.551
DO I=2,AOCPL_IMT GRR0F403.258
XUO(I)=XUO(I-1)+O_COLDEPC(I) INITA2O1.553
XTO(I)=XTO(I-1)+0.5*(O_COLDEPC(I-1)+O_COLDEPC(I)) INITA2O1.554
ENDDO INITA2O1.555
YUO(1)=O_REALHD(7) INITA2O1.556
YUO(0)=YUO(1)-O_ROWDEPC(1) INITA2O1.557
YTO(1)=YUO(1)-0.5*O_ROWDEPC(1) INITA2O1.558
DO J=2,AOCPL_JMT GRR0F403.259
YUO(J)=YUO(J-1)+O_ROWDEPC(J) INITA2O1.560
YTO(J)=YTO(J-1)+0.5*(O_ROWDEPC(J-1)+O_ROWDEPC(J)) INITA2O1.561
ENDDO INITA2O1.562
XUA(0)=A_REALHD(4)-0.5*A_REALHD(1) INITA2O1.563
DO I=1,AOCPL_ROW_LENGTH GRR0F403.260
XTA(I)=A_REALHD(4)+(I-1)*A_REALHD(1) INITA2O1.565
XUA(I)=A_REALHD(4)+(I-0.5)*A_REALHD(1) INITA2O1.566
ENDDO INITA2O1.567
XTA(AOCPL_ROW_LENGTH+1)=A_REALHD(4)+AOCPL_ROW_LENGTH*A_REALHD(1) GRR0F403.261
DO J=1,AOCPL_P_ROWS GRR0F403.262
YTA(J)=A_REALHD(3)-(J-1)*A_REALHD(2) INITA2O1.570
ENDDO INITA2O1.571
DO J=0,AOCPL_P_ROWS GRR0F403.263
YUA(J)=A_REALHD(3)-(J-0.5)*A_REALHD(2) INITA2O1.573
ENDDO INITA2O1.574
*ENDIF INITA2O1.575
C INITA2O1.576
999 CONTINUE INITA2O1.577
RETURN INITA2O1.578
CL---------------------------------------------------------------------- INITA2O1.579
END INITA2O1.580
*ENDIF INITA2O1.581