model/src/tracers_iigw_correction.F

159909ced3 Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: TRACERS_CORRECTION_IIGW
                0005 C     !INTERFACE:
                0006       SUBROUTINE TRACERS_IIGW_CORRECTION(
                0007      I                   bi, bj, myTime, myIter, myThid )
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | S/R TRACERS_IIGW_CORRECTION
                0011 C     | o apply correction term to Tracers due to Implicit
                0012 C     |   treatment of Internal Gravity Waves:
                0013 C-    |    -DeltaT.(w^{n+1}-w^{n})*d.Tr_{ref}/dz
                0014 C     *==========================================================*
                0015 C     \ev
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
                0024 #include "DYNVARS.h"
                0025 #ifdef ALLOW_NONHYDROSTATIC
                0026 #include "NH_VARS.h"
                0027 #endif
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     == Routine Arguments ==
                0031 C     bi,bj   :: tile indices
                0032 C     myTime  :: current time in simulation
                0033 C     myIter  :: current iteration number in simulation
                0034 C     myThid  :: my Thread Id number
                0035       INTEGER bi,bj
                0036       _RL     myTime
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039
                0040 #ifdef ALLOW_NONHYDROSTATIC
                0041 C     !LOCAL VARIABLES:
                0042 C     == Local variables ==
                0043 C     i,j,k           :: Loop counters
                0044       INTEGER i,j,k
                0045       INTEGER kp1
                0046       _RL     dTr_k, dTrp1
                0047       _RL     dW_k(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
                0048       _RL     dWp1(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
                0049 CEOP
                0050
                0051 C-    Initialise dW = w^{n+1} - w^{n} to zero:
                0052       DO j=1-Oly,sNy+Oly
                0053         DO i=1-Olx,sNx+Olx
                0054           dWp1(i,j) = 0. _d 0
                0055         ENDDO
                0056       ENDDO
                0057
                0058 C--   Start vertical loop
                0059       DO k=1,Nr
                0060
                0061 C-    Compute dW @ interface k & k+1
                0062        kp1 = MIN(k+1,Nr)
                0063        DO j=1-Oly,sNy+Oly
                0064         DO i=1-Olx,sNx+Olx
                0065           dW_k(i,j) = dWp1(i,j)
                0066           dWp1(i,j) = ( wVel(i,j,kp1,bi,bj)
                0067      &                  - gW(i,j,kp1,bi,bj) )*maskC(i,j,k,bi,bj)
                0068         ENDDO
                0069        ENDDO
                0070
                0071 C-     Add Impl.IGW correction to Pot.Temperature:
                0072        dTr_k = 0. _d 0
                0073        IF ( k.GT.1 ) dTr_k = (tRef(k) - tRef(k-1))*rkSign
                0074        dTrp1 = (tRef(kp1) - tRef(k))*rkSign
                0075        IF ( tempAdvection .AND.
                0076      &     (dTr_k.NE.0. _d 0 .OR. dTrp1.NE.0. _d 0) ) THEN
                0077          DO j=1-Oly,sNy+Oly
                0078           DO i=1-Olx,sNx+Olx
                0079           theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
                0080      &       -dTtracerLev(k)*0.5 _d 0
                0081      &                      *( dTr_k*dW_k(i,j) + dTrp1*dWp1(i,j) )
616600b8d2 Patr*0082      &                      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
159909ced3 Jean*0083           ENDDO
                0084          ENDDO
                0085        ENDIF
                0086
                0087 C-     Add Impl.IGW correction to Salinity/Water vapor:
                0088        dTr_k = 0. _d 0
                0089        IF ( k.GT.1 ) dTr_k = (sRef(k) - sRef(k-1))*rkSign
                0090        dTrp1 = (sRef(kp1) - sRef(k))*rkSign
                0091        IF ( saltAdvection .AND.
                0092      &     (dTr_k.NE.0. _d 0 .OR. dTrp1.NE.0. _d 0) ) THEN
                0093          DO j=1-Oly,sNy+Oly
                0094           DO i=1-Olx,sNx+Olx
                0095             salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0096      &       -dTtracerLev(k)*0.5 _d 0
                0097      &                      *( dTr_k*dW_k(i,j) + dTrp1*dWp1(i,j) )
616600b8d2 Patr*0098      &                      *recip_drF(k)*_recip_hFacC(i,j,k,bi,bj)
159909ced3 Jean*0099           ENDDO
                0100          ENDDO
                0101        ENDIF
                0102
                0103 C-    End of k loop
                0104       ENDDO
                0105
                0106 #endif /* ALLOW_NONHYDROSTATIC */
                0107
                0108       RETURN
                0109       END