pkg/diagnostics/diagnostics_fill_state.F

c90c060abd Ed H*0001 #include "DIAG_OPTIONS.h"
ab685e6b35 Jean*0002
c83206cd4e Jean*0003 CBOP
                0004 C     !ROUTINE: DIAGNOSTICS_FILL_STATE
                0005 C     !INTERFACE:
8ce775c441 Jean*0006       SUBROUTINE DIAGNOSTICS_FILL_STATE( selectVars, myIter, myThid )
c90c060abd Ed H*0007
c83206cd4e Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE DIAGNOSTICS_FILL_STATE
                0011 C     | o Fill-in main code, state-variables diagnostics
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     == Global variables ===
2e735ea21e Andr*0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
d316948822 Andr*0020 #include "PARAMS.h"
2e735ea21e Andr*0021 #include "GRID.h"
0ef6d0142d Jean*0022 #include "SURFACE.h"
5b0d80d77c Jean*0023 #include "DYNVARS.h"
                0024 #include "NH_VARS.h"
8ce775c441 Jean*0025 #ifdef ALLOW_GENERIC_ADVDIFF
                0026 # include "GAD.h"
                0027 #endif
2e735ea21e Andr*0028
c83206cd4e Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     == Routine arguments ==
                0031 C     selectVars :: select which group of dianostics variables to fill-in
                0032 C            = 1 :: fill-in diagnostics for tracer   variables only
                0033 C            = 2 :: fill-in diagnostics for momentum variables only
                0034 C            = 3 :: fill-in diagnostics for momentum & tracer variables
7b936be362 Andr*0035 C            = 4 :: fill-in state variable tendency diagnostics the second time
8ce775c441 Jean*0036 C     myIter     :: current Iteration number
c83206cd4e Jean*0037 C     myThid     :: my Thread Id number
9ba8ef70b1 Jean*0038       INTEGER selectVars
8ce775c441 Jean*0039       INTEGER myIter
9ba8ef70b1 Jean*0040       INTEGER myThid
ab685e6b35 Jean*0041
                0042 #ifdef ALLOW_DIAGNOSTICS
c83206cd4e Jean*0043 C     !LOCAL VARIABLES:
                0044 C     == Local variables ==
337bea277a Jean*0045       LOGICAL  DIAGNOSTICS_IS_ON
                0046       EXTERNAL DIAGNOSTICS_IS_ON
                0047       _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0048       _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
