/[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.1 by adcroft, Wed Jun 21 18:58:25 2000 UTC revision 1.4 by jmc, Sun Nov 21 16:06:05 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    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 31  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          IF ( useCubedSphereExchange ) THEN
60            CALL FILL_CS_CORNER_TR_RL( .TRUE., rhoLoc, bi,bj, myThid )
61          ENDIF
62        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
63         DO i=1-Olx+1,sNx+Olx         DO i=1-Olx+1,sNx+Olx
64          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)          sigmaX(i,j,k)=_maskW(i,j,k,bi,bj)
65       &        *_recip_dxC(i,j,bi,bj)       &        *_recip_dxC(i,j,bi,bj)
66       &        *(rhoK(i,j)-rhoK(i-1,j))       &        *(rhoLoc(i,j)-rhoLoc(i-1,j))
67         ENDDO         ENDDO
68        ENDDO        ENDDO
69    
70    C-    Internal exchange for calculations in Y
71          IF ( useCubedSphereExchange ) THEN
72            CALL FILL_CS_CORNER_TR_RL( .FALSE., rhoLoc, bi,bj, myThid )
73          ENDIF
74        DO j=1-Oly+1,sNy+Oly        DO j=1-Oly+1,sNy+Oly
75         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
76          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)          sigmaY(i,j,k)=_maskS(i,j,k,bi,bj)
77       &        *_recip_dyC(i,j,bi,bj)       &        *_recip_dyC(i,j,bi,bj)
78       &        *(rhoK(i,j)-rhoK(i,j-1))       &        *(rhoLoc(i,j)-rhoLoc(i,j-1))
79         ENDDO         ENDDO
80        ENDDO        ENDDO
81    
82        DO j=1-Oly,sNy+Oly  C- jmc: Patrick, will this work for TAF ?
83         DO i=1-Olx,sNx+Olx        IF (K.EQ.1) THEN
84          IF (K.NE.1 .AND. hfacC(i,j,k,bi,bj).NE.0.) THEN         DO j=1-Oly,sNy+Oly
85           sigmaR(i,j,k)=recip_drC(k)*rkFac*(sigKm1(i,j)-sigKp1(i,j))          DO i=1-Olx,sNx+Olx
         ELSE  
86           sigmaR(i,j,k)=0.           sigmaR(i,j,k)=0.
87          ENDIF          ENDDO
88         ENDDO         ENDDO
89        ENDDO        ELSE
90           DO j=1-Oly,sNy+Oly
91            DO i=1-Olx,sNx+Olx
92             sigmaR(i,j,k)= maskC(i,j,k,bi,bj)
93         &                *recip_drC(k)*rkFac
94         &                *(sigKm1(i,j)-sigKp1(i,j))
95            ENDDO
96           ENDDO
97          ENDIF
98    C- jmc: leave the old code commented (in case ...)
99    c     DO j=1-Oly,sNy+Oly
100    c      DO i=1-Olx,sNx+Olx
101    c       IF (K.NE.1 .AND. hfacC(i,j,k,bi,bj).NE.0.) THEN
102    c        sigmaR(i,j,k)=recip_drC(k)*rkFac*(sigKm1(i,j)-sigKp1(i,j))
103    c       ELSE
104    c        sigmaR(i,j,k)=0.
105    c       ENDIF
106    c      ENDDO
107    c     ENDDO
108    
109        RETURN        RETURN
110        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22