SUBROUTINE MEADCALC(L_OHMEAD,L_OISOPYC,MEADTEST,SF_MEAD 1MEADCALC.20
& ,L_OISOMOM,diff_fn OOM1F405.137
& ,LPL_MEAD,J,JMMD MEADCALC.21
& ,IMT,IMT_IPD,KM_IPD,NT_IPD MEADCALC.22
& ,ITEM,JMT,KM MEADCALC.23
& ,KMU,LSEGC,LDIV,NT,O_MAX_TRACERS MEADCALC.24
& ,SIREL_MEAD,TRACER_XREF, MEADCALC.25
*CALL ARGOCMEA 
MEADCALC.26
& DYUR,CONV_MEAD MEADCALC.27
& ,ESAV,FM MEADCALC.28
& ,DXT,DZ,CS,DXU,DXTK MEADCALC.29
& ,TP,T,V MEADCALC.30
& ,MEAD_DIAG MEADCALC.31
&) MEADCALC.32
MEADCALC.33
! MEADCALC.34
! Description: This subroutine handles the calculation of MEAD MEADCALC.35
! diagnostics previously held in ROWCALC. MEADCALC.36
! MEADCALC.37
! MEADCALC.38
! Author: R. Hill MEADCALC.39
! MEADCALC.40
! Date: September 1997 MEADCALC.41
! MEADCALC.42
! Modification History MEADCALC.43
! MEADCALC.44
! Date Name Description MEADCALC.45
! ------ ---------- ------------------------------------------ MEADCALC.46
! MEADCALC.47
!################################################################### MEADCALC.48
MEADCALC.49
IMPLICIT NONE MEADCALC.50
MEADCALC.51
*CALL COCNINDX MEADCALC.52
MEADCALC.53
!---------------------------------------------------------------------- MEADCALC.54
! Variables coming in/out of this subroutine. MEADCALC.55
!---------------------------------------------------------------------- MEADCALC.56
MEADCALC.57
INTEGER IMT MEADCALC.58
& ,IMT_IPD,KM_IPD,NT_IPD MEADCALC.59
& ,JMT MEADCALC.60
& ,JMMD MEADCALC.61
& ,KM MEADCALC.62
& ,KMU(IMT) MEADCALC.63
& ,LSEGC MEADCALC.64
& ,LDIV MEADCALC.65
& ,NT MEADCALC.66
& ,O_MAX_TRACERS MEADCALC.67
& ,SIREL_MEAD(O_MAX_TRACERS) !Pointers to STASHWS relative MEADCALC.68
! to SI(211,30) MEADCALC.69
& ,TRACER_XREF(O_MAX_TRACERS) !Maps model tracers to MEADCALC.70
! Cox tracers MEADCALC.71
MEADCALC.72
LOGICAL L_OHMEAD MEADCALC.73
& ,L_OISOPYC MEADCALC.74
& ,MEADTEST ! True if mead diags selected for any tracer MEADCALC.75
& ,SF_MEAD(O_MAX_TRACERS) !Stash flags for Mead MEADCALC.76
! diagnostics MEADCALC.77
& ,LPL_MEAD(LSEGC*4,O_MAX_TRACERS) !Pseudo levels indicator MEADCALC.78
& ,L_OISOMOM ! Griffies iso diff OOM1F405.138
MEADCALC.79
*CALL UMSCALAR MEADCALC.80
*CALL TYPOCMEA MEADCALC.81
MEADCALC.82
REAL CONV_MEAD(O_MAX_TRACERS) ! Conversion factor for SI units MEADCALC.83
& ,ESAV(IMT_IPD,KM_IPD,NT_IPD) MEADCALC.84
& ,diff_fn(imt,km,nt,0:1) OOM1F405.139
& ,FM(IMT,KM) ! Land mask for T points MEADCALC.85
& ,DXT(IMT) ! Spacing of T points along row MEADCALC.86
& ,DXU(IMT) ! Spacing of U points along row MEADCALC.87
& ,DXTK(IMT,KM) ! Intermediate value MEADCALC.88
! (for grid spacing) MEADCALC.89
& ,DYUR(JMT) ! Reciprocal spacing of U/V gridpts MEADCALC.90
& ,DZ(KM) ! Vertical grid spacing (U/V/T) MEADCALC.91
& ,TP(IMT,KM,NT) MEADCALC.92
& ,T(IMT,KM,NT) MEADCALC.93
& ,V(IMT,KM) MEADCALC.94
& ,CS(JMT) ! Cosine at row - U grid MEADCALC.95
& ,MEAD_DIAG(*) ! OUT - The mead diagnostics MEADCALC.96
MEADCALC.97
MEADCALC.98
!----------------------------------------------------------------------- MEADCALC.99
! Local variables to this routine. MEADCALC.100
!----------------------------------------------------------------------- MEADCALC.101
MEADCALC.102
INTEGER I,J,K,L,M,N MEADCALC.103
& ,ICS,ICE ! Start/end indices for tracer tnspt integrn MEADCALC.104
& ,LD MEADCALC.105
& ,IKM MEADCALC.106
& ,ITEM MEADCALC.107
& ,PL_COUNT ! Pseudo-level counter MEADCALC.108
& ,KZI(IMT) ! Bottom level in Mead calculation MEADCALC.109
MEADCALC.110
REAL DHTC MEADCALC.111
& ,TBR1(KM,LSEGC,NT) ! ZONAL MEAN TRACER VALUE MEADCALC.112
& ,VBR1(KM,LSEGC) ! ZONAL SUM OF MERIDIONAL VELOCITY MEADCALC.113
& ,SUMDX(KM) ! TOTAL ZONAL SPAN OF OCEAN BOXES MEADCALC.114
! AT EACH LEVEL MEADCALC.115
& ,TTN_MEAD(4,LSEGC,NT) ! Value of TTN for MEAD MEADCALC.116
! diagnostics. MEADCALC.117
& ,TSUM ! Intermediate value -tracer MEADCALC.118
! transport summing MEADCALC.119
& ,VBRPT(IMT,KM) ! Intermediate value for "Mead" MEADCALC.120
! diagnostics MEADCALC.121
MEADCALC.122
LOGICAL LAND ! True if land MEADCALC.123
MEADCALC.124
!----------------------------------------------------------------------- MEADCALC.125
MEADCALC.126
! MEAD TRACER TRANSPORT DIAGNOSTICS MEADCALC.127
IF (MEADTEST.AND.J+J_OFFSET.LT.JMTM1_GLOBAL) THEN MEADCALC.128
MEADCALC.129
IF (.NOT.(L_OISOPYC))THEN MEADCALC.130
MEADCALC.131
!--- DEFINE COEFFT USED IN CALCULATION OF DIFFUSIVE TRACER TRANSPORTS MEADCALC.132
DHTC=AH*DYUR(J) MEADCALC.133
ENDIF MEADCALC.134
MEADCALC.135
!--- ZERO ARRAY USED TO STORE TRACER TRANSPORTS AT EACH LATITUDE MEADCALC.136
DO M=1,NT MEADCALC.137
DO N=1,4 MEADCALC.138
DO L=1,LSEGC MEADCALC.139
TTN_MEAD(N,L,M)=0.0 MEADCALC.140
ENDDO ! over N MEADCALC.141
ENDDO ! over L MEADCALC.142
ENDDO ! over M MEADCALC.143
MEADCALC.144
DO 4160 L=1,LSEGC MEADCALC.145
MEADCALC.146
!*--- L=1..INDIAN OCEAN; L=2..PACIFIC; L=3..ATLANTIC; L=4..GLOBAL OCEAN MEADCALC.147
DO K=1,KM MEADCALC.148
VBR1(K,L)=0.0 MEADCALC.149
SUMDX(K)=0.0 MEADCALC.150
ENDDO MEADCALC.151
DO M=1,NT MEADCALC.152
DO K=1,KM MEADCALC.153
TBR1(K,L,M)=0.0 MEADCALC.154
ENDDO MEADCALC.155
ENDDO MEADCALC.156
MEADCALC.157
!*--- AVOID CALCULATIONS IF ALL BASIN SEGMENTS CONTAIN LAND MEADCALC.158
LAND=.true. MEADCALC.159
DO LD=1,LDIV MEADCALC.160
IF (ISHT(J,L,LD).NE.0) LAND=.false. MEADCALC.161
ENDDO MEADCALC.162
MEADCALC.163
IF ( LAND ) GO TO 4160 MEADCALC.164
!*--- ESTABLISH START AND STOP INDICES FOR BASIN SEGMENTS (ICS,ICE) MEADCALC.165
DO 4130 LD=1,LDIV MEADCALC.166
ICS=ISHT(J,L,LD) MEADCALC.167
IF (ICS.EQ.0) GO TO 4130 MEADCALC.168
ICE=IEHT(J,L,LD) MEADCALC.169
!*--- MEADCALC.170
!*--- CALCULATE TRACER TRANSPORTS MEADCALC.171
!*--- MEADCALC.172
!*--- PERFORM INTEGRATIONS ACROSS BASIN SEGMENT MEADCALC.173
DO M=1,NT MEADCALC.174
MEADCALC.175
IF (L_OISOPYC) THEN MEADCALC.176
IF (L_OISOMOM) THEN OOM1F405.140
DO K=1,KM OOM1F405.141
DO I=ICS,ICE OOM1F405.142
TTN_MEAD(3,L,M)=TTN_MEAD(3,L,M)-diff_fn(I,K,M,0)* OOM1F405.143
& FM(I,K)*DXT(I)*DZ(K) OOM1F405.144
END DO ! I=ICS,ICE OOM1F405.145
ENDDO ! over K OOM1F405.146
ELSE OOM1F405.147
DO K=1,KM MEADCALC.177
DO I=ICS,ICE MEADCALC.178
TTN_MEAD(3,L,M)=TTN_MEAD(3,L,M)- MEADCALC.179
& ESAV(I,K,M)*FM(I,K)*DXT(I)*DZ(K) MEADCALC.180
ENDDO ! I=ICS,ICE MEADCALC.181
ENDDO ! over K MEADCALC.182
ENDIF ! L_OISOMOM OOM1F405.148
ELSE MEADCALC.183
DO K=1,KM MEADCALC.184
DO I=ICS,ICE MEADCALC.185
TTN_MEAD(3,L,M)=TTN_MEAD(3,L,M)-DHTC* MEADCALC.186
& (TP(I,K,M)-T(I,K,M))*DXT(I)*CS(J)*DZ(K) MEADCALC.187
ENDDO ! I=ICS,ICE MEADCALC.188
ENDDO ! over K MEADCALC.189
ENDIF MEADCALC.190
MEADCALC.191
ENDDO ! over M MEADCALC.192
MEADCALC.193
!*--- CALCULATE OCEAN DEPTH AT TRACER TRANSPORT CALCULATION POINTS MEADCALC.194
!*--- AS MAXIMUM OF DEPTHS AT TWO ADJACENT U,V POINTS MEADCALC.195
DO I=ICS,ICE MEADCALC.196
IKM=I MEADCALC.197
IF (KMU(I-1).GT.KMU(I)) IKM=I-1 MEADCALC.198
KZI(I)=KMU(IKM) MEADCALC.199
ENDDO ! I MEADCALC.200
MEADCALC.201
!*--- VBR1 WILL CONTAIN ZONAL SUM OF NORTHWARD CURRENT MEADCALC.202
DO K=1,KM MEADCALC.203
DO I=ICS,ICE MEADCALC.204
IF (K.LE.KZI(I)) THEN MEADCALC.205
VBRPT(I,K)=(V(I,K)*DXU(I)+V(I-1,K)* MEADCALC.206
& DXU(I-1))*CS(J) MEADCALC.207
DXTK(I,K)=DXT(I) MEADCALC.208
ELSE MEADCALC.209
VBRPT(I,K)=0.0 MEADCALC.210
DXTK(I,K)=0.0 MEADCALC.211
ENDIF MEADCALC.212
ENDDO ! I MEADCALC.213
ENDDO ! K MEADCALC.214
MEADCALC.215
DO K=1,KM MEADCALC.216
DO I=ICS,ICE MEADCALC.217
VBR1(K,L)=VBR1(K,L)+VBRPT(I,K) MEADCALC.218
SUMDX(K)=SUMDX(K)+DXTK(I,K) MEADCALC.219
ENDDO ! I MEADCALC.220
ENDDO ! K MEADCALC.221
MEADCALC.222
DO M=1,NT MEADCALC.223
DO K=1,KM MEADCALC.224
DO I=ICS,ICE MEADCALC.225
!*--- TOTAL TRACER TRANSPORT MEADCALC.226
TSUM=T(I,K,M)+TP(I,K,M) MEADCALC.227
TTN_MEAD(4,L,M)=TTN_MEAD(4,L,M)+ MEADCALC.228
& VBRPT(I,K)*TSUM*0.25*DZ(K) MEADCALC.229
!*--- TBR1 WILL CONTAIN ZONAL MEAN TRACER VALUE MEADCALC.230
TBR1(K,L,M)=TBR1(K,L,M)+TSUM*DXTK(I,K) MEADCALC.231
ENDDO MEADCALC.232
ENDDO MEADCALC.233
ENDDO MEADCALC.234
MEADCALC.235
!*--- INTEGRATIONS ACROSS BASIN SEGMENT COMPLETED MEADCALC.236
4130 CONTINUE MEADCALC.237
MEADCALC.238
DO M=1,NT MEADCALC.239
DO K=1,KM MEADCALC.240
IF(SUMDX(K).GT.0.0) TBR1(K,L,M)=TBR1(K,L,M)/SUMDX(K) MEADCALC.241
!*--- CALCULATE OVERTURNING TRANSPORT MEADCALC.242
TTN_MEAD(2,L,M)=TTN_MEAD(2,L,M)+VBR1(K,L)* MEADCALC.243
& TBR1(K,L,M)*0.25*DZ(K) MEADCALC.244
ENDDO ! Over K MEADCALC.245
MEADCALC.246
!*--- CALCULATE GYRE TRANSPORT MEADCALC.247
TTN_MEAD(1,L,M)=TTN_MEAD(4,L,M)-TTN_MEAD(2,L,M) MEADCALC.248
MEADCALC.249
!*--- CALCULATE TOTAL (ADVECTIVE + DIFFUSIVE) TRACER TRANSPORT MEADCALC.250
TTN_MEAD(4,L,M)=TTN_MEAD(4,L,M)+TTN_MEAD(3,L,M) MEADCALC.251
ENDDO ! Over M MEADCALC.252
4160 CONTINUE MEADCALC.253
MEADCALC.254
!*--- COPY DIAGNOSTICS TO STASH WORKSPACE. CONVERT TEMPERATURE TRANSPORT MEADCALC.255
!*--- TO HEAT TRANSPORT IN WATTS, SALT TRANSPORT TO KG/S. MEADCALC.256
DO item=1,O_MAX_TRACERS MEADCALC.257
IF (SF_MEAD(item)) THEN MEADCALC.258
DO L=1,LSEGC MEADCALC.259
DO N=1,4 MEADCALC.260
pl_count = (L-1)*4+N MEADCALC.261
IF (Lpl_mead(pl_count,item)) THEN MEADCALC.262
mead_diag(sirel_mead(item) - 1 + MEADCALC.263
& (pl_count-1)*(J_JMTM1-J_1+1)+J-O_NS_HALO)= MEADCALC.264
& TTN_MEAD(N,L,tracer_xref(item))* MEADCALC.265
& conv_mead(item) MEADCALC.266
ENDIF MEADCALC.267
ENDDO MEADCALC.268
ENDDO MEADCALC.269
ENDIF MEADCALC.270
ENDDO MEADCALC.271
MEADCALC.272
ENDIF ! if meadtest=true MEADCALC.273
MEADCALC.274
RETURN MEADCALC.275
END MEADCALC.276
*ENDIF MEADCALC.277