06349ecfd7 Jean*0049       _RL tmpU (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       _RL tmpV (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84d01e10aa Jean*0051       _RL tmpFac, uBarC, vBarC
b21f2d376f Jean*0052 #ifdef ALLOW_FIZHI
d316948822 Andr*0053       _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
b21f2d376f Jean*0054 #endif
8ce775c441 Jean*0055 #ifdef ALLOW_ADAMSBASHFORTH_3
                0056       INTEGER m1
                0057 #endif
                0058       INTEGER i,j,k,bi,bj
337bea277a Jean*0059       INTEGER km1
9ba8ef70b1 Jean*0060
7b936be362 Andr*0061       IF ( selectVars.EQ.2 .OR. selectVars.EQ.3 ) THEN
c83206cd4e Jean*0062 C--   fill momentum state-var diagnostics:
                0063
62f9c88755 Jean*0064         CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)
ee04343829 Andr*0065
                0066         IF ( DIAGNOSTICS_IS_ON('RSURF   ',myThid) ) THEN
                0067          DO bj = myByLo(myThid), myByHi(myThid)
                0068           DO bi = myBxLo(myThid), myBxHi(myThid)
                0069            DO j = 1,sNy
                0070             DO i = 1,sNx
                0071               tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
                0072             ENDDO
                0073            ENDDO
                0074           ENDDO
                0075          ENDDO
                0076          CALL DIAGNOSTICS_FILL(tmp1k,'RSURF   ',0,1,0,1,1,myThid)
                0077         ENDIF
                0078
d9055b137d Jean*0079         CALL DIAGNOSTICS_SCALE_FILL( etaN, oneRL, 2,
62f9c88755 Jean*0080      &                              'ETANSQ  ',0, 1,0,1,1,myThid)
9ba8ef70b1 Jean*0081
d9055b137d Jean*0082         CALL DIAGNOSTICS_SCALE_FILL( dEtaHdt, oneRL, 2,
62f9c88755 Jean*0083      &                              'DETADT2 ',0, 1,0,1,1,myThid)
5b0d80d77c Jean*0084 #ifdef ALLOW_NONHYDROSTATIC
                0085         IF ( use3Dsolver ) THEN
                0086           CALL DIAGNOSTICS_FILL( phi_nh,'PHI_NH  ',0,Nr,0,1,1,myThid )
                0087         ENDIF
                0088 #endif
9ba8ef70b1 Jean*0089
ff78c25591 Jean*0090         IF ( nonlinFreeSurf.GT.0 ) THEN
                0091          CALL DIAGNOSTICS_FILL_RS( hFacW,'hFactorW',0,Nr,0,1,1,myThid )
                0092          CALL DIAGNOSTICS_FILL_RS( hFacS,'hFactorS',0,Nr,0,1,1,myThid )
                0093         ENDIF
                0094
c83206cd4e Jean*0095         CALL DIAGNOSTICS_FILL(uVel, 'UVEL    ',0,Nr,0,1,1,myThid)
                0096         CALL DIAGNOSTICS_FILL(vVel, 'VVEL    ',0,Nr,0,1,1,myThid)
                0097         CALL DIAGNOSTICS_FILL(wVel, 'WVEL    ',0,Nr,0,1,1,myThid)
9ba8ef70b1 Jean*0098
d9055b137d Jean*0099         CALL DIAGNOSTICS_SCALE_FILL( uVel, oneRL, 2,
62f9c88755 Jean*0100      &                              'UVELSQ  ',0,Nr,0,1,1,myThid)
d9055b137d Jean*0101         CALL DIAGNOSTICS_SCALE_FILL( vVel, oneRL, 2,
62f9c88755 Jean*0102      &                              'VVELSQ  ',0,Nr,0,1,1,myThid)
d9055b137d Jean*0103         CALL DIAGNOSTICS_SCALE_FILL( wVel, oneRL, 2,
62f9c88755 Jean*0104      &                              'WVELSQ  ',0,Nr,0,1,1,myThid)
                0105
c83206cd4e Jean*0106 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0107
06349ecfd7 Jean*0108         IF ( DIAGNOSTICS_IS_ON('UE_VEL_C',myThid) .OR.
                0109      &       DIAGNOSTICS_IS_ON('VN_VEL_C',myThid) .OR.
                0110      &       DIAGNOSTICS_IS_ON('UV_VEL_C',myThid) ) THEN
c83206cd4e Jean*0111          DO bj = myByLo(myThid), myByHi(myThid)
                0112           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0113            DO k=1,Nr
337bea277a Jean*0114             DO j = 1,sNy
c83206cd4e Jean*0115              DO i = 1,sNx
84d01e10aa Jean*0116               uBarC = 0.5 _d 0
8ce775c441 Jean*0117      &           *(uVel(i,j,k,bi,bj)+uVel(i+1,j,k,bi,bj))
84d01e10aa Jean*0118               vBarC = 0.5 _d 0
8ce775c441 Jean*0119      &           *(vVel(i,j,k,bi,bj)+vVel(i,j+1,k,bi,bj))
06349ecfd7 Jean*0120               tmpU(i,j) = angleCosC(i,j,bi,bj)*uBarC
                0121      &                   -angleSinC(i,j,bi,bj)*vBarC
                0122               tmpV(i,j) = angleSinC(i,j,bi,bj)*uBarC
                0123      &                   +angleCosC(i,j,bi,bj)*vBarC
8ce775c441 Jean*0124               tmpMk(i,j,k,bi,bj) = tmpU(i,j)*tmpV(i,j)
c83206cd4e Jean*0125              ENDDO
337bea277a Jean*0126             ENDDO
06349ecfd7 Jean*0127             CALL DIAGNOSTICS_FILL(tmpU,'UE_VEL_C',k,1,2,bi,bj,myThid)
                0128             CALL DIAGNOSTICS_FILL(tmpV,'VN_VEL_C',k,1,2,bi,bj,myThid)
c83206cd4e Jean*0129            ENDDO
337bea277a Jean*0130           ENDDO
c83206cd4e Jean*0131          ENDDO
                0132          CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_C',0,Nr,0,1,1,myThid)
                0133         ENDIF
9ba8ef70b1 Jean*0134
c83206cd4e Jean*0135         IF ( DIAGNOSTICS_IS_ON('UV_VEL_Z',myThid) ) THEN
                0136          DO bj = myByLo(myThid), myByHi(myThid)
                0137           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0138            DO k=1,Nr
c83206cd4e Jean*0139             DO j = 1,sNy+1
                0140              DO i = 1,sNx+1
8ce775c441 Jean*0141               tmpMk(i,j,k,bi,bj) = 0.25 _d 0
                0142      &           *(uVel(i,j-1,k,bi,bj)+uVel(i,j,k,bi,bj))
                0143      &           *(vVel(i-1,j,k,bi,bj)+vVel(i,j,k,bi,bj))
c83206cd4e Jean*0144              ENDDO
337bea277a Jean*0145             ENDDO
c83206cd4e Jean*0146            ENDDO
337bea277a Jean*0147           ENDDO
c83206cd4e Jean*0148          ENDDO
                0149          CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_Z',0,Nr,0,1,1,myThid)
                0150         ENDIF
9ba8ef70b1 Jean*0151
6df3568a20 Jean*0152         IF ( DIAGNOSTICS_IS_ON('WU_VEL  ',myThid) ) THEN
                0153          DO bj = myByLo(myThid), myByHi(myThid)
                0154           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0155            DO k=1,Nr
6df3568a20 Jean*0156             km1 = MAX(k-1,1)
                0157             DO j = 1,sNy
                0158              DO i = 1,sNx+1
8ce775c441 Jean*0159               tmpMk(i,j,k,bi,bj) = 0.25 _d 0
                0160      &           *(uVel(i,j,km1,bi,bj)+uVel(i,j,k,bi,bj))
                0161      &           *(wVel(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
                0162      &            +wVel( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
6df3568a20 Jean*0163      &            )*recip_rAw(i,j,bi,bj)
                0164              ENDDO
                0165             ENDDO
                0166            ENDDO
                0167           ENDDO
                0168          ENDDO
                0169          CALL DIAGNOSTICS_FILL(tmpMk,'WU_VEL  ',0,Nr,0,1,1,myThid)
                0170         ENDIF
                0171
                0172         IF ( DIAGNOSTICS_IS_ON('WV_VEL  ',myThid) ) THEN
                0173          DO bj = myByLo(myThid), myByHi(myThid)
                0174           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0175            DO k=1,Nr
6df3568a20 Jean*0176             km1 = MAX(k-1,1)
                0177             DO j = 1,sNy+1
                0178              DO i = 1,sNx
8ce775c441 Jean*0179               tmpMk(i,j,k,bi,bj) = 0.25 _d 0
                0180      &           *(vVel(i,j,km1,bi,bj)+vVel(i,j,k,bi,bj))
                0181      &           *(wVel(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
                0182      &            +wVel(i, j ,k,bi,bj)*rA(i, j ,bi,bj)
6df3568a20 Jean*0183      &            )*recip_rAs(i,j,bi,bj)
                0184              ENDDO
                0185             ENDDO
                0186            ENDDO
                0187           ENDDO
                0188          ENDDO
                0189          CALL DIAGNOSTICS_FILL(tmpMk,'WV_VEL  ',0,Nr,0,1,1,myThid)
                0190         ENDIF
                0191
c83206cd4e Jean*0192 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0193
                0194         IF ( DIAGNOSTICS_IS_ON('UVELTH  ',myThid) ) THEN
                0195          DO bj = myByLo(myThid), myByHi(myThid)
                0196           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0197            DO k=1,Nr
337bea277a Jean*0198             DO j = 1,sNy
c83206cd4e Jean*0199              DO i = 1,sNx+1
8ce775c441 Jean*0200                tmpMk(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)*0.5 _d 0
                0201      &                  *(theta(i,j,k,bi,bj)+theta(i-1,j,k,bi,bj))
c83206cd4e Jean*0202              ENDDO
337bea277a Jean*0203             ENDDO
c83206cd4e Jean*0204            ENDDO
337bea277a Jean*0205           ENDDO
c83206cd4e Jean*0206          ENDDO
                0207          CALL DIAGNOSTICS_FILL(tmpMk,'UVELTH  ',0,Nr,0,1,1,myThid)
                0208         ENDIF
9ba8ef70b1 Jean*0209
c83206cd4e Jean*0210         IF ( DIAGNOSTICS_IS_ON('VVELTH  ',myThid) ) THEN
                0211          DO bj = myByLo(myThid), myByHi(myThid)
                0212           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0213            DO k=1,Nr
c83206cd4e Jean*0214             DO j = 1,sNy+1
                0215              DO i = 1,sNx
8ce775c441 Jean*0216                tmpMk(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)*0.5 _d 0
                0217      &                  *(theta(i,j,k,bi,bj)+theta(i,j-1,k,bi,bj))
c83206cd4e Jean*0218              ENDDO
337bea277a Jean*0219             ENDDO
c83206cd4e Jean*0220            ENDDO
337bea277a Jean*0221           ENDDO
c83206cd4e Jean*0222          ENDDO
                0223          CALL DIAGNOSTICS_FILL(tmpMk,'VVELTH  ',0,Nr,0,1,1,myThid)
                0224         ENDIF
9ba8ef70b1 Jean*0225
c83206cd4e Jean*0226         IF ( DIAGNOSTICS_IS_ON('WVELTH  ',myThid) ) THEN
                0227          DO bj = myByLo(myThid), myByHi(myThid)
                0228           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0229            DO k=1,Nr
47146cb74f Ed H*0230             km1 = MAX(k-1,1)
337bea277a Jean*0231             DO j = 1,sNy
c83206cd4e Jean*0232              DO i = 1,sNx
8ce775c441 Jean*0233                tmpMk(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)*0.5 _d 0
                0234      &                  *(theta(i,j,k,bi,bj)+theta(i,j,km1,bi,bj))
c83206cd4e Jean*0235              ENDDO
337bea277a Jean*0236             ENDDO
c83206cd4e Jean*0237            ENDDO
337bea277a Jean*0238           ENDDO
c83206cd4e Jean*0239          ENDDO
                0240          CALL DIAGNOSTICS_FILL(tmpMk,'WVELTH  ',0,Nr,0,1,1,myThid)
                0241         ENDIF
9ba8ef70b1 Jean*0242
c83206cd4e Jean*0243         IF ( DIAGNOSTICS_IS_ON('UVELSLT ',myThid) ) THEN
                0244          DO bj = myByLo(myThid), myByHi(myThid)
                0245           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0246            DO k=1,Nr
337bea277a Jean*0247             DO j = 1,sNy
c83206cd4e Jean*0248              DO i = 1,sNx+1
8ce775c441 Jean*0249                tmpMk(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)*0.5 _d 0
                0250      &                  *(salt(i,j,k,bi,bj)+salt(i-1,j,k,bi,bj))
c83206cd4e Jean*0251              ENDDO
337bea277a Jean*0252             ENDDO
c83206cd4e Jean*0253            ENDDO
337bea277a Jean*0254           ENDDO
c83206cd4e Jean*0255          ENDDO
                0256          CALL DIAGNOSTICS_FILL(tmpMk,'UVELSLT ',0,Nr,0,1,1,myThid)
                0257         ENDIF
9ba8ef70b1 Jean*0258
c83206cd4e Jean*0259         IF ( DIAGNOSTICS_IS_ON('VVELSLT ',myThid) ) THEN
                0260          DO bj = myByLo(myThid), myByHi(myThid)
                0261           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0262            DO k=1,Nr
c83206cd4e Jean*0263             DO j = 1,sNy+1
                0264              DO i = 1,sNx
8ce775c441 Jean*0265                tmpMk(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)*0.5 _d 0
                0266      &                  *(salt(i,j,k,bi,bj)+salt(i,j-1,k,bi,bj))
c83206cd4e Jean*0267              ENDDO
337bea277a Jean*0268             ENDDO
c83206cd4e Jean*0269            ENDDO
337bea277a Jean*0270           ENDDO
c83206cd4e Jean*0271          ENDDO
                0272          CALL DIAGNOSTICS_FILL(tmpMk,'VVELSLT ',0,Nr,0,1,1,myThid)
                0273         ENDIF
2e735ea21e Andr*0274
c83206cd4e Jean*0275         IF ( DIAGNOSTICS_IS_ON('WVELSLT ',myThid) ) THEN
                0276          DO bj = myByLo(myThid), myByHi(myThid)
                0277           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0278            DO k=1,Nr
47146cb74f Ed H*0279             km1 = MAX(k-1,1)
337bea277a Jean*0280             DO j = 1,sNy
c83206cd4e Jean*0281              DO i = 1,sNx
8ce775c441 Jean*0282                tmpMk(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)*0.5 _d 0
                0283      &                  *(salt(i,j,k,bi,bj)+salt(i,j,km1,bi,bj))
c83206cd4e Jean*0284              ENDDO
337bea277a Jean*0285             ENDDO
c83206cd4e Jean*0286            ENDDO
337bea277a Jean*0287           ENDDO
c83206cd4e Jean*0288          ENDDO
                0289          CALL DIAGNOSTICS_FILL(tmpMk,'WVELSLT ',0,Nr,0,1,1,myThid)
                0290         ENDIF
9ba8ef70b1 Jean*0291
fefa9e1c60 Andr*0292         IF ( DIAGNOSTICS_IS_ON('UVELPHI ',myThid) ) THEN
                0293          DO bj = myByLo(myThid), myByHi(myThid)
                0294           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0295            DO k=1,Nr
fefa9e1c60 Andr*0296             DO j = 1,sNy
                0297              DO i = 1,sNx+1
8ce775c441 Jean*0298                tmpMk(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj)
                0299      &       *0.5 _d 0*(totPhiHyd(i,j,k,bi,bj)+totPhiHyd(i-1,j,k,bi,bj))
fefa9e1c60 Andr*0300              ENDDO
                0301             ENDDO
                0302            ENDDO
                0303           ENDDO
                0304          ENDDO
                0305          CALL DIAGNOSTICS_FILL(tmpMk,'UVELPHI ',0,Nr,0,1,1,myThid)
                0306         ENDIF
9ba8ef70b1 Jean*0307
fefa9e1c60 Andr*0308         IF ( DIAGNOSTICS_IS_ON('VVELPHI ',myThid) ) THEN
                0309          DO bj = myByLo(myThid), myByHi(myThid)
                0310           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0311            DO k=1,Nr
fefa9e1c60 Andr*0312             DO j = 1,sNy+1
                0313              DO i = 1,sNx
8ce775c441 Jean*0314                tmpMk(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj)
                0315      &       *0.5 _d 0*(totPhiHyd(i,j,k,bi,bj)+totPhiHyd(i,j-1,k,bi,bj))
fefa9e1c60 Andr*0316              ENDDO
                0317             ENDDO
                0318            ENDDO
                0319           ENDDO
                0320          ENDDO
                0321          CALL DIAGNOSTICS_FILL(tmpMk,'VVELPHI ',0,Nr,0,1,1,myThid)
                0322         ENDIF
9ba8ef70b1 Jean*0323
ee8b184348 Jean*0324         IF ( DIAGNOSTICS_IS_ON('RCENTER ',myThid) ) THEN
e4ea461a62 Andr*0325          DO bj = myByLo(myThid), myByHi(myThid)
                0326           DO bi = myBxLo(myThid), myBxHi(myThid)
57630d677b Jean*0327            DO j = 1,sNy
                0328             DO i = 1,sNx
                0329               tmp1k(i,j,bi,bj) = R_low(i,j,bi,bj)
                0330             ENDDO
                0331            ENDDO
                0332            DO k = Nr,1,-1
                0333             DO j = 1,sNy
                0334              DO i = 1,sNx
                0335               tmpMk(i,j,k,bi,bj) = tmp1k(i,j,bi,bj)
b6c3833a19 Jean*0336      &             + (rF(k+1)-rC(k))*hFacC(i,j,k,bi,bj)*rkSign
4c2a1393c6 Jean*0337 C         above: more general (setInterFDr/setCenterDr) than line below
                0338 c    &                      + drF(k)*hFacC(i,j,k,bi,bj)*0.5 _d 0
57630d677b Jean*0339               tmp1k(i,j,bi,bj) =   tmp1k(i,j,bi,bj)
                0340      &                      + drF(k)*hFacC(i,j,k,bi,bj)
                0341              ENDDO
                0342             ENDDO
                0343            ENDDO
e4ea461a62 Andr*0344           ENDDO
                0345          ENDDO
ee8b184348 Jean*0346          CALL DIAGNOSTICS_FILL(tmpMk,'RCENTER ',0,Nr,0,1,1,myThid)
e4ea461a62 Andr*0347         ENDIF
                0348
7b936be362 Andr*0349 C First fill sequence for state variable tendency diagnostics: subtract state variable
                0350 C NOTE: send a '0' for the bibjflag and allow counter to be incremented
                0351 C     (next fill for these diagnostics will NOT allow counter to be incremented)
                0352
d9055b137d Jean*0353         tmpFac = -86400. _d 0/deltaTMom
                0354         CALL DIAGNOSTICS_SCALE_FILL( uVel, tmpFac, 1,
                0355      &                              'TOTUTEND',0,Nr,0,1,1,myThid )
                0356         CALL DIAGNOSTICS_SCALE_FILL( vVel, tmpFac, 1,
                0357      &                              'TOTVTEND',0,Nr,0,1,1,myThid )
9ba8ef70b1 Jean*0358
7b936be362 Andr*0359         IF ( DIAGNOSTICS_IS_ON('TOTTTEND',myThid) ) THEN
                0360          DO bj = myByLo(myThid), myByHi(myThid)
                0361           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0362            DO k=1,Nr
d9055b137d Jean*0363             tmpFac = -86400. _d 0/dTtracerLev(k)
7b936be362 Andr*0364             DO j = 1,sNy
                0365              DO i = 1,sNx
d9055b137d Jean*0366                tmpMk(i,j,k,bi,bj) = tmpFac*theta(i,j,k,bi,bj)
7b936be362 Andr*0367              ENDDO
                0368             ENDDO
                0369            ENDDO
                0370           ENDDO
                0371          ENDDO
                0372          CALL DIAGNOSTICS_FILL(tmpMk,'TOTTTEND',0,Nr,0,1,1,myThid)
edd113ba3f Ryan*0373 #ifdef ALLOW_LAYERS
                0374          IF ( useLayers ) THEN
                0375            CALL LAYERS_FILL(tmpMk,1,'TOT',0,Nr,0,1,1,myThid)
                0376          ENDIF
ff78c25591 Jean*0377 #endif /* ALLOW_LAYERS */
7b936be362 Andr*0378         ENDIF
9ba8ef70b1 Jean*0379
7b936be362 Andr*0380         IF ( DIAGNOSTICS_IS_ON('TOTSTEND',myThid) ) THEN
                0381          DO bj = myByLo(myThid), myByHi(myThid)
                0382           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0383            DO k=1,Nr
d9055b137d Jean*0384             tmpFac = -86400. _d 0/dTtracerLev(k)
7b936be362 Andr*0385             DO j = 1,sNy
                0386              DO i = 1,sNx
d9055b137d Jean*0387                tmpMk(i,j,k,bi,bj) = tmpFac*salt(i,j,k,bi,bj)
7b936be362 Andr*0388              ENDDO
                0389             ENDDO
                0390            ENDDO
                0391           ENDDO
                0392          ENDDO
                0393          CALL DIAGNOSTICS_FILL(tmpMk,'TOTSTEND',0,Nr,0,1,1,myThid)
edd113ba3f Ryan*0394 #ifdef ALLOW_LAYERS
                0395          IF ( useLayers ) THEN
                0396            CALL LAYERS_FILL(tmpMk,2,'TOT',0,Nr,0,1,1,myThid)
                0397          ENDIF
                0398 #endif /* ALLOW_LAYERS */
7b936be362 Andr*0399         ENDIF
                0400
c83206cd4e Jean*0401 C--   fill momentum state-var diagnostics: end
337bea277a Jean*0402       ENDIF
c83206cd4e Jean*0403
                0404 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0405
                0406       IF ( selectVars.EQ.1 .OR. selectVars.EQ.3 ) THEN
                0407 C--   fill tracer state-var diagnostics:
                0408
ff78c25591 Jean*0409         IF ( nonlinFreeSurf.GT.0 ) THEN
                0410          CALL DIAGNOSTICS_FILL_RS( hFacC,'hFactorC',0,Nr,0,1,1,myThid )
                0411         ENDIF
                0412
c83206cd4e Jean*0413         CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)
                0414         CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)
62f9c88755 Jean*0415
d316948822 Andr*0416 #ifdef ALLOW_FIZHI
8ce775c441 Jean*0417       IF ( useFIZHI .AND. DIAGNOSTICS_IS_ON('RELHUM  ',myThid) ) THEN
d316948822 Andr*0418        kappa = getcon('KAPPA')
8ce775c441 Jean*0419        DO bj = myByLo(myThid), myByHi(myThid)
                0420         DO bi = myBxLo(myThid), myBxHi(myThid)
                0421          DO j = 1,sNy
                0422           DO i = 1,sNx
                0423            DO k = 1,Nr
                0424             dummy1 = theta(i,j,k,bi,bj) * ((rC(k)/100.)/1000.)**kappa
                0425             dummy2 = rC(k) / 100.
                0426             CALL QSAT(dummy1,dummy2,dummy3,dummy4,.false.)
                0427             tmpMk(i,j,k,bi,bj) = hFacC(i,j,k,bi,bj)
                0428      &                          *salt(i,j,k,bi,bj)*100. / dummy3
                0429            ENDDO
                0430           ENDDO
                0431          ENDDO
                0432         ENDDO
                0433        ENDDO
d316948822 Andr*0434        CALL DIAGNOSTICS_FILL(tmpMk, 'RELHUM  ',0,Nr,0,1,1,myThid)
                0435       ENDIF
                0436 #endif /* ALLOW_FIZHI */
                0437
d9055b137d Jean*0438         CALL DIAGNOSTICS_SCALE_FILL( theta, oneRL, 2,
62f9c88755 Jean*0439      &                              'THETASQ ',0,Nr,0,1,1,myThid)
d9055b137d Jean*0440         CALL DIAGNOSTICS_SCALE_FILL( salt, oneRL, 2,
62f9c88755 Jean*0441      &                              'SALTSQ  ',0,Nr,0,1,1,myThid)
9ba8ef70b1 Jean*0442
8ce775c441 Jean*0443 #ifdef ALLOW_GENERIC_ADVDIFF
                0444 # ifdef ALLOW_ADAMSBASHFORTH_3
                0445       IF ( selectVars.EQ.1 ) THEN
                0446 C-    stagger time-step: fill diags after updating myIter
                0447         m1 = 1 + MOD(myIter,2)
                0448       ELSE
                0449 C-    synchronous time-step: fill diags before updating myIter
                0450         m1 = 1 + MOD(myIter+1,2)
                0451       ENDIF
                0452       IF ( AdamsBashforthGt )
                0453      & CALL DIAGNOSTICS_FILL( gtNm(1-OLx,1-OLy,1,1,1,m1),
                0454      &                        'gTinAB  ',0,Nr,0,1,1,myThid )
                0455       IF ( AdamsBashforthGs )
                0456      & CALL DIAGNOSTICS_FILL( gsNm(1-OLx,1-OLy,1,1,1,m1),
                0457      &                        'gSinAB  ',0,Nr,0,1,1,myThid )
                0458 # else /* ALLOW_ADAMSBASHFORTH_3 */
                0459       IF ( AdamsBashforthGt )
                0460      & CALL DIAGNOSTICS_FILL( gtNm1,'gTinAB  ',0,Nr,0,1,1,myThid )
                0461       IF ( AdamsBashforthGs )
                0462      & CALL DIAGNOSTICS_FILL( gsNm1,'gSinAB  ',0,Nr,0,1,1,myThid )
                0463 # endif /* ALLOW_ADAMSBASHFORTH_3 */
                0464 #endif /* ALLOW_GENERIC_ADVDIFF */
                0465
b21f2d376f Jean*0466 c       IF ( DIAGNOSTICS_IS_ON('SST     ',myThid) ) THEN
                0467 c        DO bj = myByLo(myThid), myByHi(myThid)
                0468 c         DO bi = myBxLo(myThid), myBxHi(myThid)
                0469 c          DO j = 1,sNy
                0470 c           DO i = 1,sNx
                0471 c             tmp1k(i,j,bi,bj) = THETA(i,j,1,bi,bj)
                0472 c           ENDDO
                0473 c          ENDDO
                0474 c         ENDDO
                0475 c        ENDDO
                0476 c        CALL DIAGNOSTICS_FILL(tmp1k,'SST     ',0,1,0,1,1,myThid)
                0477 c       ENDIF
9ba8ef70b1 Jean*0478
b21f2d376f Jean*0479 c       IF ( DIAGNOSTICS_IS_ON('SSS     ',myThid) ) THEN
                0480 c        DO bj = myByLo(myThid), myByHi(myThid)
                0481 c         DO bi = myBxLo(myThid), myBxHi(myThid)
                0482 c          DO j = 1,sNy
                0483 c           DO i = 1,sNx
                0484 c             tmp1k(i,j,bi,bj) = SALT(i,j,1,bi,bj)
                0485 c           ENDDO
                0486 c          ENDDO
                0487 c         ENDDO
                0488 c        ENDDO
                0489 c        CALL DIAGNOSTICS_FILL(tmp1k,'SSS     ',0,1,0,1,1,myThid)
                0490 c       ENDIF
c83206cd4e Jean*0491
9ba8ef70b1 Jean*0492         IF ( fluidIsWater .AND.
                0493      &       ( DIAGNOSTICS_IS_ON('SALTanom',myThid)
                0494      &     .OR.DIAGNOSTICS_IS_ON('SALTSQan',myThid) ) ) THEN
23753a76a9 Dimi*0495          DO bj = myByLo(myThid), myByHi(myThid)
                0496           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0497            DO k=1,Nr
23753a76a9 Dimi*0498             DO j = 1,sNy
                0499              DO i = 1,sNx
8ce775c441 Jean*0500                tmpMk(i,j,k,bi,bj) = salt(i,j,k,bi,bj)-35. _d 0
23753a76a9 Dimi*0501              ENDDO
                0502             ENDDO
                0503            ENDDO
                0504           ENDDO
                0505          ENDDO
9ba8ef70b1 Jean*0506          CALL DIAGNOSTICS_FILL( tmpMk,'SALTanom',0,Nr,0,1,1,myThid)
d9055b137d Jean*0507          CALL DIAGNOSTICS_SCALE_FILL( tmpMk, oneRL, 2,
9ba8ef70b1 Jean*0508      &                                'SALTSQan',0,Nr,0,1,1,myThid)
23753a76a9 Dimi*0509         ENDIF
9ba8ef70b1 Jean*0510
c83206cd4e Jean*0511 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0512
                0513         IF ( DIAGNOSTICS_IS_ON('UVELMASS',myThid) ) THEN
                0514          DO bj = myByLo(myThid), myByHi(myThid)
                0515           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0516            DO k=1,Nr
337bea277a Jean*0517             DO j = 1,sNy
e2067c2922 Jean*0518               DO i = 1,sNx+1
8ce775c441 Jean*0519                 tmpMk(i,j,k,bi,bj)
                0520      &               = uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj)
337bea277a Jean*0521               ENDDO
                0522             ENDDO
c83206cd4e Jean*0523            ENDDO
337bea277a Jean*0524           ENDDO
c83206cd4e Jean*0525          ENDDO
                0526          CALL DIAGNOSTICS_FILL(tmpMk,'UVELMASS',0,Nr,0,1,1,myThid)
                0527         ENDIF
2e735ea21e Andr*0528
c83206cd4e Jean*0529         IF ( DIAGNOSTICS_IS_ON('VVELMASS',myThid) ) THEN
                0530          DO bj = myByLo(myThid), myByHi(myThid)
                0531           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0532            DO k=1,Nr
e2067c2922 Jean*0533             DO j = 1,sNy+1
337bea277a Jean*0534               DO i = 1,sNx
8ce775c441 Jean*0535                 tmpMk(i,j,k,bi,bj)
                0536      &               = vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj)
