/[MITgcm]/MITgcm/model/src/grad_sigma.F
ViewVC logotype

Diff of /MITgcm/model/src/grad_sigma.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by cnh, Sun Feb 4 14:38:47 2001 UTC revision 1.8 by jmc, Thu Aug 16 02:13:40 2007 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: GRAD_SIGMA
8    C     !INTERFACE:
9        SUBROUTINE GRAD_SIGMA(        SUBROUTINE GRAD_SIGMA(
10       I             bi, bj, iMin, iMax, jMin, jMax, K,       I             bi, bj, iMin, iMax, jMin, jMax, K,
11       I             rhoK, sigKm1, sigKp1,       I             rhoK, sigKm1, sigKp1,
12       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
13       I             myThid )       I             myThid )
14  C     /==========================================================\  C     !DESCRIPTION: \bv
15  C     | SUBROUTINE CALC_ISOSLOPES                                |  C     *==========================================================*
16  C     | o Calculate isoneutral gradients                         |  C     | SUBROUTINE GRAD_SIGMA
17  C     |==========================================================|  C     | o Calculate isoneutral gradients
18  C     \==========================================================/  C     *==========================================================*
19        IMPLICIT NONE  C     \ev
20    
21    C     !USES:
22          IMPLICIT NONE
23  C     == Global variables ==  C     == Global variables ==
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "GRID.h"  #include "GRID.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  #include "PARAMS.h"  #include "PARAMS.h"
28    
29    C     !INPUT/OUTPUT PARAMETERS:
30  C     == Routine arguments ==  C     == Routine arguments ==
31  C  C     rhoK       :: density at level k
32    C     sigKm1     :: upper level density computed at current pressure
33    C     sigKp1     :: lower level density computed at current pressure
34    C     sigmaX,Y,R :: iso-neutral gradient of density in 3 directions X,Y,R
35        INTEGER bi,bj,iMin,iMax,jMin,jMax,K        INTEGER bi,bj,iMin,iMax,jMin,jMax,K
36        _RL rhoK(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL rhoK(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
37        _RL sigKm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL sigKm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
# Line 32  C Line 41  C
41        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
42        INTEGER myThid        INTEGER myThid
43    
44    C     !LOCAL VARIABLES:
45  C     == Local variables ==  C     == Local variables ==
46    C     rhoLoc :: local copy of rhoK
47        INTEGER i,j        INTEGER i,j
48          _RL rhoLoc(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49    CEOP
50    
51    C-    safer to work on a local copy of rhoK (before a partial update)
52          DO j=1-Oly,sNy+Oly
53           DO i=1-Olx,sNx+Olx
54            rhoLoc(i,j) = rhoK(i,j)
55           ENDDO
56          ENDDO
57    
58    C-    Internal exchange for calculations in X
59    cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
60          IF ( useCubedSphereExchange ) THEN
61            CALL FILL_CS_CORNER_TR_RL( .TRUE., .FALSE.,
62         &                             rhoLoc, bi,bj, myThid )
63          ENDIF
64    cph-exch2#endif
65        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
66         DO i=1-Olx+1,sNx+Olx         DO i=1-Olx+1,sNx+Olx
67          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)
68       &        *_recip_dxC(i,j,bi,bj)       &        *_recip_dxC(i,j,bi,bj)
69       &        *(rhoK(i,j)-rhoK(i-1,j))       &        *(rhoLoc(i,j)-rhoLoc(i-1,j))
70         ENDDO         ENDDO
71        ENDDO        ENDDO
72    
73    C-    Internal exchange for calculations in Y
74    cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
75          IF ( useCubedSphereExchange ) THEN
76            CALL FILL_CS_CORNER_TR_RL(.FALSE., .FALSE.,
77         &                             rhoLoc, bi,bj, myThid )
78          ENDIF
79    cph-exch2#endif
80        DO j=1-Oly+1,sNy+Oly        DO j=1-Oly+1,sNy+Oly
81         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
82          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)
83       &        *_recip_dyC(i,j,bi,bj)       &        *_recip_dyC(i,j,bi,bj)
84       &        *(rhoK(i,j)-rhoK(i,j-1))       &        *(rhoLoc(i,j)-rhoLoc(i,j-1))
85         ENDDO         ENDDO
86        ENDDO        ENDDO
87    
88        DO j=1-Oly,sNy+Oly        IF (K.EQ.1) THEN
89         DO i=1-Olx,sNx+Olx         DO j=1-Oly,sNy+Oly
90          IF (K.NE.1 .AND. hfacC(i,j,k,bi,bj).NE.0.) THEN          DO i=1-Olx,sNx+Olx
          sigmaR(i,j,k)=recip_drC(k)*rkFac*(sigKm1(i,j)-sigKp1(i,j))  
         ELSE  
91           sigmaR(i,j,k)=0.           sigmaR(i,j,k)=0.
92          ENDIF          ENDDO
93         ENDDO         ENDDO
94        ENDDO        ELSE
95           DO j=1-Oly,sNy+Oly
96            DO i=1-Olx,sNx+Olx
97             sigmaR(i,j,k)= maskC(i,j,k,bi,bj)
98         &                *recip_drC(k)*rkSign
99         &                *(sigKp1(i,j)-sigKm1(i,j))
100            ENDDO
101           ENDDO
102          ENDIF
103    
104        RETURN        RETURN
105        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22