SUBROUTINE ELEMENTS ( 1,26ELEMENTS.44
*CALL ARGSIZE 
ELEMENTS.45
*CALL COCAWRKA ELEMENTS.46
& ,j,cstr,dyur,dxur,dz2r,dzz2r,dzw,dtxsqr,delta_iso, ELEMENTS.47
& s_minus,s_plus,dzt2r,Ai_ez,Ai_nz,Ai_bx,Ai_by,K11,K22,K33, ELEMENTS.48
& slope_max,slmxr,adv_vetiso,adv_vbtiso,adv_fbiso,J_OFFSET) ELEMENTS.49
c ELEMENTS.50
c ELEMENTS.51
c----------------------------------------------------------------------- ELEMENTS.52
c calculate temperature and salinity expansion coefficients (alpha ELEMENTS.53
c and beta). calculate gradients on sides of T cells for the ELEMENTS.54
c the next row and update the current row ELEMENTS.55
c----------------------------------------------------------------------- ELEMENTS.56
c ELEMENTS.57
IMPLICIT NONE ELEMENTS.58
ELEMENTS.59
*CALL OARRYSIZ ELEMENTS.60
*CALL TYPSIZE ELEMENTS.61
*CALL CNTLOCN ELEMENTS.62
*CALL COCTWRKA ELEMENTS.63
*CALL COCSTATE ELEMENTS.64
ELEMENTS.65
INTEGER i,j,k,n,kp1,kr,ip,jq,m,J_OFFSET ELEMENTS.66
REAL c0,c1,p5,c2 ELEMENTS.67
REAL cstr(jmt),dyur(jmt),dxur(imt),dzt2r(km) ELEMENTS.68
REAL dzwr(0:km),dzw(0:km),dz2r(km),dzz2r(km+1) ELEMENTS.69
REAL slmx,slopec,slmxr,dtxsqr(km),delta_iso, ELEMENTS.70
& s_minus,s_plus,slope_max ELEMENTS.71
REAL tprime,sprime ELEMENTS.72
REAL tq,sq ELEMENTS.73
c REAL tbpp(imt,km,nt),fmpp(imt,km) ELEMENTS.74
ELEMENTS.75
C Isopycnal diffusion variables (see ISOPYC_M) ELEMENTS.76
REAL Ai_ez(imt_iso,km_iso,0:1,0:1),Ai_bx(imt_iso,km_iso,0:1,0:1), ELEMENTS.77
& Ai_by(imt_iso,km_iso,0:1,0:1),Ai_nz(imt_iso,km_iso,0:1,0:1), ELEMENTS.78
& K11(imt_iso,km_iso),K22(imt_iso,km_iso),K33(imt_iso,km_iso) ELEMENTS.79
ELEMENTS.80
C GM variables ELEMENTS.81
REAL adv_vetiso(imt_gmm,km_gmm), ELEMENTS.82
& adv_vbtiso(imt_gmm,0:km_gmm),adv_fbiso(imt_gmm,0:km_gmm) ELEMENTS.83
ELEMENTS.84
C External subroutines ELEMENTS.85
C DRODT ! calculate expansion coeff due to temperature ELEMENTS.86
C DRODS ! calculate expansion coeff due to salinity ELEMENTS.87
ELEMENTS.88
c0=0. ELEMENTS.89
c1=1. ELEMENTS.90
c2=2. ELEMENTS.91
p5=0.5 ELEMENTS.92
ELEMENTS.93
c----------------------------------------------------------------------- ELEMENTS.94
c initialize variables (all mixing units are cm**2/sec.) ELEMENTS.95
c----------------------------------------------------------------------- ELEMENTS.96
c ELEMENTS.97
c maximum isopycnal slope ELEMENTS.98
c ELEMENTS.99
slmx = slope_max ELEMENTS.100
c ELEMENTS.101
c set reciprocal of maximum isopycnal slope ELEMENTS.102
c ELEMENTS.103
slmxr = c1/slmx ELEMENTS.104
c ELEMENTS.105
c----------------------------------------------------------------------- ELEMENTS.106
c store the square root of the tracer timestep acceleration values ELEMENTS.107
c into variable "dtxsqr" for use in isopycnal mixing ELEMENTS.108
c this is a MOM variable related to distorted timestepping: ELEMENTS.109
c set equal to 1 ELEMENTS.110
c----------------------------------------------------------------------- ELEMENTS.111
do k=1,km ELEMENTS.112
c dtxsqr(k) = sqrt(dtxcel(k)) ELEMENTS.113
dtxsqr(k) = c1 ELEMENTS.114
enddo ELEMENTS.115
ELEMENTS.116
C delta_iso is 'isopycnal diffusion grid factor' ELEMENTS.117
C it affects the scaling when using the full tensor ELEMENTS.118
C if (delta_iso < 0.5) then tensor is rescaled if slope between s_minus ELEMENTS.119
C and s_plus ELEMENTS.120
C otherwise it is not rescaled ELEMENTS.121
ELEMENTS.122
delta_iso=0.6 ELEMENTS.123
if (delta_iso .lt. p5) then ELEMENTS.124
s_minus = (c1 - sqrt(c1 - 4.0*delta_iso**2))/(c2*delta_iso) ELEMENTS.125
s_plus = c1/s_minus ELEMENTS.126
else ELEMENTS.127
s_minus = c0 ELEMENTS.128
s_plus = c0 ELEMENTS.129
endif ELEMENTS.130
ELEMENTS.131
c----------------------------------------------------------------------- ELEMENTS.132
c initialize arrays ELEMENTS.133
c----------------------------------------------------------------------- ELEMENTS.134
c ELEMENTS.135
if (J+J_OFFSET.EQ.2) then ELEMENTS.136
c ELEMENTS.137
c======================================================================= ELEMENTS.138
c Estimate alpha, beta, and normal gradients on faces of T cells ELEMENTS.139
c for first row. Also initialise any variables which will be updated ELEMENTS.140
c row by row ELEMENTS.141
c======================================================================= ELEMENTS.142
c ELEMENTS.143
CALL DRODT(TB,TB(1,1,2),alphai(1,1,1),imt,km) ELEMENTS.144
CALL DRODS(TB,TB(1,1,2),betai(1,1,1),imt,km) ELEMENTS.145
call SETBCX (alphai(1,1,1), imt, km) ELEMENTS.146
call SETBCX (betai(1,1,1), imt, km) ELEMENTS.147
ELEMENTS.148
IF (L_OBIHARMGM) THEN ELEMENTS.149
CALL DRODT(TBP,TBP(1,1,2),alphai(1,1,2),imt,km) ELEMENTS.150
CALL DRODS(TBP,TBP(1,1,2),betai(1,1,2),imt,km) ELEMENTS.151
call SETBCX (alphai(1,1,2), imt, km) ELEMENTS.152
call SETBCX (betai(1,1,2), imt, km) ELEMENTS.153
ENDIF ELEMENTS.154
c ELEMENTS.155
do n=1,2 ELEMENTS.156
do k=1,km ELEMENTS.157
do i=1,imt-1 ELEMENTS.158
ddxt(i,k,n,1) = (((fm(i,k)*fm(i+1,k))*cstr(j))* ELEMENTS.159
& dxur(i))*(tb(i+1,k,n) - tb(i,k,n)) ELEMENTS.160
enddo ELEMENTS.161
enddo ELEMENTS.162
call SETBCX (ddxt(1,1,n,1), imt, km) ELEMENTS.163
enddo ELEMENTS.164
c ELEMENTS.165
do n=1,2 ELEMENTS.166
do k=1,km ELEMENTS.167
do i=1,imt ELEMENTS.168
ddyt(i,k,n,1) = c0 ELEMENTS.169
enddo ELEMENTS.170
enddo ELEMENTS.171
call SETBCX (ddyt(1,1,n,1), imt, km) ELEMENTS.172
enddo ELEMENTS.173
c ELEMENTS.174
IF (L_OBIHARMGM) THEN ELEMENTS.175
do n=1,2 ELEMENTS.176
do k=1,km ELEMENTS.177
do i=1,imt ELEMENTS.178
ddyt(i,k,n,2) = ((fmp(i,k)*fmpp(i,k))*dyur(j+1))* ELEMENTS.179
& (tbpp(i,k,n) - tbp(i,k,n)) ELEMENTS.180
enddo ELEMENTS.181
enddo ELEMENTS.182
call SETBCX (ddyt(1,1,n,2), imt, km) ELEMENTS.183
enddo ELEMENTS.184
ENDIF ELEMENTS.185
c ELEMENTS.186
do n=1,2 ELEMENTS.187
do k=1,km ELEMENTS.188
kp1 = min(k+1,km) ELEMENTS.189
do i=1,imt ELEMENTS.190
ddzt(i,k,n,1) = ((2.*fm(i,kp1))*dzz2r(k+1))* ELEMENTS.191
& (tb(i,k,n) - tb(i,kp1,n)) ELEMENTS.192
enddo ELEMENTS.193
enddo ELEMENTS.194
do i=1,imt ELEMENTS.195
ddzt(i,0,n,1) = c0 ELEMENTS.196
enddo ELEMENTS.197
call SETBCX (ddzt(1,0,n,1), imt, km+1) ELEMENTS.198
enddo ELEMENTS.199
c ELEMENTS.200
IF (L_OBIHARMGM) THEN ELEMENTS.201
do n=1,2 ELEMENTS.202
do k=1,km ELEMENTS.203
kp1 = min(k+1,km) ELEMENTS.204
do i=1,imt ELEMENTS.205
ddzt(i,k,n,2) = ((2.*fmp(i,kp1))*dzz2r(k+1))* ELEMENTS.206
& (tbp(i,k,n) - tbp(i,kp1,n)) ELEMENTS.207
enddo ELEMENTS.208
enddo ELEMENTS.209
do i=1,imt ELEMENTS.210
ddzt(i,0,n,2) = c0 ELEMENTS.211
enddo ELEMENTS.212
call SETBCX (ddzt(1,0,n,2), imt, km+1) ELEMENTS.213
enddo ELEMENTS.214
ENDIF ELEMENTS.215
c ELEMENTS.216
do n=1,nt ELEMENTS.217
do k=1,km ELEMENTS.218
do i=1,imt ELEMENTS.219
diff_fn(i,k,n,0)=c0 ELEMENTS.220
enddo ELEMENTS.221
enddo ELEMENTS.222
enddo ELEMENTS.223
ELEMENTS.224
IF (L_OISOGM) THEN ELEMENTS.225
do k=1,km ELEMENTS.226
do i=1,imt ELEMENTS.227
adv_vetiso(i,k) = c0 ELEMENTS.228
adv_vntiso(i,k,0) = c0 ELEMENTS.229
adv_vntiso(i,k,1) = c0 ELEMENTS.230
enddo ELEMENTS.231
enddo ELEMENTS.232
ENDIF ELEMENTS.233
c ELEMENTS.234
IF (L_OISOGM) THEN ELEMENTS.235
do k=0,km ELEMENTS.236
do i=1,imt ELEMENTS.237
adv_vbtiso(i,k) = c0 ELEMENTS.238
adv_fbiso(i,k) = c0 ELEMENTS.239
enddo ELEMENTS.240
enddo ELEMENTS.241
ENDIF ! GM scheme ELEMENTS.242
ELEMENTS.243
endif ! j+joffset=2 ELEMENTS.244
ELEMENTS.245
do k=1,km ELEMENTS.246
do i=1,imt ELEMENTS.247
Ai_ez(i,k,0,0) = c0 ELEMENTS.248
Ai_ez(i,k,0,1) = c0 ELEMENTS.249
Ai_ez(i,k,1,0) = c0 ELEMENTS.250
Ai_ez(i,k,1,1) = c0 ELEMENTS.251
Ai_bx(i,k,0,0) = c0 ELEMENTS.252
Ai_bx(i,k,0,1) = c0 ELEMENTS.253
Ai_bx(i,k,1,0) = c0 ELEMENTS.254
Ai_bx(i,k,1,1) = c0 ELEMENTS.255
Ai_by(i,k,0,0) = c0 ELEMENTS.256
Ai_by(i,k,0,1) = c0 ELEMENTS.257
Ai_by(i,k,1,0) = c0 ELEMENTS.258
Ai_by(i,k,1,1) = c0 ELEMENTS.259
Ai_nz(i,k,0,0) = c0 ELEMENTS.260
Ai_nz(i,k,0,1) = c0 ELEMENTS.261
Ai_nz(i,k,1,0) = c0 ELEMENTS.262
Ai_nz(i,k,1,1) = c0 ELEMENTS.263
K11(i,k) = c0 ELEMENTS.264
K22(i,k) = c0 ELEMENTS.265
K33(i,k) = c0 ELEMENTS.266
enddo ELEMENTS.267
enddo ELEMENTS.268
ELEMENTS.269
ELEMENTS.270
c ELEMENTS.271
C update old values of expansion coeffs and gradients with new values ELEMENTS.272
c ELEMENTS.273
do k=1,km ELEMENTS.274
do i=1,imt ELEMENTS.275
alphai(i,k,0)=alphai(i,k,1) ELEMENTS.276
betai(i,k,0)=betai(i,k,1) ELEMENTS.277
enddo ELEMENTS.278
enddo ELEMENTS.279
ELEMENTS.280
IF (L_OBIHARMGM) THEN ELEMENTS.281
do k=1,km ELEMENTS.282
do i=1,imt ELEMENTS.283
alphai(i,k,1)=alphai(i,k,2) ELEMENTS.284
betai(i,k,1)=betai(i,k,2) ELEMENTS.285
enddo ELEMENTS.286
enddo ELEMENTS.287
ENDIF ELEMENTS.288
ELEMENTS.289
do n=1,2 ELEMENTS.290
do k=0,km ELEMENTS.291
do i=1,imt ELEMENTS.292
ddzt(i,k,n,0) = ddzt(i,k,n,1) ELEMENTS.293
enddo ELEMENTS.294
enddo ELEMENTS.295
enddo ELEMENTS.296
ELEMENTS.297
IF (L_OBIHARMGM) THEN ELEMENTS.298
do n=1,2 ELEMENTS.299
do k=0,km ELEMENTS.300
do i=1,imt ELEMENTS.301
ddzt(i,k,n,1) = ddzt(i,k,n,2) ELEMENTS.302
enddo ELEMENTS.303
enddo ELEMENTS.304
enddo ELEMENTS.305
ENDIF ELEMENTS.306
ELEMENTS.307
do n=1,2 ELEMENTS.308
do k=1,km ELEMENTS.309
do i=1,imt ELEMENTS.310
ddxt(i,k,n,0) = ddxt(i,k,n,1) ELEMENTS.311
ddyt(i,k,n,0) = ddyt(i,k,n,1) ELEMENTS.312
enddo ELEMENTS.313
enddo ELEMENTS.314
enddo ELEMENTS.315
ELEMENTS.316
IF (L_OBIHARMGM) THEN ELEMENTS.317
do n=1,2 ELEMENTS.318
do k=1,km ELEMENTS.319
do i=1,imt ELEMENTS.320
ddyt(i,k,n,1) = ddyt(i,k,n,2) ELEMENTS.321
enddo ELEMENTS.322
enddo ELEMENTS.323
enddo ELEMENTS.324
ENDIF ELEMENTS.325
ELEMENTS.326
c----------------------------------------------------------------------- ELEMENTS.327
c alpha and beta at centers of T cells ELEMENTS.328
c----------------------------------------------------------------------- ELEMENTS.329
c ELEMENTS.330
IF (L_OBIHARMGM) THEN ELEMENTS.331
CALL DRODT(TBPP,TBPP(1,1,2),alphai(1,1,2),imt,km) ELEMENTS.332
CALL DRODS(TBPP,TBPP(1,1,2),betai(1,1,2),imt,km) ELEMENTS.333
call SETBCX (alphai(1,1,2), imt, km) ELEMENTS.334
call SETBCX (betai(1,1,2), imt, km) ELEMENTS.335
ELSE ELEMENTS.336
CALL DRODT(TBP,TBP(1,1,2),alphai(1,1,1),imt,km) ELEMENTS.337
CALL DRODS(TBP,TBP(1,1,2),betai(1,1,1),imt,km) ELEMENTS.338
call SETBCX (alphai(1,1,1), imt, km) ELEMENTS.339
call SETBCX (betai(1,1,1), imt, km) ELEMENTS.340
ENDIF ELEMENTS.341
ELEMENTS.342
c ELEMENTS.343
c----------------------------------------------------------------------- ELEMENTS.344
c gradients at eastern face of T cells ELEMENTS.345
c----------------------------------------------------------------------- ELEMENTS.346
c ELEMENTS.347
do n=1,2 ELEMENTS.348
do k=1,km ELEMENTS.349
do i=1,imt-1 ELEMENTS.350
ddxt(i,k,n,1) = (((fmp(i,k)*fmp(i+1,k))*cstr(j+1))* ELEMENTS.351
& dxur(i))*(tbp(i+1,k,n) - tbp(i,k,n)) ELEMENTS.352
enddo ELEMENTS.353
enddo ELEMENTS.354
call SETBCX (ddxt(1,1,n,1), imt, km) ELEMENTS.355
enddo ELEMENTS.356
c ELEMENTS.357
c----------------------------------------------------------------------- ELEMENTS.358
c gradients at northern face of T cells ELEMENTS.359
c----------------------------------------------------------------------- ELEMENTS.360
c ELEMENTS.361
IF (L_OBIHARMGM) THEN ELEMENTS.362
do n=1,2 ELEMENTS.363
do k=1,km ELEMENTS.364
kp1 = min(k+1,km) ELEMENTS.365
do i=1,imt ELEMENTS.366
ddyt(i,k,n,2) = ((fmp(i,k)*fmpp(i,k))*dyur(j+1))* ELEMENTS.367
& (tbpp(i,k,n) - tbp(i,k,n)) ELEMENTS.368
enddo ELEMENTS.369
enddo ELEMENTS.370
call SETBCX (ddyt(1,1,n,2), imt, km) ELEMENTS.371
enddo ELEMENTS.372
ELEMENTS.373
ELSE ELEMENTS.374
ELEMENTS.375
do n=1,2 ELEMENTS.376
do k=1,km ELEMENTS.377
kp1 = min(k+1,km) ELEMENTS.378
do i=1,imt ELEMENTS.379
ddyt(i,k,n,1) = ((fm(i,k)*fmp(i,k))*dyur(j))* ELEMENTS.380
& (tbp(i,k,n) - tb(i,k,n)) ELEMENTS.381
enddo ELEMENTS.382
enddo ELEMENTS.383
call SETBCX (ddyt(1,1,n,1), imt, km) ELEMENTS.384
enddo ELEMENTS.385
ENDIF ELEMENTS.386
c ELEMENTS.387
c----------------------------------------------------------------------- ELEMENTS.388
c gradients at bottom face of T cells ELEMENTS.389
c----------------------------------------------------------------------- ELEMENTS.390
c ELEMENTS.391
IF (L_OBIHARMGM) THEN ELEMENTS.392
do n=1,2 ELEMENTS.393
do k=1,km ELEMENTS.394
kp1 = min(k+1,km) ELEMENTS.395
do i=1,imt ELEMENTS.396
ddzt(i,k,n,2) = ((2.*fmpp(i,kp1))*dzz2r(k+1))* ELEMENTS.397
& (tbpp(i,k,n) - tbpp(i,kp1,n)) ELEMENTS.398
enddo ELEMENTS.399
enddo ELEMENTS.400
do i=1,imt ELEMENTS.401
ddzt(i,0,n,2) = c0 ELEMENTS.402
enddo ELEMENTS.403
call SETBCX (ddzt(1,0,n,2), imt, km+1) ELEMENTS.404
enddo ELEMENTS.405
ELEMENTS.406
ELSE ELEMENTS.407
ELEMENTS.408
do n=1,2 ELEMENTS.409
do k=1,km ELEMENTS.410
kp1 = min(k+1,km) ELEMENTS.411
do i=1,imt ELEMENTS.412
ddzt(i,k,n,1) = ((2.*fmp(i,kp1))*dzz2r(k+1))* ELEMENTS.413
& (tbp(i,k,n) - tbp(i,kp1,n)) ELEMENTS.414
enddo ELEMENTS.415
enddo ELEMENTS.416
do i=1,imt ELEMENTS.417
ddzt(i,0,n,1) = c0 ELEMENTS.418
enddo ELEMENTS.419
call SETBCX (ddzt(1,0,n,1), imt, km+1) ELEMENTS.420
enddo ELEMENTS.421
ENDIF ELEMENTS.422
ELEMENTS.423
RETURN ELEMENTS.424
END ELEMENTS.425
*ENDIF ELEMENTS.426