337bea277a Jean*0537               ENDDO
                0538             ENDDO
c83206cd4e Jean*0539            ENDDO
337bea277a Jean*0540           ENDDO
c83206cd4e Jean*0541          ENDDO
                0542          CALL DIAGNOSTICS_FILL(tmpMk,'VVELMASS',0,Nr,0,1,1,myThid)
                0543         ENDIF
2e735ea21e Andr*0544
c83206cd4e Jean*0545         CALL DIAGNOSTICS_FILL(wVel, 'WVELMASS',0,Nr,0,1,1,myThid)
                0546
                0547         IF ( DIAGNOSTICS_IS_ON('UTHMASS ',myThid) ) THEN
                0548          DO bj = myByLo(myThid), myByHi(myThid)
                0549           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0550            DO k=1,Nr
337bea277a Jean*0551             DO j = 1,sNy
c83206cd4e Jean*0552              DO i = 1,sNx+1
8ce775c441 Jean*0553                tmpMk(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)*0.5 _d 0
                0554      &                  *(theta(i,j,k,bi,bj)+theta(i-1,j,k,bi,bj))
                0555      &                  * hFacW(i,j,k,bi,bj)
c83206cd4e Jean*0556              ENDDO
337bea277a Jean*0557             ENDDO
c83206cd4e Jean*0558            ENDDO
337bea277a Jean*0559           ENDDO
c83206cd4e Jean*0560          ENDDO
                0561          CALL DIAGNOSTICS_FILL(tmpMk,'UTHMASS ',0,Nr,0,1,1,myThid)
                0562         ENDIF
