/[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.7 by heimbach, Fri Jul 27 22:18:57 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 CALC_ISOSLOPES                                
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., rhoLoc, bi,bj, myThid )
62          ENDIF
63    cph-exch2#endif
64        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
65         DO i=1-Olx+1,sNx+Olx         DO i=1-Olx+1,sNx+Olx
66          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)
67       &        *_recip_dxC(i,j,bi,bj)       &        *_recip_dxC(i,j,bi,bj)
68       &        *(rhoK(i,j)-rhoK(i-1,j))       &        *(rhoLoc(i,j)-rhoLoc(i-1,j))
69         ENDDO         ENDDO
70        ENDDO        ENDDO
71    
72    C-    Internal exchange for calculations in Y
73    cph-exch2#ifndef ALLOW_AUTODIFF_TAMC
74          IF ( useCubedSphereExchange ) THEN
75            CALL FILL_CS_CORNER_TR_RL( .FALSE., rhoLoc, bi,bj, myThid )
76          ENDIF
77    cph-exch2#endif
78        DO j=1-Oly+1,sNy+Oly        DO j=1-Oly+1,sNy+Oly
79         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
80          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)
81       &        *_recip_dyC(i,j,bi,bj)       &        *_recip_dyC(i,j,bi,bj)
82       &        *(rhoK(i,j)-rhoK(i,j-1))       &        *(rhoLoc(i,j)-rhoLoc(i,j-1))
83         ENDDO         ENDDO
84        ENDDO        ENDDO
85    
86        DO j=1-Oly,sNy+Oly        IF (K.EQ.1) THEN
87         DO i=1-Olx,sNx+Olx         DO j=1-Oly,sNy+Oly
88          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  
89           sigmaR(i,j,k)=0.           sigmaR(i,j,k)=0.
90          ENDIF          ENDDO
91         ENDDO         ENDDO
92        ENDDO        ELSE
93           DO j=1-Oly,sNy+Oly
94            DO i=1-Olx,sNx+Olx
95             sigmaR(i,j,k)= maskC(i,j,k,bi,bj)
96         &                *recip_drC(k)*rkSign
97         &                *(sigKp1(i,j)-sigKm1(i,j))
98            ENDDO
99           ENDDO
100          ENDIF
101    
102        RETURN        RETURN
103        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22