/[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.3 by cnh, Wed Sep 26 18:09:15 2001 UTC revision 1.4 by jmc, Sun Nov 21 16:06:05 2004 UTC
# Line 28  C     == Global variables == Line 28  C     == Global variables ==
28    
29  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
30  C     == Routine arguments ==  C     == Routine arguments ==
31    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 39  C     == Routine arguments == Line 43  C     == Routine arguments ==
43    
44  C     !LOCAL VARIABLES:  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  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.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22