2e735ea21e Andr*0563
c83206cd4e Jean*0564         IF ( DIAGNOSTICS_IS_ON('VTHMASS ',myThid) ) THEN
                0565          DO bj = myByLo(myThid), myByHi(myThid)
                0566           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0567            DO k=1,Nr
c83206cd4e Jean*0568             DO j = 1,sNy+1
                0569              DO i = 1,sNx
8ce775c441 Jean*0570                tmpMk(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)*0.5 _d 0
                0571      &                  *(theta(i,j,k,bi,bj)+theta(i,j-1,k,bi,bj))
                0572      &                  * hFacS(i,j,k,bi,bj)
c83206cd4e Jean*0573              ENDDO
337bea277a Jean*0574             ENDDO
c83206cd4e Jean*0575            ENDDO
337bea277a Jean*0576           ENDDO
c83206cd4e Jean*0577          ENDDO
                0578          CALL DIAGNOSTICS_FILL(tmpMk,'VTHMASS ',0,Nr,0,1,1,myThid)
                0579         ENDIF
9ba8ef70b1 Jean*0580
c83206cd4e Jean*0581         IF ( DIAGNOSTICS_IS_ON('WTHMASS ',myThid) ) THEN
                0582          DO bj = myByLo(myThid), myByHi(myThid)
                0583           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0584            DO k=1,Nr
