model/src/grad_sigma.F

2833334a42 Alis*0001 #include "CPP_OPTIONS.h"
                0002
9366854e02 Chri*0003 CBOP
                0004 C     !ROUTINE: GRAD_SIGMA
                0005 C     !INTERFACE:
2833334a42 Alis*0006       SUBROUTINE GRAD_SIGMA(
3e6712ab78 Jean*0007      I             bi, bj, iMin, iMax, jMin, jMax, k,
2833334a42 Alis*0008      I             rhoK, sigKm1, sigKp1,
                0009      O             sigmaX, sigmaY, sigmaR,
                0010      I             myThid )
9366854e02 Chri*0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
25897dc454 Jean*0013 C     | SUBROUTINE GRAD_SIGMA
                0014 C     | o Calculate isoneutral gradients
9366854e02 Chri*0015 C     *==========================================================*
                0016 C     \ev
2833334a42 Alis*0017
9366854e02 Chri*0018 C     !USES:
                0019       IMPLICIT NONE
2833334a42 Alis*0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
3e6712ab78 Jean*0024 #include "GRID.h"
2833334a42 Alis*0025
9366854e02 Chri*0026 C     !INPUT/OUTPUT PARAMETERS:
3e6712ab78 Jean*0027 C     bi, bj     :: tile indices
                0028 C     iMin,iMax  :: not used
                0029 C     jMin,jMax  :: not used
                0030 C     k          :: current level index
b900b44159 Jean*0031 C     rhoK       :: density at level k
                0032 C     sigKm1     :: upper level density computed at current pressure
                0033 C     sigKp1     :: lower level density computed at current pressure
                0034 C     sigmaX,Y,R :: iso-neutral gradient of density in 3 directions X,Y,R
3e6712ab78 Jean*0035 C     myThid     :: my Thread Id. number
                0036       INTEGER bi,bj,iMin,iMax,jMin,jMax,k
                0037       _RL rhoK(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0038       _RL sigKm1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0039       _RL sigKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0040       _RL sigmaX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0041       _RL sigmaY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0042       _RL sigmaR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
2833334a42 Alis*0043       INTEGER myThid
                0044
9366854e02 Chri*0045 C     !LOCAL VARIABLES:
a67797e4f0 Jean*0046 C     rhoLoc     :: local copy of rhoK
2833334a42 Alis*0047       INTEGER i,j
3e6712ab78 Jean*0048       _RL rhoLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9366854e02 Chri*0049 CEOP
2833334a42 Alis*0050
b900b44159 Jean*0051 C-    safer to work on a local copy of rhoK (before a partial update)
3e6712ab78 Jean*0052       DO j=1-OLy,sNy+OLy
                0053        DO i=1-OLx,sNx+OLx
b900b44159 Jean*0054         rhoLoc(i,j) = rhoK(i,j)
                0055        ENDDO
                0056       ENDDO
                0057
                0058 C-    Internal exchange for calculations in X
                0059       IF ( useCubedSphereExchange ) THEN
93e3461d85 Jean*0060         CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
25897dc454 Jean*0061      &                             rhoLoc, bi,bj, myThid )
b900b44159 Jean*0062       ENDIF
3e6712ab78 Jean*0063       DO j=1-OLy,sNy+OLy
                0064        DO i=1-OLx+1,sNx+OLx
2833334a42 Alis*0065         sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)
a67797e4f0 Jean*0066      &        *_recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
b900b44159 Jean*0067      &        *(rhoLoc(i,j)-rhoLoc(i-1,j))
2833334a42 Alis*0068        ENDDO
                0069       ENDDO
                0070
b900b44159 Jean*0071 C-    Internal exchange for calculations in Y
                0072       IF ( useCubedSphereExchange ) THEN
93e3461d85 Jean*0073         CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
25897dc454 Jean*0074      &                             rhoLoc, bi,bj, myThid )
b900b44159 Jean*0075       ENDIF
3e6712ab78 Jean*0076       DO j=1-OLy+1,sNy+OLy
                0077        DO i=1-OLx,sNx+OLx
2833334a42 Alis*0078         sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)
a67797e4f0 Jean*0079      &        *_recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
b900b44159 Jean*0080      &        *(rhoLoc(i,j)-rhoLoc(i,j-1))
2833334a42 Alis*0081        ENDDO
                0082       ENDDO
                0083
3e6712ab78 Jean*0084       IF (k.EQ.1) THEN
                0085        DO j=1-OLy,sNy+OLy
                0086         DO i=1-OLx,sNx+OLx
                0087          sigmaR(i,j,k)= 0. _d 0
b900b44159 Jean*0088         ENDDO
2833334a42 Alis*0089        ENDDO
b900b44159 Jean*0090       ELSE
3e6712ab78 Jean*0091        DO j=1-OLy,sNy+OLy
                0092         DO i=1-OLx,sNx+OLx
                0093          sigmaR(i,j,k)= maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
bb6c554092 Jean*0094      &                *recip_drC(k)*rkSign
                0095      &                *(sigKp1(i,j)-sigKm1(i,j))
b900b44159 Jean*0096         ENDDO
                0097        ENDDO
                0098       ENDIF
2833334a42 Alis*0099
                0100       RETURN
                0101       END