SUBROUTINE TROPIC ( 1,16TROPIC.64
*CALL ARGSIZE 
TROPIC.65
*CALL ARGOCALL TROPIC.66
*CALL ARGOINDX TROPIC.67
TROPIC.68
& ITT TROPIC.69
&,XF,YF TROPIC.70
&,ETA,ETAB,UBT,UBTBBT,VBT,VBTBBT TROPIC.71
&,UBTBBC,VBTBBC TROPIC.72
& ) TROPIC.73
TROPIC.74
C TROPIC.75
C----------------------------------------------------------------------- TROPIC.76
IMPLICIT NONE TROPIC.77
C----------------------------------------------------------------------- TROPIC.78
C TROPIC.79
C----------------------------------------------------------------------- TROPIC.80
C DEFINE GLOBAL DATA TROPIC.81
C----------------------------------------------------------------------- TROPIC.82
C TROPIC.83
C TROPIC.84
*CALL TYPSIZE TROPIC.85
*CALL TYPOINDX PXORDER.55
*CALL TYPOCALL TROPIC.86
*CALL UMSCALAR TROPIC.87
*CALL CNTLOCN TROPIC.88
*CALL OARRYSIZ PXORDER.56
*CALL COCTWRKA TROPIC.89
*CALL OTIMER TROPIC.91
C TROPIC.93
TROPIC.94
INTEGER TROPIC.95
& ITT ! baroclinic timestep indicator IN TROPIC.96
TROPIC.97
REAL TROPIC.98
& XF(IMT,JMT) ! vert mean x-comp of barotropic forcing IN TROPIC.99
&,YF(IMT,JMT) ! vert mean y-comp of barotropic forcing IN TROPIC.100
&,ETA(IMT,JMT) ! free surface elevation IN/OUT TROPIC.101
&,ETAB(IMT,JMT) ! free surface elev on prev t step IN/OUT TROPIC.102
&,UBT(IMT,JMTM1) ! depth integrated x-comp of barotropic TROPIC.103
C velocity at current barotropic t step IN/OUT TROPIC.104
&,UBTBBT(IMT,JMTM1)! depth integrated x-comp of barotropic TROPIC.105
C velocity at previous barotropic t step IN/OUT TROPIC.106
&,VBT(IMT,JMTM1) ! depth integrated y-comp of barotropic TROPIC.107
C velocity at current barotropic t step IN/OUT TROPIC.108
&,VBTBBT(IMT,JMTM1)! depth integrated y-comp of barotropic TROPIC.109
C velocity at previous barotropic t step IN/OUT TROPIC.110
&,UBTBBC(IMT,JMTM1)! depth integrated x-comp of barotropic TROPIC.111
C velocity at previous baroclinic timestep OUT TROPIC.112
&,VBTBBC(IMT,JMTM1)! depth integrated y-comp of barotropic TROPIC.113
C velocity at previous baroclinic timestep OUT TROPIC.114
TROPIC.115
C---------------------------------------------------------------------- TROPIC.116
C DEFINE LOCAL DATA TROPIC.117
C---------------------------------------------------------------------- TROPIC.118
TROPIC.119
REAL TROPIC.120
& ETAA(IMT,JMT) ! eta for next timestep TROPIC.121
&,UBTA(IMT,JMTM1) ! x-comp of barot vely next t step TROPIC.122
&,VBTA(IMT,JMTM1) ! y-comp of barot vely next t step TROPIC.123
&,ETAGRD(IMT,JMT) ! gradient of free surf elevation TROPIC.124
&,UTB(IMT,JMTM1) ! x-comp depth ave barotrop vely prev t step TROPIC.125
&,VTB(IMT,JMTM1) ! y-comp depth ave barotrop vely prev t step TROPIC.126
&,SPLR(IMT,JMT) ! sets eta values on land TROPIC.127
&,COR_FACTOR(IMT) ! array for coriolis factor TROPIC.128
&,FACTOR(IMT) ! array used in calculating coriolis terms TROPIC.129
&,FAC2(IMT) ! determinant used in timestep equation TROPIC.130
&,UBTGRD(IMT) ! barotropic u velocity gradient TROPIC.131
&,VBTGRD(IMT) ! barotropic v velocity gradient TROPIC.132
&,H(IMT) ! local ocean depth TROPIC.133
&,BTFRICX(IMT) ! x-comp barotropic friction term TROPIC.134
&,BTFRICY(IMT) ! y-comp barotropic friction term TROPIC.135
&,TEMPX(IMT) ! temporary array used in diffn calc TROPIC.136
&,TEMPY(IMT) ! temporary array used in diffn calc TROPIC.137
&,UTEMP(IMT) ! temporary array used in press grad calc TROPIC.138
&,VTEMP(IMT) ! temporary array used in press grad calc TROPIC.139
TROPIC.140
TROPIC.141
INTEGER TROPIC.142
& I ! Grid point index (zonal) TROPIC.143
&,J ! Grid point index (meridional) TROPIC.144
&,L ! Loop index TROPIC.145
&,JLIMIT ! local limit for j counter TROPIC.146
&,ITBT ! barotropic timestep counter TROPIC.147
&,NB ! no of free surf t steps TROPIC.148
TROPIC.149
REAL TROPIC.150
& FX ! local constant TROPIC.151
&,DLPL ! delplus term TROPIC.152
&,DLCR ! delcross term TROPIC.153
&,UBTDUM ! local dummy for ubt TROPIC.154
&,VBTDUM ! local dummy for vbt TROPIC.155
&,HD ! local dummy for ocean depth TROPIC.156
TROPIC.157
C---------------------------------------------------------------------- TROPIC.158
C BEGIN EXECUTABLE CODE TROPIC.159
C---------------------------------------------------------------------- TROPIC.160
TROPIC.161
IF (L_OTIMER) CALL TIMER('TROPIC ',3) TROPIC.162
TROPIC.163
C---------------------------------------------------------------------- TROPIC.164
C AT EACH BAROCLINIC TIMESTEP CLINIC REQUIRES BAROTROPIC VELOCITIES TROPIC.165
C FOR THE *PREVIOUS* BAROCLINIC TIMESTEP. TROPIC.166
C STORE *PRESENT* UBT,VBT VALUES IN ARRAYS FOR USE IN CLINIC AT THE TROPIC.167
C NEXT BAROCLINIC TIMESTEP WHERE THESE VALUES WILL BE FOR THE TROPIC.168
C *PREVIOUS* BAROCLINIC TIMESTEP UBTBBC,VBTBBC. TROPIC.169
C INITIALISE UBTA,VBTA,ETAGRD,UBTDIF,VBTDIF,ETADIF TO SET THE VALUE TROPIC.170
C FOR LAND POINTS TO ZERO. OCEAN POINTS ARE OVERWRITTEN LATER. THIS TROPIC.171
C AVOIDS UNSET VARIABLE ERROR. TROPIC.172
C---------------------------------------------------------------------- TROPIC.173
TROPIC.174
DO J=J_1,J_JMTM1 TROPIC.175
DO I=1,IMT TROPIC.176
UBTBBC(I,J) = UBT(I,J) TROPIC.177
VBTBBC(I,J) = VBT(I,J) TROPIC.178
UBTA(I,J) = 0.0 TROPIC.179
VBTA(I,J) = 0.0 TROPIC.180
ENDDO TROPIC.181
ENDDO TROPIC.182
TROPIC.183
DO J=J_1,J_JMT TROPIC.184
DO I=1,IMT TROPIC.185
TROPIC.186
ETAGRD(I,J) = 0.0 TROPIC.187
ETAA(I,J) = 0.0 TROPIC.188
ENDDO TROPIC.189
ENDDO TROPIC.190
TROPIC.191
DO I=1,IMT TROPIC.192
BTFRICX(I) = 0.0 TROPIC.193
BTFRICY(I) = 0.0 TROPIC.194
UBTGRD(I) = 0.0 TROPIC.195
VBTGRD(I) = 0.0 TROPIC.196
ENDDO TROPIC.197
TROPIC.198
C---------------------------------------------------------------------- TROPIC.199
C SET Y FORCING ON SYMMETRY ROW TO ZERO TROPIC.200
C---------------------------------------------------------------------- TROPIC.201
TROPIC.202
IF (L_OSYMM) THEN TROPIC.203
IF ( (J_JMTM1+J_OFFSET) .EQ. JMTM1_GLOBAL) THEN TROPIC.204
DO I=1,IMT TROPIC.205
YF(I,J_JMTM1)=0.0 TROPIC.206
END DO TROPIC.207
ENDIF ! J condition TROPIC.208
ENDIF ! L_OSYMM TROPIC.209
TROPIC.210
IF (L_ODELPLUS) THEN TROPIC.211
C TROPIC.212
C----------------------------------------------------------------------- TROPIC.213
C CALCULATE THE ARRAY SPLR USED TO SET PSUEDO VALUES OF ETA ON LAND. TROPIC.214
C THIS ARRAY IS ONLY NEEDED IN THE CALCULATION OF ETA WHEN THE DELPLUS TROPIC.215
C OPERATOR IS BEING USED. TROPIC.216
C----------------------------------------------------------------------- TROPIC.217
C TROPIC.218
DO J=J_2,J_JMTM1 TROPIC.219
DO I=2,IMTM1 TROPIC.220
TROPIC.221
IF ( (EM(I,J).EQ.0.0).AND. TROPIC.222
& ( ( EM(I+1,J)+EM(I-1,J) TROPIC.223
& +EM(I,J+1)+EM(I,J-1)).GT.0.0 ) ) THEN TROPIC.224
TROPIC.225
SPLR(I,J) = 1./( EM(I+1,J)+EM(I-1,J)+EM(I,J+1)+EM(I,J-1) ) TROPIC.226
TROPIC.227
ELSE TROPIC.228
TROPIC.229
SPLR(I,J) = 0.0 TROPIC.230
TROPIC.231
ENDIF TROPIC.232
TROPIC.233
ENDDO ! over i TROPIC.234
END DO ! over j TROPIC.235
TROPIC.236
END IF ! L_ODELPLUS TROPIC.237
C TROPIC.238
C----------------------------------------------------------------------- TROPIC.239
C CALCULATE NUMBER OF FREE SURF T STEPS PER BAROCLINIC T STEP TROPIC.240
C----------------------------------------------------------------------- TROPIC.241
C TROPIC.242
NB=NINT(DTUV/DTBT) TROPIC.243
C TROPIC.244
C======================================================================= TROPIC.245
C TIME STEP BAROTROPIC EQUATIONS BETWEEN (LARGER) BAROCLINIC TIME STEPS TROPIC.246
C======================================================================= TROPIC.247
C TROPIC.248
DO ITBT = 1,NB TROPIC.249
C TROPIC.250
C----------------------------------------------------------------------- TROPIC.251
C RESET TIMESTEP FOR CASE WHEN A MIXING TIMESTEP IS REQUIRED. THIS TROPIC.252
C OCCURS FOR THE *FIRST* BAROTROPIC TIMESTEP ONLY WHEN MIX IS SELECTED. TROPIC.253
C THUS THE TIMESTEP MUST BE CHANGED HERE, WHEREAS THE ETAB, UBTBBT AND TROPIC.254
C VBTBBT ARRAYS CAN BE SET IN OCN_FRST ALONG WITH THE OTHER ARRAYS. TROPIC.255
C----------------------------------------------------------------------- TROPIC.256
C TROPIC.257
C2DTBT=2.0*DTBT TROPIC.258
TROPIC.259
IF ((ITBT.EQ.1).AND.(ITT.EQ.1)) THEN TROPIC.260
C2DTBT=DTBT TROPIC.261
ELSEIF ((ITBT.EQ.1).AND.(MOD(ITT,NMIX).EQ.1)) THEN TROPIC.262
C2DTBT=DTBT TROPIC.263
ENDIF TROPIC.264
TROPIC.265
IF (L_ODELPLUS) THEN TROPIC.266
C TROPIC.267
C----------------------------------------------------------------------- TROPIC.268
C SET PSEUDO ETA VALUES ON LAND FOR USE BY DLPL. TROPIC.269
C----------------------------------------------------------------------- TROPIC.270
C TROPIC.271
DO J=J_2,J_JMTM1 TROPIC.272
DO I=2,IMTM1 TROPIC.273
TROPIC.274
C if the point is set as a coastal point then create pseudo eta values TROPIC.275
C over the land. TROPIC.276
TROPIC.277
IF (SPLR(I,J) .NE. 0.0) THEN TROPIC.278
TROPIC.279
ETA(I,J) = ( EM(I+1,J)*ETA(I+1,J) TROPIC.280
& + EM(I-1,J)*ETA(I-1,J) TROPIC.281
& + EM(I,J+1)*ETA(I,J+1) TROPIC.282
& + EM(I,J-1)*ETA(I,J-1) )*SPLR(I,J) TROPIC.283
TROPIC.284
ENDIF TROPIC.285
TROPIC.286
END DO ! OVER I TROPIC.287
END DO ! OVER J TROPIC.288
TROPIC.289
c following section recoded for version 4.2 to set values for the TROPIC.290
c top and bottom (global) rows. For the case where one row only TROPIC.291
c is assigned to each processor, a call to SWAPBOUNDS is needed before TROPIC.292
c and after the calculations. TROPIC.293
TROPIC.294
*IF DEF,MPP TROPIC.295
IF ((JFIN-JST+1).LT.2) THEN TROPIC.296
C TROPIC.297
C===================================================================== TROPIC.298
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.299
C===================================================================== TROPIC.300
C TROPIC.301
CALL SWAPBOUNDS(ETA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.302
TROPIC.303
ENDIF ! ONE ROW PER PROCESSOR TROPIC.304
*ENDIF TROPIC.305
TROPIC.306
IF (JST.EQ.1) THEN TROPIC.307
DO I=2,IMTM1 TROPIC.308
ETA(I,J_1) = ETA(I,J_1+1) TROPIC.309
ENDDO ! i loop TROPIC.310
ENDIF ! j condition TROPIC.311
TROPIC.312
IF (JFIN.EQ.JMT_GLOBAL) THEN TROPIC.313
DO I=2,IMTM1 TROPIC.314
ETA(I,J_JMT) = ETA(I,J_JMT-1) TROPIC.315
END DO ! i loop TROPIC.316
ENDIF ! j condition TROPIC.317
TROPIC.318
*IF DEF,MPP TROPIC.319
IF ((JFIN-JST+1).LT.2) THEN TROPIC.320
C TROPIC.321
C===================================================================== TROPIC.322
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.323
C===================================================================== TROPIC.324
C TROPIC.325
CALL SWAPBOUNDS(ETA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.326
TROPIC.327
ENDIF ! ONE ROW PER PROCESSOR TROPIC.328
*ENDIF TROPIC.329
C TROPIC.330
C--------------------------------------------------------------------- TROPIC.331
C APPLY BOUNDARY CONDITIONS FOR SURFACE HEIGHT TROPIC.332
C--------------------------------------------------------------------- TROPIC.333
C TROPIC.334
DO J=J_1,J_JMT TROPIC.335
TROPIC.336
IF (L_OCYCLIC) THEN TROPIC.337
ETA( 1,J) = ETA(IMTM1,J) TROPIC.338
ETA(IMT,J) = ETA(2,J) TROPIC.339
TROPIC.340
ELSE TROPIC.341
ETA( 1,J) = 0.0 TROPIC.342
ETA(IMT,J) = 0.0 TROPIC.343
TROPIC.344
ENDIF ! L_OCYCLIC TROPIC.345
TROPIC.346
ENDDO ! over j TROPIC.347
TROPIC.348
END IF ! L_ODELPLUS TROPIC.349
C TROPIC.350
C----------------------------------------------------------------------- TROPIC.351
C CALCULATE THE OLD DEPTH AVERAGED BAROTROPIC VELOCITIES UTB AND VTB TROPIC.352
C FOR EACH OF THE SMALL BAROTROPIC TIMESTEPS FOR USE IN THE CALCULATION TROPIC.353
C OF THE BAROTROPIC HORIZONTAL DIFFUSION AND BAROTROPIC CORIOLIS TERMS. TROPIC.354
C----------------------------------------------------------------------- TROPIC.355
C TROPIC.356
DO J=J_2,J_JMTM1 TROPIC.357
DO I=1,IMU TROPIC.358
UTB(I,J) = UBTBBT(I,J)*HR(I,J) TROPIC.359
VTB(I,J) = VBTBBT(I,J)*HR(I,J) TROPIC.360
END DO TROPIC.361
END DO TROPIC.362
TROPIC.363
C SET VALUE FOR UTB,VTB AT J=1 TO ZERO TROPIC.364
TROPIC.365
IF (JST .EQ. 1) THEN TROPIC.366
DO I=1,IMU TROPIC.367
UTB(I,J_1) = 0.0 TROPIC.368
VTB(I,J_1) = 0.0 TROPIC.369
ENDDO ! over i TROPIC.370
ENDIF ! J condition TROPIC.371
TROPIC.372
*IF DEF,MPP TROPIC.373
C TROPIC.374
C===================================================================== TROPIC.375
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.376
C===================================================================== TROPIC.377
TROPIC.378
CALL SWAPBOUNDS(UTB,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.379
CALL SWAPBOUNDS(VTB,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.380
TROPIC.381
*ENDIF TROPIC.382
C TROPIC.383
C======================================================================= TROPIC.384
C BEGIN SURFACE HEIGHT CALCULATION TROPIC.385
C======================================================================= TROPIC.386
C----------------------------------------------------------------------- TROPIC.387
C COMPUTE ETAGRD FROM ETA,UBT,VBT FOR THE CURRENT BAROTROPIC TIMESTEP TROPIC.388
C----------------------------------------------------------------------- TROPIC.389
C TROPIC.390
IF (L_ODELPLUS) THEN TROPIC.391
TROPIC.392
*IF DEF,MPP TROPIC.393
C TROPIC.394
C===================================================================== TROPIC.395
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.396
C===================================================================== TROPIC.397
C TROPIC.398
CALL SWAPBOUNDS(ETA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.399
TROPIC.400
*ENDIF TROPIC.401
TROPIC.402
FX = DTBT*WGHT_DELPLUS*GRAV*ZDZ(KM) TROPIC.403
TROPIC.404
DO J=J_2,J_JMTM1 TROPIC.405
DO L=1,LSE(J) TROPIC.406
DO I=ISE(J,L),IEE(J,L) TROPIC.407
TROPIC.408
DLPL = ETA(I,J+1) + ETA(I+1,J) TROPIC.409
& + ETA(I-1,J) + ETA(I,J-1) - 4.*ETA(I,J) TROPIC.410
TROPIC.411
DLCR = 0.5*( EM(I+1,J+1)*ETA(I+1,J+1) TROPIC.412
& + EM(I-1,J+1)*ETA(I-1,J+1) TROPIC.413
& + EM(I+1,J-1)*ETA(I+1,J-1) TROPIC.414
& + EM(I-1,J-1)*ETA(I-1,J-1) TROPIC.415
& - ( EM(I+1,J+1) + EM(I-1,J+1) TROPIC.416
& + EM(I+1,J-1) + EM(I-1,J-1) )*ETA(I,J) ) TROPIC.417
TROPIC.418
TROPIC.419
ETAGRD(I,J) = TROPIC.420
& -DXT2R(I)*DYTR(J)*CSTR(J)* TROPIC.421
& ( UBT(I ,J)*DYU(J) + UBT(I ,J-1)*DYU(J-1) TROPIC.422
& -( UBT(I-1,J)*DYU(J) + UBT(I-1,J-1)*DYU(J-1) ) TROPIC.423
& +( VBT(I,J)*DXU(I) + VBT(I-1,J)*DXU(I-1) )*CS(J) TROPIC.424
& -( VBT(I,J-1)*DXU(I) + VBT(I-1,J-1)*DXU(I-1) )*CS(J-1) TROPIC.425
& ) + FX*DXTR(I)*DYTR(J)*( DLPL - DLCR ) TROPIC.426
TROPIC.427
END DO TROPIC.428
END DO TROPIC.429
END DO TROPIC.430
TROPIC.431
ELSE TROPIC.432
TROPIC.433
DO J=J_2,J_JMTM1 TROPIC.434
DO L=1,LSE(J) TROPIC.435
DO I=ISE(J,L),IEE(J,L) TROPIC.436
TROPIC.437
ETAGRD(I,J) = TROPIC.438
& -DXT2R(I)*DYTR(J)*CSTR(J)* TROPIC.439
& ( UBT(I ,J)*DYU(J) + UBT(I ,J-1)*DYU(J-1) TROPIC.440
& -( UBT(I-1,J)*DYU(J) + UBT(I-1,J-1)*DYU(J-1) ) TROPIC.441
& +( VBT(I,J)*DXU(I) + VBT(I-1,J)*DXU(I-1) )*CS(J) TROPIC.442
& -( VBT(I,J-1)*DXU(I) + VBT(I-1,J-1)*DXU(I-1) )*CS(J-1) TROPIC.443
& ) TROPIC.444
TROPIC.445
END DO ! OVER I TROPIC.446
TROPIC.447
END DO ! OVER L END OF LOOP OVER SEGMENTS TROPIC.448
TROPIC.449
END DO ! OVER J END OF LOOP OVER ROWS TROPIC.450
TROPIC.451
END IF TROPIC.452
C TROPIC.453
C----------------------------------------------------------------------- TROPIC.454
C COMPUTE ETAA FROM ETAGRD AND ETAB USING A LEAPFROG TIMESTEP TROPIC.455
C----------------------------------------------------------------------- TROPIC.456
C TROPIC.457
DO J=J_1,J_JMT TROPIC.458
DO I=1,IMT TROPIC.459
TROPIC.460
ETAA(I,J) = EM(I,J)*( ETAB(I,J) + TROPIC.461
& C2DTBT*ETAGRD(I,J) ) TROPIC.462
TROPIC.463
END DO TROPIC.464
END DO TROPIC.465
TROPIC.466
IF (L_OSYMM) THEN TROPIC.467
TROPIC.468
c following section recoded for version 4.2 to set values for the TROPIC.469
c top and bottom (global) rows. For the case where one row only TROPIC.470
c is assigned to each processor, a call to SWAPBOUNDS is needed before TROPIC.471
c and after the calculations. TROPIC.472
TROPIC.473
*IF DEF,MPP TROPIC.474
IF ((JFIN-JST+1).LT.2) THEN TROPIC.475
C TROPIC.476
C===================================================================== TROPIC.477
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.478
C===================================================================== TROPIC.479
C TROPIC.480
CALL SWAPBOUNDS(ETAA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.481
TROPIC.482
ENDIF ! ONE ROW PER PROCESSOR TROPIC.483
*ENDIF TROPIC.484
TROPIC.485
IF (JFIN.EQ.JMT_GLOBAL) THEN TROPIC.486
DO I=1,IMT TROPIC.487
ETAA(I,J_JMT)=ETAA(I,J_JMT-1) TROPIC.488
END DO TROPIC.489
ENDIF ! j condition TROPIC.490
TROPIC.491
*IF DEF,MPP TROPIC.492
IF ((JFIN-JST+1).LT.2) THEN TROPIC.493
C TROPIC.494
C===================================================================== TROPIC.495
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.496
C===================================================================== TROPIC.497
C TROPIC.498
CALL SWAPBOUNDS(ETAA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.499
TROPIC.500
ENDIF ! ONE ROW PER PROCESSOR TROPIC.501
*ENDIF TROPIC.502
ENDIF ! L_OSYMM TROPIC.503
C TROPIC.504
C--------------------------------------------------------------------- TROPIC.505
C APPLY BOUNDARY CONDITIONS ON ETAA TROPIC.506
C--------------------------------------------------------------------- TROPIC.507
C TROPIC.508
IF (L_OCYCLIC) THEN TROPIC.509
IF (L_OSYMM) THEN TROPIC.510
JLIMIT=J_JMT TROPIC.511
ELSE TROPIC.512
JLIMIT=J_JMTM1 TROPIC.513
ENDIF ! L_OSYMM TROPIC.514
TROPIC.515
DO J=J_2,JLIMIT TROPIC.516
ETAA( 1,J) = ETAA(IMTM1,J) TROPIC.517
ETAA(IMT,J) = ETAA(2,J) TROPIC.518
END DO TROPIC.519
TROPIC.520
END IF ! L_OCYCLIC TROPIC.521
TROPIC.522
*IF DEF,MPP TROPIC.523
C TROPIC.524
C===================================================================== TROPIC.525
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.526
C===================================================================== TROPIC.527
C TROPIC.528
CALL SWAPBOUNDS(ETA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.529
TROPIC.530
*ENDIF TROPIC.531
C TROPIC.532
C======================================================================= TROPIC.533
C END CALCULATION OF ETA TROPIC.534
C======================================================================= TROPIC.535
C TROPIC.536
C TROPIC.537
C======================================================================= TROPIC.538
C BEGIN CALCULATION OF THE DEPTH INTEGRATED BAROTROPIC FLOW TROPIC.539
C======================================================================= TROPIC.540
C----------------------------------------------------------------------- TROPIC.541
C START LOOP TO STEP UBT AND VBT FROM ETA,UT AND VT. TROPIC.542
C----------------------------------------------------------------------- TROPIC.543
C TROPIC.544
IF (L_OSYMM) THEN TROPIC.545
JLIMIT = J_JMTM1 TROPIC.546
ELSE TROPIC.547
JLIMIT = J_JMTM2 TROPIC.548
ENDIF ! L_OSYMM TROPIC.549
TROPIC.550
DO J=J_2,JLIMIT TROPIC.551
TROPIC.552
DO L=1,LSU(J) TROPIC.553
C TROPIC.554
C----------------------------------------------------------------------- TROPIC.555
C SET UP THE ARRAYS FOR THE CORIOLIS TERMS FOR USE IN THE CALCULATION TROPIC.556
C OF UBTGRD, VBTGRD AND UBTDUM, VBTDUM. TROPIC.557
C----------------------------------------------------------------------- TROPIC.558
C TROPIC.559
IF(ACOR.NE.0.) THEN TROPIC.560
TROPIC.561
DO I=ISU(J,L),IEU(J,L) TROPIC.562
FACTOR(I)=CORIOLIS(I,J)*ACOR*C2DTBT TROPIC.563
FAC2(I)=1.0/(1.0 + FACTOR(I)*FACTOR(I)) TROPIC.564
ENDDO TROPIC.565
TROPIC.566
ENDIF ! ACOR=0 TROPIC.567
TROPIC.568
C CALCULATE DEPTH ARRAYS FOR USE IN THE CALCULATION OF BT FRICTION TROPIC.569
TROPIC.570
DO I=ISU(J,L),IEU(J,L) TROPIC.571
TROPIC.572
H(I) = 1./HR(I,J) TROPIC.573
TROPIC.574
ENDDO ! over i TROPIC.575
C TROPIC.576
C----------------------------------------------------------------------- TROPIC.577
C CALCULATE THE DEPTH INTEGRATED BAROTROPIC FRICTION TERMS FOR THE TROPIC.578
C PRESENT BAROTROPIC TIMESTEP TO ADD IN FOR THE CALCULATION OF THE TROPIC.579
C VELOCITY GRADIENTS. TROPIC.580
C----------------------------------------------------------------------- TROPIC.581
C TROPIC.582
IF (J+J_OFFSET .NE. JMTM1_GLOBAL) THEN TROPIC.583
TROPIC.584
DO I=ISU(J,L),IEU(J,L) TROPIC.585
TROPIC.586
TEMPX(I) = UTB(I,J+1) - UTB(I,J) TROPIC.587
TEMPY(I) = VTB(I,J+1) - VTB(I,J) TROPIC.588
TROPIC.589
ENDDO ! over i TROPIC.590
TROPIC.591
ELSE TROPIC.592
TROPIC.593
DO I=ISU(J,L),IEU(J,L) TROPIC.594
TROPIC.595
C note the symmetric nature of VTB(I,JMTM2) - hence the minus sign TROPIC.596
TROPIC.597
TEMPX(I) = UTB(I,J_JMTM2) - UTB(I,J) TROPIC.598
TEMPY(I) =-VTB(I,J_JMTM2) - VTB(I,J) TROPIC.599
TROPIC.600
ENDDO ! over i TROPIC.601
TROPIC.602
ENDIF TROPIC.603
TROPIC.604
DO I=ISU(J,L),IEU(J,L) TROPIC.605
TROPIC.606
BTFRICX(I) = H(I)*( TROPIC.607
& BBU(J)*DXU2R(I)*( TROPIC.608
& DXT4R(I+1)*(UTB(I+1,J) - UTB(I,J)) TROPIC.609
& -DXT4R(I)*(UTB(I,J) - UTB(I-1,J))) TROPIC.610
& + CCU(J)*TEMPX(I) TROPIC.611
& - DDU(J)*( UTB(I,J ) - UTB(I,J-1) ) TROPIC.612
& + GGU(J)*UTB(I,J) TROPIC.613
& - HHU(J)*DXU2R(I)*(VTB(I+1,J) - VTB(I-1,J)) ) TROPIC.614
TROPIC.615
BTFRICY(I) = H(I)*( TROPIC.616
& BBU(J)*DXU2R(I)*( TROPIC.617
& DXT4R(I+1)*(VTB(I+1,J) - VTB(I,J)) TROPIC.618
& -DXT4R(I)*(VTB(I,J) - VTB(I-1,J))) TROPIC.619
& + CCU(J)*TEMPY(I) TROPIC.620
& - DDU(J)*( VTB(I,J ) - VTB(I,J-1) ) TROPIC.621
& + GGU(J)*VTB(I,J) TROPIC.622
& + HHU(J)*DXU2R(I)*(UTB(I+1,J) - UTB(I-1,J)) ) TROPIC.623
TROPIC.624
ENDDO ! over i TROPIC.625
C TROPIC.626
C----------------------------------------------------------------------- TROPIC.627
C CALCULATE dU/dt - THE GRADIENT OF THE DEPTH INTEGRATED BAROTROPIC TROPIC.628
C FLOW. THE SEMI IMPLICIT TREATMENT OF THE CORIOLIS TERM FOLLOWS THE TROPIC.629
C METHOD USED IN CLINIC TROPIC.630
C----------------------------------------------------------------------- TROPIC.631
C TROPIC.632
IF (J+J_OFFSET .NE. JMTM1_GLOBAL) THEN TROPIC.633
TROPIC.634
DO I=ISU(J,L),IEU(J,L) TROPIC.635
UTEMP(I) = ETA(I+1,J+1) + ETA(I+1,J) TROPIC.636
& -ETA(I ,J+1) - ETA(I ,J) TROPIC.637
TROPIC.638
VTEMP(I) = ETA(I,J+1) + ETA(I+1,J+1) TROPIC.639
& -ETA(I,J ) - ETA(I+1,J ) TROPIC.640
ENDDO ! over i TROPIC.641
TROPIC.642
ELSE ! for symmetric case TROPIC.643
TROPIC.644
DO I=ISU(J,L),IEU(J,L) TROPIC.645
UTEMP(I) = ETA(I+1,J_JMTM1) + ETA(I+1,J) TROPIC.646
& -ETA(I ,J_JMTM1) - ETA(I ,J) TROPIC.647
TROPIC.648
VTEMP(I) = ETA(I,J_JMTM1) + ETA(I+1,J_JMTM1) TROPIC.649
& -ETA(I,J ) - ETA(I+1,J ) TROPIC.650
ENDDO ! over i TROPIC.651
TROPIC.652
ENDIF TROPIC.653
TROPIC.654
IF(ACOR.EQ.0.) THEN TROPIC.655
TROPIC.656
DO I=ISU(J,L),IEU(J,L) TROPIC.657
TROPIC.658
UBTGRD(I) = H(I)*XF(I,J) TROPIC.659
& + BTFRICX(I) TROPIC.660
& + 2.0*OMEGA*SINE(J)*VBT(I,J) TROPIC.661
& - H(I)*GRAV*CSR(J)*DXU2R(I)*UTEMP(I) TROPIC.662
TROPIC.663
VBTGRD(I) = H(I)*YF(I,J) TROPIC.664
& + BTFRICY(I) TROPIC.665
& - 2.0*OMEGA*SINE(J)*UBT(I,J) TROPIC.666
& - H(I)*GRAV*DYU2R(J)*VTEMP(I) TROPIC.667
TROPIC.668
ENDDO ! over i TROPIC.669
TROPIC.670
ELSE TROPIC.671
TROPIC.672
DO I=ISU(J,L),IEU(J,L) TROPIC.673
TROPIC.674
UBTGRD(I) = H(I)*XF(I,J) TROPIC.675
& + BTFRICX(I) TROPIC.676
& + H(I)* ( CORIOLIS(I,J)*VTB(I,J) TROPIC.677
& - GRAV*CSR(J)*DXU2R(I)*UTEMP(I) ) TROPIC.678
TROPIC.679
VBTGRD(I) = H(I)*YF(I,J) TROPIC.680
& + BTFRICY(I) TROPIC.681
& - H(I)* ( CORIOLIS(I,J)*UTB(I,J) TROPIC.682
& + GRAV*DYU2R(J)*VTEMP(I) ) TROPIC.683
TROPIC.684
ENDDO ! over i TROPIC.685
TROPIC.686
ENDIF ! ACOR condition TROPIC.687
C TROPIC.688
C----------------------------------------------------------------------- TROPIC.689
C CALCULATE UBTA AND VBTA FROM UBTGRD AND VBTGRD USING A LEAPFROG TROPIC.690
C TIMESTEP. TROPIC.691
C----------------------------------------------------------------------- TROPIC.692
C TROPIC.693
DO I=ISU(J,L),IEU(J,L) TROPIC.694
TROPIC.695
IF(ACOR.EQ.0.) THEN TROPIC.696
TROPIC.697
UBTA(I,J) = UBTBBT(I,J)+C2DTBT*UBTGRD(I) TROPIC.698
VBTA(I,J) = VBTBBT(I,J)+C2DTBT*VBTGRD(I) TROPIC.699
TROPIC.700
ELSE TROPIC.701
TROPIC.702
UBTDUM = C2DTBT*UBTGRD(I) TROPIC.703
VBTDUM = C2DTBT*VBTGRD(I) TROPIC.704
TROPIC.705
UBTA(I,J) = UBTBBT(I,J)+(UBTDUM+FACTOR(I)*VBTDUM)*FAC2(I) TROPIC.706
VBTA(I,J) = VBTBBT(I,J)+(VBTDUM-FACTOR(I)*UBTDUM)*FAC2(I) TROPIC.707
TROPIC.708
ENDIF ! ACOR condition TROPIC.709
TROPIC.710
END DO ! OVER I TROPIC.711
TROPIC.712
END DO ! OVER L END OF LOOP OVER SEGMENTS TROPIC.713
TROPIC.714
END DO ! OVER J END OF LOOP OVER ROWS TROPIC.715
TROPIC.716
C END OF LOOP STEPPING UBT,VBT TROPIC.717
C TROPIC.718
C----------------------------------------------------------------------- TROPIC.719
C SET SYMMETRIC CONDITIONS ON UBT AND VBT. TROPIC.720
C----------------------------------------------------------------------- TROPIC.721
C TROPIC.722
IF (L_OSYMM) THEN TROPIC.723
IF (J+J_OFFSET .EQ. JMTM1_GLOBAL) THEN TROPIC.724
DO I=1,IMU TROPIC.725
VBTA(I,J)=0.0 TROPIC.726
END DO TROPIC.727
ENDIF ! J condition TROPIC.728
END IF ! L_OSYMM TROPIC.729
TROPIC.730
TROPIC.731
IF (L_OFILTER) THEN TROPIC.732
C TROPIC.733
C----------------------------------------------------------------------- TROPIC.734
C FOURIER FILTER THE BAROTROPIC VELOCITIES AND SURFACE HEIGHT AT HIGH TROPIC.735
C LATITUDES TROPIC.736
C----------------------------------------------------------------------- TROPIC.737
C TROPIC.738
CALL TFILT_CTL( TROPIC.739
*CALL ARGSIZE TROPIC.740
*CALL ARGOCALL TROPIC.741
*CALL ARGOINDX TROPIC.742
& UBTA,VBTA,ETAA, TROPIC.743
*CALL COCAWRKA TROPIC.744
& ) TROPIC.745
TROPIC.746
ENDIF ! L_OFILTER = true TROPIC.747
C TROPIC.748
C----------------------------------------------------------------------- TROPIC.749
C ALLOW FOR CYCLIC CONDITIONS TROPIC.750
C----------------------------------------------------------------------- TROPIC.751
C TROPIC.752
IF (L_OCYCLIC) THEN TROPIC.753
TROPIC.754
IF (L_OSYMM) THEN TROPIC.755
JLIMIT=J_JMT TROPIC.756
ELSE TROPIC.757
JLIMIT=J_JMTM1 TROPIC.758
ENDIF ! L_OSYMM TROPIC.759
TROPIC.760
DO J=J_2,JLIMIT TROPIC.761
ETAA( 1,J) = ETAA(IMTM1,J) TROPIC.762
ETAA(IMT,J) = ETAA(2,J) TROPIC.763
END DO TROPIC.764
TROPIC.765
DO J=J_2,J_JMTM1 TROPIC.766
UBTA( 1,J) = UBTA(IMUM1,J) TROPIC.767
VBTA( 1,J) = VBTA(IMUM1,J) TROPIC.768
UBTA(IMU,J) = UBTA(2,J) TROPIC.769
VBTA(IMU,J) = VBTA(2,J) TROPIC.770
END DO TROPIC.771
TROPIC.772
END IF ! (L_OCYCLIC) TROPIC.773
C TROPIC.774
C----------------------------------------------------------------------- TROPIC.775
C TIME FILTER THE BAROTROPIC VELOCITIES TROPIC.776
C----------------------------------------------------------------------- TROPIC.777
C TROPIC.778
IF (L_OSYMM) THEN TROPIC.779
JLIMIT = J_JMTM1 TROPIC.780
ELSE TROPIC.781
JLIMIT = J_JMTM2 TROPIC.782
ENDIF ! l_OSYMM TROPIC.783
TROPIC.784
DO J=J_2,JLIMIT TROPIC.785
DO I=1,IMU TROPIC.786
UBT(I,J) = PNU2M*UBT(I,J) + PNU*( UBTBBT(I,J) + UBTA(I,J) ) TROPIC.787
VBT(I,J) = PNU2M*VBT(I,J) + PNU*( VBTBBT(I,J) + VBTA(I,J) ) TROPIC.788
ENDDO ! over i TROPIC.789
ENDDO ! over j TROPIC.790
C TROPIC.791
C----------------------------------------------------------------------- TROPIC.792
C TIME FILTER THE SURFACE HEIGHT FIELD TROPIC.793
C----------------------------------------------------------------------- TROPIC.794
C TROPIC.795
DO J=J_1,J_JMT TROPIC.796
DO I=1,IMT TROPIC.797
ETA(I,J) = PNU2M*ETA(I,J) + PNU*( ETAB(I,J) + ETAA(I,J) ) TROPIC.798
ENDDO TROPIC.799
ENDDO TROPIC.800
C TROPIC.801
C----------------------------------------------------------------------- TROPIC.802
C ROLL BACK THE VALUES TO PREPARE FOR THE NEXT BAROTROPIC TIMESTEP TROPIC.803
C----------------------------------------------------------------------- TROPIC.804
C TROPIC.805
DO J=J_1,J_JMTM1 TROPIC.806
DO I=1,IMU TROPIC.807
TROPIC.808
UBTBBT(I,J)=UBT(I,J) TROPIC.809
VBTBBT(I,J)=VBT(I,J) TROPIC.810
UBT(I,J) =UBTA(I,J) TROPIC.811
VBT(I,J) =VBTA(I,J) TROPIC.812
TROPIC.813
ENDDO ! over i TROPIC.814
ENDDO ! over j TROPIC.815
TROPIC.816
DO J=J_1,J_JMT TROPIC.817
DO I=1,IMT TROPIC.818
TROPIC.819
ETAB(I,J) =ETA(I,J) TROPIC.820
ETA(I,J) =ETAA(I,J) TROPIC.821
TROPIC.822
ENDDO ! over i TROPIC.823
ENDDO ! over j TROPIC.824
TROPIC.825
*IF DEF,MPP TROPIC.826
C TROPIC.827
C===================================================================== TROPIC.828
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.829
C===================================================================== TROPIC.830
C TROPIC.831
CALL SWAPBOUNDS(ETA,IMT,JMT,O_EW_HALO,O_NS_HALO,1) TROPIC.832
CALL SWAPBOUNDS(UBT,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.833
CALL SWAPBOUNDS(VBT,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.834
TROPIC.835
*ENDIF TROPIC.836
TROPIC.837
TROPIC.838
TROPIC.839
TROPIC.840
ENDDO ! OVER ITBT TROPIC.841
C TROPIC.842
C======================================================================= TROPIC.843
C END OF BAROTROPIC LOOP TROPIC.844
C======================================================================= TROPIC.845
C TROPIC.846
TROPIC.847
*IF DEF,MPP TROPIC.848
C TROPIC.849
C===================================================================== TROPIC.850
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION TROPIC.851
C===================================================================== TROPIC.852
C TROPIC.853
CALL SWAPBOUNDS(UBTBBC,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.854
CALL SWAPBOUNDS(VBTBBC,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) TROPIC.855
TROPIC.856
*ENDIF TROPIC.857
TROPIC.858
TROPIC.859
IF (L_OTIMER) CALL TIMER('TROPIC ',4) TROPIC.860
TROPIC.861
RETURN TROPIC.862
END TROPIC.863
*ENDIF TROPIC.864