c83206cd4e Jean*0585             km1 = MAX(k-1,1)
337bea277a Jean*0586             DO j = 1,sNy
c83206cd4e Jean*0587              DO i = 1,sNx
8ce775c441 Jean*0588                tmpMk(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)*0.5 _d 0
                0589      &                  *(theta(i,j,k,bi,bj)+theta(i,j,km1,bi,bj))
c83206cd4e Jean*0590              ENDDO
                0591             ENDDO
                0592            ENDDO
                0593           ENDDO
                0594          ENDDO
                0595          CALL DIAGNOSTICS_FILL(tmpMk,'WTHMASS ',0,Nr,0,1,1,myThid)
                0596         ENDIF
                0597
                0598         IF ( DIAGNOSTICS_IS_ON('USLTMASS',myThid) ) THEN
                0599          DO bj = myByLo(myThid), myByHi(myThid)
                0600           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0601            DO k=1,Nr
c83206cd4e Jean*0602             DO j = 1,sNy
                0603              DO i = 1,sNx+1
8ce775c441 Jean*0604                tmpMk(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)*0.5 _d 0
                0605      &                  *(salt(i,j,k,bi,bj)+salt(i-1,j,k,bi,bj))
                0606      &                  * hFacW(i,j,k,bi,bj)
c83206cd4e Jean*0607              ENDDO
337bea277a Jean*0608             ENDDO
c83206cd4e Jean*0609            ENDDO
337bea277a Jean*0610           ENDDO
c83206cd4e Jean*0611          ENDDO
                0612          CALL DIAGNOSTICS_FILL(tmpMk,'USLTMASS',0,Nr,0,1,1,myThid)
                0613         ENDIF
