SUBROUTINE INITTRAC( 1,18INITTRAC.42
*CALL ARGSIZE 
INITTRAC.43
*CALL ARGD1 INITTRAC.44
*CALL ARGDUMO INITTRAC.45
*CALL ARGPTRO INITTRAC.46
*CALL ARGOINDX INITTRAC.47
& LABS,NDISKB,NDISK,NDISKA,FKMP,FKMQ INITTRAC.48
& , TX,TBX,TMX,TBMX,TPX,TBPX INITTRAC.49
&, TPPX, TBPPX, L_OBIMOM, L_OBIHARMGM OOM3F405.215
& , NBLOCK,JROWS INITTRAC.50
& ) INITTRAC.51
INITTRAC.52
IMPLICIT NONE INITTRAC.53
INITTRAC.54
*CALL TYPSIZE INITTRAC.55
*CALL TYPD1 INITTRAC.56
*CALL TYPDUMO INITTRAC.57
*CALL TYPPTRO INITTRAC.58
*CALL TYPOINDX INITTRAC.59
INITTRAC.60
! Variables passed into this subroutine INITTRAC.61
INTEGER NDISKB, NDISKA, NDISK INITTRAC.62
& ,LABS(3),NBLOCK,JROWS INITTRAC.63
LOGICAL L_OBIMOM ! biharmonic momentum diffusion OOM3F405.216
&, L_OBIHARMGM ! biharmonic GM diffusion OOM3F405.217
INITTRAC.64
REAL FKMP(IMT,JMT) INITTRAC.65
& ,FKMQ(IMT,JMT) INITTRAC.66
INITTRAC.67
! Variables passed out of this subroutine INITTRAC.68
REAL TX(NSLAB,NBLOCK ) ! Initial values for T INITTRAC.69
& ,TBX(NSLAB,NBLOCK) ! Initial values for TB INITTRAC.70
& ,TMX(NSLAB,NBLOCK) ! Initial values for TM INITTRAC.71
& ,TBMX(NSLAB,NBLOCK)! Initial values for TBM INITTRAC.72
& ,TPX(NSLAB,NBLOCK) ! Initial values for TP at JFIN+1 INITTRAC.73
& ,TBPX(NSLAB,NBLOCK)! Initial values for TBP at JFIN+1 INITTRAC.74
& ,TPPX(NSLAB,NBLOCK) ! Initial values for TPP at JFIN+2 OOM3F405.218
& ,TBPPX(NSLAB,NBLOCK)! Initial values for TBPP at JFIN+2 OOM3F405.219
& ,TPASS(NSLAB,NBLOCK) ! Temporary variable for message passing INITTRAC.75
INITTRAC.76
! Variables local to this subroutine INITTRAC.77
INTEGER I,IBLOCK,JIND,PE_SEND,PE_RECV,INFO INITTRAC.78
&, J_FROM_COMP ! Starting J index for block of rows OSI1F405.79
INITTRAC.79
*IF DEF,MPP INITTRAC.80
INITTRAC.81
! We must set up TX, TBX, TMX and TBMX for the INITTRAC.82
! pe deailing with row 1 - this is the only proc which INITTRAC.83
! reads data from its own domain. INITTRAC.84
IF (JST.EQ.1) THEN INITTRAC.85
JIND = 1 OSI1F405.78
CALL UMREAD( INITTRAC.87
*CALL ARGSIZE INITTRAC.88
*CALL ARGD1 INITTRAC.89
*CALL ARGDUMO INITTRAC.90
*CALL ARGPTRO INITTRAC.91
& LABS(NDISK),JIND+1,TX INITTRAC.92
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.93
CALL UMREAD( INITTRAC.94
*CALL ARGSIZE INITTRAC.95
*CALL ARGD1 INITTRAC.96
*CALL ARGDUMO INITTRAC.97
*CALL ARGPTRO INITTRAC.98
& LABS(NDISKB),JIND+1,TBX INITTRAC.99
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.100
CALL UMREAD( INITTRAC.101
*CALL ARGSIZE INITTRAC.102
*CALL ARGD1 INITTRAC.103
*CALL ARGDUMO INITTRAC.104
*CALL ARGPTRO INITTRAC.105
& LABS(NDISK),JIND,TMX INITTRAC.106
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.107
CALL UMREAD( INITTRAC.108
*CALL ARGSIZE INITTRAC.109
*CALL ARGD1 INITTRAC.110
*CALL ARGDUMO INITTRAC.111
*CALL ARGPTRO INITTRAC.112
& LABS(NDISKB),JIND,TBMX INITTRAC.113
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.114
ENDIF ! If this is the PE dealing with the first model row. INITTRAC.115
INITTRAC.116
! If this PE's last row is less than JMT_GLOBAL, then read the informati INITTRAC.117
! from it and send to the process that's expecting it. INITTRAC.118
IF (J_PE_JFINP1.GE.0) THEN INITTRAC.119
INITTRAC.120
JIND=J_JMT INITTRAC.121
INITTRAC.122
CALL UMREAD( INITTRAC.123
*CALL ARGSIZE INITTRAC.124
*CALL ARGD1 INITTRAC.125
*CALL ARGDUMO INITTRAC.126
*CALL ARGPTRO INITTRAC.127
& LABS(NDISK),JIND,TPASS INITTRAC.128
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.129
INITTRAC.130
! Now send the info to the PE which needs it: INITTRAC.131
PE_RECV = J_PE_JFINP1 INITTRAC.132
CALL GC_RSEND(3001,NSLAB,PE_RECV,INFO,TX,TPASS) INITTRAC.133
ENDIF INITTRAC.134
INITTRAC.135
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.349
IF (J_PE_JSTM1.GE.0) THEN INITTRAC.136
! We're expecting to receive a message: INITTRAC.137
PE_SEND = J_PE_JSTM1 INITTRAC.138
CALL GC_RRECV (3001,NSLAB,PE_SEND,INFO,TX,TPASS) INITTRAC.139
ENDIF INITTRAC.140
INITTRAC.141
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.350
IF (J_PE_JFINP1.GE.0) THEN INITTRAC.142
JIND=J_JMT INITTRAC.143
INITTRAC.144
CALL UMREAD( INITTRAC.145
*CALL ARGSIZE INITTRAC.146
*CALL ARGD1 INITTRAC.147
*CALL ARGDUMO INITTRAC.148
*CALL ARGPTRO INITTRAC.149
& LABS(NDISKB),JIND,TPASS INITTRAC.150
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.151
INITTRAC.152
INITTRAC.153
! Now send the info to the PE which needs it: INITTRAC.154
PE_RECV = J_PE_JFINP1 INITTRAC.155
CALL GC_RSEND(3002,NSLAB,PE_RECV,INFO,TBX,TPASS) INITTRAC.156
ENDIF INITTRAC.157
INITTRAC.158
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.351
IF (J_PE_JSTM1.GE.0) THEN INITTRAC.159
! We're expecting to receive a message: INITTRAC.160
PE_SEND = J_PE_JSTM1 INITTRAC.161
CALL GC_RRECV (3002,NSLAB,PE_SEND,INFO,TBX,TPASS) INITTRAC.162
INITTRAC.163
ENDIF INITTRAC.164
! Get tracers for JST - 2 at current timestep INITTRAC.165
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.352
INITTRAC.166
IF (J_PE_JFINP2.GE.0) THEN INITTRAC.167
IF ((JFIN-JST+1).GE.2) THEN INITTRAC.168
! If there is more than 1 row for this PE then only INITTRAC.169
! the last but 1 row is sent. INITTRAC.170
JIND = J_JMT-1 INITTRAC.171
ELSE INITTRAC.172
! otherwise, we send the one and only row INITTRAC.173
JIND = J_JMT INITTRAC.174
ENDIF INITTRAC.175
INITTRAC.176
CALL UMREAD( INITTRAC.177
*CALL ARGSIZE INITTRAC.178
*CALL ARGD1 INITTRAC.179
*CALL ARGDUMO INITTRAC.180
*CALL ARGPTRO INITTRAC.181
& LABS(NDISK),JIND,TPASS INITTRAC.182
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.183
INITTRAC.184
! Now send the info to the PE which needs it: INITTRAC.185
PE_RECV = J_PE_JFINP2 INITTRAC.186
CALL GC_RSEND(3003,NSLAB,PE_RECV,INFO,TMX,TPASS) INITTRAC.187
ENDIF INITTRAC.188
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.353
IF (J_PE_JSTM2.GE.0) THEN INITTRAC.189
! We're expecting to receive a message: INITTRAC.190
PE_SEND = J_PE_JSTM2 INITTRAC.191
CALL GC_RRECV (3003,NSLAB,PE_SEND,INFO,TMX,TPASS) INITTRAC.192
ENDIF INITTRAC.193
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.354
INITTRAC.194
IF (J_PE_JFINP2.GE.0) THEN INITTRAC.195
IF ((JFIN-JST+1).GE.2) THEN INITTRAC.196
! If there is more than 1 row for this PE then only INITTRAC.197
! the last but 1 row is sent. INITTRAC.198
JIND = J_JMT-1 INITTRAC.199
ELSE INITTRAC.200
! Otherwise, we send the one and only row INITTRAC.201
JIND = J_JMT INITTRAC.202
ENDIF INITTRAC.203
INITTRAC.204
CALL UMREAD( INITTRAC.205
*CALL ARGSIZE INITTRAC.206
*CALL ARGD1 INITTRAC.207
*CALL ARGDUMO INITTRAC.208
*CALL ARGPTRO INITTRAC.209
& LABS(NDISKB),JIND,TPASS INITTRAC.210
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.211
! Now send the info to the PE which needs it: INITTRAC.212
PE_RECV = J_PE_JFINP2 INITTRAC.213
CALL GC_RSEND(3004,NSLAB,PE_RECV,INFO,TBMX,TPASS) INITTRAC.214
ENDIF INITTRAC.215
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.355
IF (J_PE_JSTM2.GE.0) THEN INITTRAC.216
! We're expecting to receive a message: INITTRAC.217
PE_SEND = J_PE_JSTM2 INITTRAC.218
CALL GC_RRECV (3004,NSLAB,PE_SEND,INFO,TBMX,TPASS) INITTRAC.219
ENDIF INITTRAC.220
INITTRAC.221
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.356
INITTRAC.222
IF (J_PE_JSTM1.GE.0) THEN INITTRAC.223
INITTRAC.224
! we pass the first row one PE backwards. INITTRAC.225
JIND = J_1 INITTRAC.226
INITTRAC.227
CALL UMREAD( INITTRAC.228
*CALL ARGSIZE INITTRAC.229
*CALL ARGD1 INITTRAC.230
*CALL ARGDUMO INITTRAC.231
*CALL ARGPTRO INITTRAC.232
& LABS(NDISK),JIND,TPASS INITTRAC.233
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.234
! Now send the info to the PE which needs it: INITTRAC.235
PE_RECV = J_PE_JSTM1 INITTRAC.236
CALL GC_RSEND(3005,NSLAB,PE_RECV,INFO,TPX,TPASS) INITTRAC.237
ENDIF INITTRAC.238
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.357
IF (J_PE_JFINP1.GE.0) THEN INITTRAC.239
! We're expecting to receive a message: INITTRAC.240
PE_SEND = J_PE_JFINP1 INITTRAC.241
CALL GC_RRECV (3005,NSLAB,PE_SEND,INFO,TPX,TPASS) INITTRAC.242
ENDIF INITTRAC.243
INITTRAC.244
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.358
! Get tracers for JFIN+1 at previous timestep INITTRAC.245
IF (J_PE_JSTM1.GE.0) THEN INITTRAC.246
INITTRAC.247
! we pass the first row one PE backwards. INITTRAC.248
JIND = J_1 INITTRAC.249
INITTRAC.250
CALL UMREAD( INITTRAC.251
*CALL ARGSIZE INITTRAC.252
*CALL ARGD1 INITTRAC.253
*CALL ARGDUMO INITTRAC.254
*CALL ARGPTRO INITTRAC.255
& LABS(NDISKB),JIND,TPASS INITTRAC.256
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.257
! Now send the info to the PE which needs it: INITTRAC.258
PE_RECV = J_PE_JSTM1 INITTRAC.259
CALL GC_RSEND(3006,NSLAB,PE_RECV,INFO,TBPX,TPASS) INITTRAC.260
ENDIF INITTRAC.261
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.359
IF (J_PE_JFINP1.GE.0) THEN INITTRAC.262
! We're expecting to receive a message: INITTRAC.263
PE_SEND = J_PE_JFINP1 INITTRAC.264
CALL GC_RRECV(3006,NSLAB,PE_SEND,INFO,TBPX,TPASS) INITTRAC.265
ENDIF INITTRAC.266
CALL GC_GSYNC(O_NPROC,INFO) ORH3F403.360
IF (L_OBIMOM.or.L_OBIHARMGM) then OOM3F405.220
OOM3F405.221
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.222
OOM3F405.223
! we pass the second row one PE backwards. OOM3F405.224
JIND = J_1+1 OOM3F405.225
OOM3F405.226
CALL UMREAD( OOM3F405.227
*CALL ARGSIZE OOM3F405.228
*CALL ARGD1 OOM3F405.229
*CALL ARGDUMO OOM3F405.230
*CALL ARGPTRO OOM3F405.231
& LABS(NDISK),JIND,TPASS OOM3F405.232
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OOM3F405.233
! Now send the info to the PE which needs it: OOM3F405.234
PE_RECV = J_PE_JSTM1 OOM3F405.235
CALL GC_RSEND(3006,NSLAB,PE_RECV,INFO,TPPX,TPASS) OOM3F405.236
ENDIF OOM3F405.237
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.238
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.239
! We're expecting to receive a message: OOM3F405.240
PE_SEND = J_PE_JFINP1 OOM3F405.241
CALL GC_RRECV (3006,NSLAB,PE_SEND,INFO,TPPX,TPASS) OOM3F405.242
ENDIF OOM3F405.243
OOM3F405.244
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.245
! Get tracers for JFIN+1 at previous timestep OOM3F405.246
IF (J_PE_JSTM1.GE.0) THEN OOM3F405.247
OOM3F405.248
! we pass the second row one PE backwards. OOM3F405.249
JIND = J_1+1 OOM3F405.250
OOM3F405.251
CALL UMREAD( OOM3F405.252
*CALL ARGSIZE OOM3F405.253
*CALL ARGD1 OOM3F405.254
*CALL ARGDUMO OOM3F405.255
*CALL ARGPTRO OOM3F405.256
& LABS(NDISKB),JIND,TPASS OOM3F405.257
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OOM3F405.258
! Now send the info to the PE which needs it: OOM3F405.259
PE_RECV = J_PE_JSTM1 OOM3F405.260
CALL GC_RSEND(3007,NSLAB,PE_RECV,INFO,TBPPX,TPASS) OOM3F405.261
ENDIF OOM3F405.262
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.263
IF (J_PE_JFINP1.GE.0) THEN OOM3F405.264
! We're expecting to receive a message: OOM3F405.265
PE_SEND = J_PE_JFINP1 OOM3F405.266
CALL GC_RRECV(3007,NSLAB,PE_SEND,INFO,TBPPX,TPASS) OOM3F405.267
ENDIF OOM3F405.268
CALL GC_GSYNC(O_NPROC,INFO) OOM3F405.269
OOM3F405.270
ENDIF ! L_OBIMOM or L_OBIHARMGM OOM3F405.271
OOM3F405.272
*ELSE INITTRAC.267
INITTRAC.268
! Non MPP version - caters for Cray autotasking INITTRAC.269
DO IBLOCK=1,NBLOCK INITTRAC.270
INITTRAC.271
INITTRAC.272
C OSI1F405.80
C Set JIND, JST and JFROM OSI1F405.81
C OSI1F405.82
! Get tracers for J_FROM_COMP - 1 at current timestep OSI1F405.89
JIND=3+((IBLOCK-1)*JROWS) INITTRAC.274
IF(JIND.EQ.3) THEN OSI1F405.83
JST=1 OSI1F405.84
ELSE OSI1F405.85
JST=JIND OSI1F405.86
ENDIF OSI1F405.87
J_FROM_COMP = MAX(2,JST) OSI1F405.88
INITTRAC.275
CALL UMREAD( INITTRAC.276
*CALL ARGSIZE INITTRAC.277
*CALL ARGD1 INITTRAC.278
*CALL ARGDUMO INITTRAC.279
*CALL ARGPTRO INITTRAC.280
& LABS(NDISK),J_FROM_COMP-1,TX(1,IBLOCK) OSI1F405.90
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.282
INITTRAC.283
INITTRAC.284
! Get tracers for J_FROM_COMP - 1 at previous timestep OSI1F405.91
INITTRAC.286
CALL UMREAD( INITTRAC.287
*CALL ARGSIZE INITTRAC.288
*CALL ARGD1 INITTRAC.289
*CALL ARGDUMO INITTRAC.290
*CALL ARGPTRO INITTRAC.291
& LABS(NDISKB),J_FROM_COMP-1,TBX(1,IBLOCK) OSI1F405.92
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.293
INITTRAC.294
INITTRAC.295
IF (JIND.GT.3) THEN OSI1F405.93
! Get tracers for J_FROM_COMP - 2 at current timestep OSI1F405.94
! Since JIND >=3, we can do this for all processors INITTRAC.297
CALL UMREAD( INITTRAC.298
*CALL ARGSIZE INITTRAC.299
*CALL ARGD1 INITTRAC.300
*CALL ARGDUMO INITTRAC.301
*CALL ARGPTRO INITTRAC.302
& LABS(NDISK),J_FROM_COMP-2,TMX(1,IBLOCK) OSI1F405.95
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.304
INITTRAC.305
! Get tracers for J_FROM_COMP - 2 at previous timestep OSI1F405.96
INITTRAC.307
CALL UMREAD( INITTRAC.308
*CALL ARGSIZE INITTRAC.309
*CALL ARGD1 INITTRAC.310
*CALL ARGDUMO INITTRAC.311
*CALL ARGPTRO INITTRAC.312
& LABS(NDISKB),J_FROM_COMP-2,TBMX(1,IBLOCK) OSI1F405.97
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.314
INITTRAC.315
ENDIF OSI1F405.98
INITTRAC.316
!-------------------------------------------------------------------- INITTRAC.317
! For blocks 1 to NBLOCK - 1 we must obtain tracer values INITTRAC.318
! for row JFIN + 1 prior to commencing block computaion. INITTRAC.319
!-------------------------------------------------------------------- INITTRAC.320
INITTRAC.321
! We cant read the last plus 1 row for the final block INITTRAC.322
! but we do it for all the rest. INITTRAC.323
IF (IBLOCK.LT.NBLOCK) THEN INITTRAC.324
INITTRAC.325
! Get tracers for JFIN+1 at current timestep INITTRAC.326
INITTRAC.327
JFIN=MIN(JIND+JROWS-1,JMTM1) INITTRAC.328
JIND=JFIN INITTRAC.329
INITTRAC.330
CALL UMREAD( INITTRAC.331
*CALL ARGSIZE INITTRAC.332
*CALL ARGD1 INITTRAC.333
*CALL ARGDUMO INITTRAC.334
*CALL ARGPTRO INITTRAC.335
& LABS(NDISK),JIND+1,TPX (1,IBLOCK) INITTRAC.336
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.337
INITTRAC.338
! Get tracers for JFIN+1 at previous timestep INITTRAC.339
INITTRAC.340
CALL UMREAD( INITTRAC.341
*CALL ARGSIZE INITTRAC.342
*CALL ARGD1 INITTRAC.343
*CALL ARGDUMO INITTRAC.344
*CALL ARGPTRO INITTRAC.345
& LABS(NDISKB),JIND+1,TBPX(1,IBLOCK) INITTRAC.346
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) INITTRAC.347
INITTRAC.348
INITTRAC.349
ENDIF INITTRAC.350
ENDDO ! OVER IBLOCK INITTRAC.351
INITTRAC.352
*ENDIF INITTRAC.353
RETURN INITTRAC.354
INITTRAC.355
END INITTRAC.356
*ENDIF INITTRAC.357