SUBROUTINE MED_OUTFLOW( ,6MED_OUTF.45
*CALL ARGSIZE 
MED_OUTF.46
*CALL ARGD1 MED_OUTF.47
*CALL ARGDUMO MED_OUTF.48
*CALL ARGPTRO MED_OUTF.49
*CALL ARGOCALL MED_OUTF.50
*CALL ARGOINDX MED_OUTF.51
& NSLAB_ARG MED_OUTF.52
& ,ATTEND MED_OUTF.53
& ,tendfrc OJG1F404.60
& ) MED_OUTF.54
C MED_OUTF.55
c Subroutine med_outflow. Calculate the tracer tendencies produced MED_OUTF.56
C by the Mediterranean outflow parameterization. These tendencies are MED_OUTF.57
C passed to TRACER to update TA. MED_OUTF.58
c MED_OUTF.59
c MED_OUTF.60
IMPLICIT NONE MED_OUTF.61
C MED_OUTF.62
*CALL TYPSIZE MED_OUTF.63
*CALL OARRYSIZ MED_OUTF.64
*CALL TYPD1 MED_OUTF.65
*CALL TYPDUMO MED_OUTF.66
*CALL TYPPTRO MED_OUTF.67
*CALL TYPOINDX PXORDER.27
*CALL TYPOCALL MED_OUTF.68
*CALL OTIMER MED_OUTF.70
MED_OUTF.71
C Input and Output variables MED_OUTF.72
REAL ATTEND(KM,NT,4) ! Will contain the tracer tendencies for MED_OUTF.73
C both Atlantic and Med points MED_OUTF.74
MED_OUTF.75
C Input variables MED_OUTF.76
INTEGER NSLAB_ARG MED_OUTF.77
REAL tendfrc ! Fraction of gridboxes mixed OJG1F404.61
MED_OUTF.78
C Local variables MED_OUTF.79
INTEGER PE_RECV,PE_SEND,tag,info ! variables used in MPP coding MED_OUTF.80
MED_OUTF.81
INTEGER MED_OUTF.82
+ m,k,n ! indexing variables MED_OUTF.83
+, index_med(4) ! used for indexing points in slab MED_OUTF.84
+, jread_med ! local row to read data from dump MED_OUTF.85
+, LABS_MED ! Unit number for disk, depends if mixing timestep MED_OUTF.86
&, nmedpt ! Number of points mixed OJG1F404.62
&, imedpt ! Loop index over such points OJG1F404.63
&, kmoffset ! Offset into slab of data OJG1F404.64
MED_OUTF.87
REAL MED_OUTF.88
+ FXA1,FXA2,FXB1,FXB2,FX ! local constants MED_OUTF.89
+, TMED(KM,NT) ! mean tracer value of Atl and Med points MED_OUTF.90
MED_OUTF.92
REAL MED_OUTF.93
& TBMED(NSLAB_ARG),TBPMED(NSLAB_ARG) ! slabs read from dump for MED_OUTF.94
&, TBPPMED(NSLAB_ARG),TBPPPMED(NSLAB_ARG) ! rows needed for calc MED_OUTF.95
MED_OUTF.96
REAL MED_OUTF.97
& dytcst2,dytcst3,dytcst4 ! dyt*cst for j's on their PE's MED_OUTF.98
MED_OUTF.99
C*-------------------------------------------------------------------- MED_OUTF.100
C BEGIN EXECUTABLE CODE MED_OUTF.101
C--------------------------------------------------------------------- MED_OUTF.102
IF (L_OTIMER) CALL TIMER('MEDOUT',103) GPB8F405.102
MED_OUTF.107
C these variables will hold tracer values from possibly remote PE's MED_OUTF.108
do n=1,nslab MED_OUTF.109
TBMED(n)=0. MED_OUTF.110
TBPMED(n)=0. MED_OUTF.111
TBPPMED(n)=0. MED_OUTF.112
TBPPPMED(n)=0. MED_OUTF.113
enddo MED_OUTF.114
C MED_OUTF.115
C set label of disk to read, dependent on mixing timestep MED_OUTF.116
IF (MIX.EQ.1) THEN MED_OUTF.117
LABS_MED=LABS(NDISK) MED_OUTF.118
ELSE MED_OUTF.119
LABS_MED=LABS(NDISKB) MED_OUTF.120
ENDIF MED_OUTF.121
MED_OUTF.122
C the following code reads data from (possibly) remote processors, and MED_OUTF.123
C sends it back to the processor that will calculate the Med outflow MED_OUTF.124
C tendencies. Read TB if not mixing timestep, else read T. MED_OUTF.125
MED_OUTF.126
*IF DEF,MPP MED_OUTF.127
IF ((JST.LE.jmout(2)).AND.(JFIN.GE.jmout(2))) THEN MED_OUTF.128
jread_med=jmout(2)-J_OFFSET MED_OUTF.129
*ELSE MED_OUTF.130
jread_med=jmout(2) MED_OUTF.131
*ENDIF MED_OUTF.132
MED_OUTF.133
C MED_OUTF.134
C Get tracers for J=jmout(2) MED_OUTF.135
C MED_OUTF.136
CALL UMREAD( MED_OUTF.137
*CALL ARGSIZE MED_OUTF.138
*CALL ARGD1 MED_OUTF.139
*CALL ARGDUMO MED_OUTF.140
*CALL ARGPTRO MED_OUTF.141
& LABS_MED,jread_med,TBPMED MED_OUTF.142
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) MED_OUTF.143
MED_OUTF.144
dytcst2=DYT(jread_med)*CST(jread_med) MED_OUTF.145
*IF DEF,MPP MED_OUTF.146
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.147
PE_RECV = J_PE_IND_MED(1) MED_OUTF.148
CALL GC_RSEND(6001,nslab,pe_recv,info,tbpmed,tbpmed) MED_OUTF.149
ENDIF MED_OUTF.150
ENDIF ! on jmout(2) PE MED_OUTF.151
MED_OUTF.152
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.153
MED_OUTF.154
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.155
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.156
PE_SEND = J_PE_IND_MED(2) MED_OUTF.157
CALL GC_RRECV(6001,nslab,pe_send,info,tbpmed,tbpmed) MED_OUTF.158
endif MED_OUTF.159
ENDIF MED_OUTF.160
MED_OUTF.161
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.162
MED_OUTF.163
IF ((JST.LE.jmout(2)).AND.(JFIN.GE.jmout(2))) THEN MED_OUTF.164
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.165
CALL GC_RSEND(6002,1,pe_recv,info,dytcst2,dytcst2) MED_OUTF.166
ENDIF MED_OUTF.167
ENDIF ! on jmout(2) PE MED_OUTF.168
MED_OUTF.169
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.170
MED_OUTF.171
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.172
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.173
PE_SEND = J_PE_IND_MED(2) MED_OUTF.174
CALL GC_RRECV(6002,1,pe_send,info,dytcst2,dytcst2) MED_OUTF.175
endif MED_OUTF.176
ENDIF MED_OUTF.177
MED_OUTF.178
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.179
*ENDIF MED_OUTF.180
MED_OUTF.181
*IF DEF,MPP MED_OUTF.182
IF ((JST.LE.jmout(3)).AND.(JFIN.GE.jmout(3))) THEN MED_OUTF.183
jread_med=jmout(3)-J_OFFSET MED_OUTF.184
*ELSE MED_OUTF.185
jread_med=jmout(3) MED_OUTF.186
*ENDIF MED_OUTF.187
C MED_OUTF.188
C Get tracers for J=jmout(3) MED_OUTF.189
C MED_OUTF.190
CALL UMREAD( MED_OUTF.191
*CALL ARGSIZE MED_OUTF.192
*CALL ARGD1 MED_OUTF.193
*CALL ARGDUMO MED_OUTF.194
*CALL ARGPTRO MED_OUTF.195
& LABS_MED,jread_med,TBPPMED MED_OUTF.196
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) MED_OUTF.197
MED_OUTF.198
dytcst3=DYT(jread_med)*CST(jread_med) MED_OUTF.199
*IF DEF,MPP MED_OUTF.200
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3)) THEN MED_OUTF.201
PE_RECV = J_PE_IND_MED(1) MED_OUTF.202
CALL GC_RSEND(6003,nslab,pe_recv,info,tbppmed,tbppmed) MED_OUTF.203
ENDIF MED_OUTF.204
ENDIF ! on jmout(3) PE MED_OUTF.205
MED_OUTF.206
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.207
MED_OUTF.208
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3) OJG1F404.65
& .and.jmout(3).ne.0) THEN OJG1F404.66
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.210
PE_SEND = J_PE_IND_MED(3) MED_OUTF.211
CALL GC_RRECV(6003,nslab,pe_send,info,tbppmed,tbppmed) MED_OUTF.212
endif MED_OUTF.213
ENDIF MED_OUTF.214
MED_OUTF.215
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.216
MED_OUTF.217
IF ((JST.LE.jmout(3)).AND.(JFIN.GE.jmout(3))) THEN MED_OUTF.218
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3)) THEN MED_OUTF.219
PE_RECV = J_PE_IND_MED(1) MED_OUTF.220
CALL GC_RSEND(6004,1,pe_recv,info,dytcst3,dytcst3) MED_OUTF.221
ENDIF MED_OUTF.222
ENDIF ! on jmout(3) PE MED_OUTF.223
MED_OUTF.224
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.225
MED_OUTF.226
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3) OJG1F404.67
& .and.jmout(3).ne.0) THEN OJG1F404.68
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.228
PE_SEND = J_PE_IND_MED(3) MED_OUTF.229
CALL GC_RRECV(6004,1,pe_send,info,dytcst3,dytcst3) MED_OUTF.230
endif MED_OUTF.231
ENDIF MED_OUTF.232
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.233
*ENDIF MED_OUTF.234
MED_OUTF.235
*IF DEF,MPP MED_OUTF.236
IF ((JST.LE.jmout(4)).AND.(JFIN.GE.jmout(4))) THEN MED_OUTF.237
jread_med=jmout(4)-J_OFFSET MED_OUTF.238
*ELSE MED_OUTF.239
jread_med=jmout(4) MED_OUTF.240
*ENDIF MED_OUTF.241
C MED_OUTF.242
C Get tracers for J=jmout(4) MED_OUTF.243
C MED_OUTF.244
CALL UMREAD( MED_OUTF.245
*CALL ARGSIZE MED_OUTF.246
*CALL ARGD1 MED_OUTF.247
*CALL ARGDUMO MED_OUTF.248
*CALL ARGPTRO MED_OUTF.249
& LABS_MED,jread_med,TBPPPMED MED_OUTF.250
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) MED_OUTF.251
C MED_OUTF.252
dytcst4=DYT(jread_med)*CST(jread_med) MED_OUTF.253
*IF DEF,MPP MED_OUTF.254
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4)) THEN MED_OUTF.255
PE_RECV = J_PE_IND_MED(1) MED_OUTF.256
CALL GC_RSEND(6005,nslab,pe_recv,info,tbpppmed,tbpppmed) MED_OUTF.257
ENDIF MED_OUTF.258
ENDIF ! on jmout(4) PE MED_OUTF.259
MED_OUTF.260
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.261
MED_OUTF.262
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4) OJG1F404.69
& .and.jmout(4).ne.0) THEN OJG1F404.70
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.264
PE_SEND = J_PE_IND_MED(4) MED_OUTF.265
CALL GC_RRECV(6005,nslab,pe_send,info,tbpppmed,tbpppmed) MED_OUTF.266
endif MED_OUTF.267
ENDIF MED_OUTF.268
MED_OUTF.269
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.270
MED_OUTF.271
IF ((JST.LE.jmout(4)).AND.(JFIN.GE.jmout(4))) THEN MED_OUTF.272
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4)) THEN MED_OUTF.273
PE_RECV = J_PE_IND_MED(1) MED_OUTF.274
CALL GC_RSEND(6006,1,pe_recv,info,dytcst4,dytcst4) MED_OUTF.275
ENDIF MED_OUTF.276
ENDIF ! on jmout(4) PE MED_OUTF.277
MED_OUTF.278
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.279
MED_OUTF.280
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4) OJG1F404.71
& .and.jmout(4).ne.0) THEN OJG1F404.72
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.282
PE_SEND = J_PE_IND_MED(4) MED_OUTF.283
CALL GC_RRECV(6006,1,pe_send,info,dytcst4,dytcst4) MED_OUTF.284
endif MED_OUTF.285
ENDIF MED_OUTF.286
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.287
*ENDIF MED_OUTF.288
MED_OUTF.289
*IF DEF,MPP MED_OUTF.290
C do the Med outflow calculation on this PE MED_OUTF.291
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.292
jread_med=jmout(1)-J_OFFSET MED_OUTF.293
*ELSE MED_OUTF.294
jread_med=jmout(1) MED_OUTF.295
*ENDIF MED_OUTF.296
C MED_OUTF.297
C Get tracers for J=jmout(1) MED_OUTF.298
C MED_OUTF.299
CALL UMREAD( MED_OUTF.300
*CALL ARGSIZE MED_OUTF.301
*CALL ARGD1 MED_OUTF.302
*CALL ARGDUMO MED_OUTF.303
*CALL ARGPTRO MED_OUTF.304
& LABS_MED,jread_med,TBMED MED_OUTF.305
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) MED_OUTF.306
MED_OUTF.307
C MED_OUTF.308
C Do Mediterranean Outflow calculations MED_OUTF.309
C-------------------------------------- MED_OUTF.310
MED_OUTF.311
C On first row with a med mixing point, calculate areas MED_OUTF.312
C of each box. MED_OUTF.313
c MED_OUTF.314
FXA1=DXT(imout(1))*DYT(jread_med)*CST(jread_med) MED_OUTF.315
FXA2=DXT(imout(2))*dytcst2 MED_OUTF.316
if (jmout(3).eq.0) then OJG1F404.73
nmedpt=2 OJG1F404.74
FX=1.0/(FXA1+FXA2) OJG1F404.75
else OJG1F404.76
FXB1=DXT(imout(3))*dytcst3 OJG1F404.77
FXB2=DXT(imout(4))*dytcst4 OJG1F404.78
nmedpt=4 OJG1F404.79
FX=1.0/(FXA1+FXA2+FXB1+FXB2) OJG1F404.80
endif OJG1F404.81
C MED_OUTF.319
C Define mixed value (lagged one timestep), and compute mixing MED_OUTF.320
C tendencies at Atlantic and Med points. MED_OUTF.321
C MED_OUTF.322
DO M=1,NT MED_OUTF.324
DO K=1,NMEDLEV MED_OUTF.325
kmoffset=((k-1)*imt)+((m-1)*imt*km) OJG1F404.82
do imedpt=1,nmedpt OJG1F404.83
index_med(imedpt)=imout(imedpt)+kmoffset OJG1F404.84
enddo OJG1F404.85
attend(k,m,1)=TBMED(index_med(1)) OJG1F404.86
attend(k,m,2)=TBPMED(index_med(2)) OJG1F404.87
if (nmedpt.eq.2) then OJG1F404.88
tmed(k,m)=FX*(FXA1*ATTEND(k,m,1)+FXA2*ATTEND(k,m,2)) OJG1F404.89
else OJG1F404.90
attend(k,m,3)=TBPPMED(index_med(3)) OJG1F404.91
attend(k,m,4)=TBPPPMED(index_med(4)) OJG1F404.92
tmed(k,m)=FX*(FXA1*ATTEND(k,m,1)+FXA2*ATTEND(k,m,2) OJG1F404.93
& + FXB1*ATTEND(k,m,3)+FXB2*ATTEND(k,m,4)) OJG1F404.94
endif OJG1F404.95
do imedpt=1,nmedpt OJG1F404.96
attend(k,m,imedpt)=tendfrc*(TMED(K,M)-ATTEND(k,m,imedpt)) OJG1F404.97
enddo OJG1F404.98
ENDDO MED_OUTF.338
ENDDO MED_OUTF.339
MED_OUTF.340
c then need to send the values in ATTEND back to the MED_OUTF.341
c appropriate processors MED_OUTF.342
MED_OUTF.343
*IF DEF,MPP MED_OUTF.344
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.345
PE_RECV = J_PE_IND_MED(2) MED_OUTF.346
CALL GC_RSEND(6007,km*nt*4,pe_recv,info,attend,attend) MED_OUTF.347
ENDIF MED_OUTF.348
endif ! on processor local to jmout(1) MED_OUTF.349
MED_OUTF.350
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.351
MED_OUTF.352
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(2)) THEN MED_OUTF.353
if ((jst.le.jmout(2)).and.(jfin.ge.jmout(2))) then MED_OUTF.354
PE_SEND = J_PE_IND_MED(1) MED_OUTF.355
CALL GC_RRECV(6007,km*nt*4,pe_send,info,attend,attend) MED_OUTF.356
endif MED_OUTF.357
ENDIF MED_OUTF.358
MED_OUTF.359
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.360
MED_OUTF.361
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.362
MED_OUTF.363
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3) OJG1F404.99
& .and.jmout(3).ne.0) THEN OJG1F404.100
PE_RECV = J_PE_IND_MED(3) MED_OUTF.365
CALL GC_RSEND(6008,km*nt*4,pe_recv,info,attend,attend) MED_OUTF.366
ENDIF MED_OUTF.367
OJG1F404.101
endif ! on processor local to jmout(1) MED_OUTF.368
MED_OUTF.369
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.370
MED_OUTF.371
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(3)) THEN MED_OUTF.372
if ((jst.le.jmout(3)).and.(jfin.ge.jmout(3))) then MED_OUTF.373
PE_SEND = J_PE_IND_MED(1) MED_OUTF.374
CALL GC_RRECV(6008,km*nt*4,pe_send,info,attend,attend) MED_OUTF.375
endif MED_OUTF.376
ENDIF MED_OUTF.377
MED_OUTF.378
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.379
MED_OUTF.380
if ((jst.le.jmout(1)).and.(jfin.ge.jmout(1))) then MED_OUTF.381
MED_OUTF.382
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4) OJG1F404.102
& .and.jmout(4).ne.0) THEN OJG1F404.103
PE_RECV = J_PE_IND_MED(4) MED_OUTF.384
CALL GC_RSEND(6009,km*nt*4,pe_recv,info,attend,attend) MED_OUTF.385
ENDIF MED_OUTF.386
MED_OUTF.387
endif ! on processor local to jmout(1) MED_OUTF.388
MED_OUTF.389
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.390
MED_OUTF.391
IF (J_PE_IND_MED(1).NE.J_PE_IND_MED(4)) THEN MED_OUTF.392
if ((jst.le.jmout(4)).and.(jfin.ge.jmout(4))) then MED_OUTF.393
PE_SEND = J_PE_IND_MED(1) MED_OUTF.394
CALL GC_RRECV(6009,km*nt*4,pe_send,info,attend,attend) MED_OUTF.395
endif MED_OUTF.396
ENDIF MED_OUTF.397
MED_OUTF.398
CALL GC_GSYNC(O_NPROC,INFO) MED_OUTF.399
MED_OUTF.400
*ENDIF MED_OUTF.401
MED_OUTF.402
MED_OUTF.403
IF (L_OTIMER) CALL TIMER('MEDOUT',104) GPB8F405.103
MED_OUTF.405
RETURN MED_OUTF.406
END MED_OUTF.407
MED_OUTF.408
*ENDIF MED_OUTF.409