2e735ea21e Andr*0614
c83206cd4e Jean*0615         IF ( DIAGNOSTICS_IS_ON('VSLTMASS',myThid) ) THEN
                0616          DO bj = myByLo(myThid), myByHi(myThid)
                0617           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0618            DO k=1,Nr
c83206cd4e Jean*0619             DO j = 1,sNy+1
                0620              DO i = 1,sNx
8ce775c441 Jean*0621                tmpMk(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)*0.5 _d 0
                0622      &                  *(salt(i,j,k,bi,bj)+salt(i,j-1,k,bi,bj))
                0623      &                  * hFacS(i,j,k,bi,bj)
c83206cd4e Jean*0624              ENDDO
337bea277a Jean*0625             ENDDO
c83206cd4e Jean*0626            ENDDO
337bea277a Jean*0627           ENDDO
c83206cd4e Jean*0628          ENDDO
                0629          CALL DIAGNOSTICS_FILL(tmpMk,'VSLTMASS',0,Nr,0,1,1,myThid)
                0630         ENDIF
9ba8ef70b1 Jean*0631
c83206cd4e Jean*0632         IF ( DIAGNOSTICS_IS_ON('WSLTMASS',myThid) ) THEN
                0633          DO bj = myByLo(myThid), myByHi(myThid)
                0634           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0635            DO k=1,Nr
