File indexing completed on 2022-03-27 05:09:01 UTC
view on githubraw file Latest commit a67797e4 on 2022-02-17 22:16:14 UTC
2833334a42 Alis*0001 #include "CPP_OPTIONS.h"
0002
9366854e02 Chri*0003
0004
0005
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
0012
25897dc454 Jean*0013
0014
9366854e02 Chri*0015
0016
2833334a42 Alis*0017
9366854e02 Chri*0018
0019 IMPLICIT NONE
2833334a42 Alis*0020
0021 #include "SIZE.h"
0022 #include "EEPARAMS.h"
0023 #include "PARAMS.h"
3e6712ab78 Jean*0024 #include "GRID.h"
2833334a42 Alis*0025
9366854e02 Chri*0026
3e6712ab78 Jean*0027
0028
0029
0030
b900b44159 Jean*0031
0032
0033
0034
3e6712ab78 Jean*0035
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
a67797e4f0 Jean*0046
2833334a42 Alis*0047 INTEGER i,j
3e6712ab78 Jean*0048 _RL rhoLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9366854e02 Chri*0049
2833334a42 Alis*0050
b900b44159 Jean*0051
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
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
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