C $Header: /u/gcmpack/MITgcm/model/src/diags_rho.F,v 1.5 2011/11/10 21:03:35 jmc Exp $ C $Name: $ #include "PACKAGES_CONFIG.h" #include "CPP_OPTIONS.h" C-- File diags_rho.F: density & density advection diagnostics C-- Contents C-- o DIAGS_RHO_L C-- o DIAGS_RHO_G C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: DIAGS_RHO_L C !INTERFACE: SUBROUTINE DIAGS_RHO_L( I diagRho, k, bi, bj, I rho3d, rhoKm1, wFld, I myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | S/R DIAGS_RHO_L C | o Density vertical advective term diagnostics C *==========================================================* C | works with local arrays, and called inside k,bi,bj loops C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" C !INPUT/OUTPUT PARAMETERS: C == Routine Arguments == C diagRho :: select which diags to fill C k :: level index C bi, bj :: tile indices C rho3d :: in-situ density anomaly C rhoKm1 :: density of water @ level above (k-1), evaluated at pressure level k C wFld :: vertical velocity C myTime :: Current time C myIter :: Iteration number C myThid :: my Thread Id number INTEGER diagRho INTEGER k, bi, bj _RL rho3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) _RL rhoKm1(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL myTime INTEGER myIter, myThid CEOP #ifdef ALLOW_DIAGNOSTICS C !LOCAL VARIABLES: C == Local variables == C i,j :: Loop counters C tmpFld :: temporary working array INTEGER i,j _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( k.GE.2 .AND. MOD(diagRho,8).GE.4 ) THEN C-- Diagnose Vertical velocity times vertical difference C of potential density reference at level below (i.e. level k) DO j=1,sNy DO i=1,sNx tmpFld(i,j) = wFld(i,j,k,bi,bj) & *( rho3d(i,j,k) - rhoKm1(i,j) )*rkSign ENDDO ENDDO CALL DIAGNOSTICS_FILL(tmpFld,'WdRHO_P ',k,1,2,bi,bj,myThid) IF ( k.EQ.2 ) CALL DIAGNOSTICS_COUNT('WdRHO_P ',bi,bj,myThid) ENDIF IF ( k.GE.2 .AND. diagRho.GE.8 ) THEN C-- Diagnose Vertical velocity times vertical difference C of density at fixed Temp & Salt (from level above, i.e. level k-1) DO j=1,sNy DO i=1,sNx tmpFld(i,j) = wFld(i,j,k,bi,bj) & *( rhoKm1(i,j) - rho3d(i,j,k-1) )*rkSign ENDDO ENDDO CALL DIAGNOSTICS_FILL(tmpFld,'WdRHOdP ',k,1,2,bi,bj,myThid) IF ( k.EQ.2 ) CALL DIAGNOSTICS_COUNT('WdRHOdP ',bi,bj,myThid) ENDIF #endif /* ALLOW_DIAGNOSTICS */ RETURN END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: DIAGS_RHO_G C !INTERFACE: SUBROUTINE DIAGS_RHO_G( I rho3d, uFld, vFld, wFld, I myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | S/R DIAGS_RHO_G C | o Density & Density advective Flux diagnostics C *==========================================================* C | works with global arrays; k,bi,bj loops are done here C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" C !INPUT/OUTPUT PARAMETERS: C == Routine Arguments == C rho3d :: in-situ density anomaly C uFld :: zonal velocity C vFld :: meridional velocity C wFld :: vertical velocity C myTime :: Current time C myIter :: Iteration number C myThid :: my Thread Id number _RL rho3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL myTime INTEGER myIter, myThid CEOP #ifdef ALLOW_DIAGNOSTICS C !FUNCTIONS: LOGICAL DIAGNOSTICS_IS_ON EXTERNAL C !LOCAL VARIABLES: C == Local variables == C i,j :: Loop counters C k, bi,bj :: level & tile indices C tmpFld :: temporary working array INTEGER i,j INTEGER k, bi,bj _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL tmpFac C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CALL DIAGNOSTICS_FILL( rho3d, 'RHOAnoma', & 0, Nr, 0, 1, 1, myThid ) tmpFac = 1. _d 0 CALL DIAGNOSTICS_SCALE_FILL( rho3d, tmpFac, 2, & 'RHOANOSQ', 0, Nr, 0, 1, 1, myThid ) IF ( DIAGNOSTICS_IS_ON('URHOMASS',myThid) ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO k=1,Nr DO j=1,sNy DO i=1,sNx+1 tmpFld(i,j) = uFld(i,j,k,bi,bj)*_hFacW(i,j,k,bi,bj) & *(rho3d(i-1,j,k,bi,bj)+rho3d(i,j,k,bi,bj)) & *0.5 _d 0 ENDDO ENDDO CALL DIAGNOSTICS_FILL(tmpFld,'URHOMASS',k,1,2,bi,bj,myThid) ENDDO ENDDO ENDDO ENDIF IF ( DIAGNOSTICS_IS_ON('VRHOMASS',myThid) ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO k=1,Nr DO j=1,sNy+1 DO i=1,sNx tmpFld(i,j) = vFld(i,j,k,bi,bj)*_hFacS(i,j,k,bi,bj) & *(rho3d(i,j-1,k,bi,bj)+rho3d(i,j,k,bi,bj)) & *0.5 _d 0 ENDDO ENDDO CALL DIAGNOSTICS_FILL(tmpFld,'VRHOMASS',k,1,2,bi,bj,myThid) ENDDO ENDDO ENDDO ENDIF IF ( DIAGNOSTICS_IS_ON('WRHOMASS',myThid) ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO k=1,Nr IF ( k.EQ.1 ) THEN DO j=1,sNy DO i=1,sNx tmpFld(i,j) = wFld(i,j,k,bi,bj)*rho3d(i,j,k,bi,bj) ENDDO ENDDO ELSE DO j=1,sNy DO i=1,sNx tmpFld(i,j) = wFld(i,j,k,bi,bj) & *(rho3d(i,j,k-1,bi,bj)+rho3d(i,j,k,bi,bj)) & *0.5 _d 0 ENDDO ENDDO ENDIF CALL DIAGNOSTICS_FILL(tmpFld,'WRHOMASS',k,1,2,bi,bj,myThid) ENDDO ENDDO ENDDO ENDIF #endif /* ALLOW_DIAGNOSTICS */ RETURN END