c83206cd4e Jean*0636             km1 = MAX(k-1,1)
                0637             DO j = 1,sNy
                0638              DO i = 1,sNx
8ce775c441 Jean*0639                tmpMk(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)*0.5 _d 0
                0640      &                  *(salt(i,j,k,bi,bj)+salt(i,j,km1,bi,bj))
c83206cd4e Jean*0641              ENDDO
                0642             ENDDO
                0643            ENDDO
                0644           ENDDO
                0645          ENDDO
                0646          CALL DIAGNOSTICS_FILL(tmpMk,'WSLTMASS',0,Nr,0,1,1,myThid)
                0647         ENDIF
9ba8ef70b1 Jean*0648
c83206cd4e Jean*0649 C--   fill tracer state-var diagnostics: end
                0650       ENDIF
                0651
7b936be362 Andr*0652       IF ( selectVars.EQ.4 ) THEN
                0653 C Second fill sequence for state variable tendency diagnostics: add state variable
3ab2854677 Dimi*0654 C NOTE: send a '-1' for the bibjflag and do not increment counter
d9055b137d Jean*0655 C     (previous fill for these diagnostics DID allow counter to be incremented)
7b936be362 Andr*0656
d9055b137d Jean*0657         tmpFac = 86400. _d 0/deltaTMom
                0658         DO bj = myByLo(myThid), myByHi(myThid)
                0659          DO bi = myBxLo(myThid), myBxHi(myThid)
                0660           CALL DIAGNOSTICS_SCALE_FILL( uVel, tmpFac, 1,
                0661      &                           'TOTUTEND',0,Nr,-1,bi,bj,myThid )
                0662           CALL DIAGNOSTICS_SCALE_FILL( vVel, tmpFac, 1,
                0663      &                           'TOTVTEND',0,Nr,-1,bi,bj,myThid )
7b936be362 Andr*0664          ENDDO
d9055b137d Jean*0665         ENDDO
9ba8ef70b1 Jean*0666
7b936be362 Andr*0667         IF ( DIAGNOSTICS_IS_ON('TOTTTEND',myThid) ) THEN
                0668          DO bj = myByLo(myThid), myByHi(myThid)
                0669           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0670            DO k=1,Nr
d9055b137d Jean*0671             tmpFac = 86400. _d 0/dTtracerLev(k)
7b936be362 Andr*0672             DO j = 1,sNy
                0673              DO i = 1,sNx
d9055b137d Jean*0674                tmpMk(i,j,k,bi,bj) = tmpFac*theta(i,j,k,bi,bj)
7b936be362 Andr*0675              ENDDO
                0676             ENDDO
                0677            ENDDO
                0678            CALL DIAGNOSTICS_FILL(tmpMk,'TOTTTEND',0,Nr,-1,bi,bj,myThid)
edd113ba3f Ryan*0679 #ifdef ALLOW_LAYERS
                0680            IF ( useLayers ) THEN
                0681              CALL LAYERS_FILL(tmpMk,1,'TOT',0,Nr,-1,bi,bj,myThid)
                0682            ENDIF
ff78c25591 Jean*0683 #endif /* ALLOW_LAYERS */
7b936be362 Andr*0684           ENDDO
                0685          ENDDO
                0686         ENDIF
9ba8ef70b1 Jean*0687
7b936be362 Andr*0688         IF ( DIAGNOSTICS_IS_ON('TOTSTEND',myThid) ) THEN
                0689          DO bj = myByLo(myThid), myByHi(myThid)
                0690           DO bi = myBxLo(myThid), myBxHi(myThid)
8ce775c441 Jean*0691            DO k=1,Nr
d9055b137d Jean*0692             tmpFac = 86400. _d 0/dTtracerLev(k)
7b936be362 Andr*0693             DO j = 1,sNy
                0694              DO i = 1,sNx
d9055b137d Jean*0695                tmpMk(i,j,k,bi,bj) = tmpFac*salt(i,j,k,bi,bj)
7b936be362 Andr*0696              ENDDO
                0697             ENDDO
                0698            ENDDO
                0699            CALL DIAGNOSTICS_FILL(tmpMk,'TOTSTEND',0,Nr,-1,bi,bj,myThid)
edd113ba3f Ryan*0700 #ifdef ALLOW_LAYERS
                0701            IF ( useLayers ) THEN
                0702             CALL LAYERS_FILL(tmpMk,2,'TOT',0,Nr,-1,bi,bj,myThid)
                0703            ENDIF
ff78c25591 Jean*0704 #endif /* ALLOW_LAYERS */
7b936be362 Andr*0705           ENDDO
                0706          ENDDO
                0707         ENDIF
                0708
                0709 C--   fill state tendency diagnostics the second time: end
                0710       ENDIF
                0711
ab685e6b35 Jean*0712 #endif /* ALLOW_DIAGNOSTICS */
9ba8ef70b1 Jean*0713
                0714       RETURN
337bea277a Jean*0715       END