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

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

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

revision 1.8 by heimbach, Thu Dec 8 15:44:33 2005 UTC revision 1.9 by jmc, Tue Dec 5 05:25:08 2006 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  CBOP  CBOP
7  C     !ROUTINE: CALC_GRAD_PHI_HYD  C     !ROUTINE: CALC_GRAD_PHI_HYD
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE CALC_GRAD_PHI_HYD(        SUBROUTINE CALC_GRAD_PHI_HYD(
10       I                       k, bi, bj, iMin,iMax, jMin,jMax,       I                       k, bi, bj, iMin,iMax, jMin,jMax,
11       I                       phiHydC, alphRho, tFld, sFld,       I                       phiHydC, alphRho, tFld, sFld,
12       O                       dPhiHydX, dPhiHydY,       O                       dPhiHydX, dPhiHydY,
13       I                       myTime, myIter, myThid)       I                       myTime, myIter, myThid)
14  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
15  C     *==========================================================*  C     *==========================================================*
16  C     | S/R CALC_GRAD_PHI_HYD                                      C     | S/R CALC_GRAD_PHI_HYD
17  C     | o Calculate the gradient of Hydrostatic potential anomaly  C     | o Calculate the gradient of Hydrostatic potential anomaly
18  C     *==========================================================*  C     *==========================================================*
19  C     \ev  C     \ev
20    
# Line 30  C     == Global variables == Line 30  C     == Global variables ==
30    
31  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
32  C     == Routine Arguments ==  C     == Routine Arguments ==
33  C     bi,bj      :: tile index              C     bi,bj      :: tile index
34  C     iMin,iMax,jMin,jMax :: Loop counters  C     iMin,iMax,jMin,jMax :: Loop counters
35  C     phiHydC    :: Hydrostatic Potential anomaly  C     phiHydC    :: Hydrostatic Potential anomaly
36  C                  (atmos: =Geopotential ; ocean-z: =Pressure/rho)  C                  (atmos: =Geopotential ; ocean-z: =Pressure/rho)
37  C     alphRho    :: Density (z-coord) or specific volume (p-coord)  C     alphRho    :: Density (z-coord) or specific volume (p-coord)
38  C     tFld       :: Potential temp.  C     tFld       :: Potential temp.
39  C     sFld       :: Salinity  C     sFld       :: Salinity
40  C     dPhiHydX,Y :: Gradient (X & Y directions) of Hyd. Potential  C     dPhiHydX,Y :: Gradient (X & Y directions) of Hyd. Potential
41  C     myTime :: Current time  C     myTime :: Current time
42  C     myIter :: Current iteration number  C     myIter :: Current iteration number
43  C     myThid :: Instance number for this call of the routine.  C     myThid :: Instance number for this call of the routine.
44        INTEGER k, bi,bj, iMin,iMax, jMin,jMax        INTEGER k, bi,bj, iMin,iMax, jMin,jMax
 c     _RL phiHyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
45        _RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
46        _RL alphRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL alphRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47        _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
# Line 70  CEOP Line 69  CEOP
69        IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN        IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN
70  # ifndef DISABLE_RSTAR_CODE  # ifndef DISABLE_RSTAR_CODE
71  C-    Integral of b.dr = rStarFac * Integral of b.dr* :  C-    Integral of b.dr = rStarFac * Integral of b.dr* :
72  C      and will add later (select_rStar=2) the contribution of  C      and will add later (select_rStar=2) the contribution of
73  C      the slope of the r* coordinate.  C      the slope of the r* coordinate.
74         IF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN         IF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN
75  C-     Consistent with Phi'= Integr[ theta'.dPi ] :  C-     Consistent with Phi'= Integr[ theta'.dPi ] :
# Line 96  C-     Consistent with Phi'= Integr[ the Line 95  C-     Consistent with Phi'= Integr[ the
95          DO j=jMin-1,jMax          DO j=jMin-1,jMax
96           DO i=iMin-1,iMax           DO i=iMin-1,iMax
97            IF (Ro_surf(i,j,bi,bj).EQ.rC(k)) THEN            IF (Ro_surf(i,j,bi,bj).EQ.rC(k)) THEN
98             factPI=atm_Cp*( ((etaH(i,j,bi,bj)+rC(k))/atm_Po)**atm_kappa               factPI=atm_Cp*( ((etaH(i,j,bi,bj)+rC(k))/atm_Po)**atm_kappa
99       &                    -(                 rC(k) /atm_Po)**atm_kappa       &                    -(                 rC(k) /atm_Po)**atm_kappa
100       &                  )       &                  )
101             varLoc(i,j) = factPI*alphRho(i,j)             varLoc(i,j) = factPI*alphRho(i,j)
102            ELSEIF (Ro_surf(i,j,bi,bj).NE.0. _d 0) THEN            ELSEIF (Ro_surf(i,j,bi,bj).NE.0. _d 0) THEN
# Line 142  C-     Consistent with Phi'= Integr[ the Line 141  C-     Consistent with Phi'= Integr[ the
141  C--   Zonal & Meridional gradient of potential anomaly  C--   Zonal & Meridional gradient of potential anomaly
142        DO j=jMin,jMax        DO j=jMin,jMax
143         DO i=iMin,iMax         DO i=iMin,iMax
144          dPhiHydX(i,j) = _recip_dxC(i,j,bi,bj)          dPhiHydX(i,j) = _recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
145       &                *( varLoc(i,j)-varLoc(i-1,j) )       &                *( varLoc(i,j)-varLoc(i-1,j) )*recip_rhoFacC(k)
146          dPhiHydY(i,j) = _recip_dyC(i,j,bi,bj)          dPhiHydY(i,j) = _recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
147       &                *( varLoc(i,j)-varLoc(i,j-1) )       &                *( varLoc(i,j)-varLoc(i,j-1) )*recip_rhoFacC(k)
148         ENDDO         ENDDO
149        ENDDO        ENDDO
150    
# Line 153  C--   Zonal & Meridional gradient of pot Line 152  C--   Zonal & Meridional gradient of pot
152        IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.1 ) THEN        IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.1 ) THEN
153         IF ( buoyancyRelation .EQ. 'OCEANIC' ) THEN         IF ( buoyancyRelation .EQ. 'OCEANIC' ) THEN
154  C--    z* coordinate slope term: rho'/rho0 * Grad_r(g.z)  C--    z* coordinate slope term: rho'/rho0 * Grad_r(g.z)
155          factorZ = gravity*recip_rhoConst*0.5 _d 0          factorZ = gravity*recip_rhoConst*recip_rhoFacC(k)*0.5 _d 0
156          DO j=jMin-1,jMax          DO j=jMin-1,jMax
157           DO i=iMin-1,iMax           DO i=iMin-1,iMax
158            varLoc(i,j) = etaH(i,j,bi,bj)            varLoc(i,j) = etaH(i,j,bi,bj)
# Line 165  C--    z* coordinate slope term: rho'/rh Line 164  C--    z* coordinate slope term: rho'/rh
164            dPhiHydX(i,j) = dPhiHydX(i,j)            dPhiHydX(i,j) = dPhiHydX(i,j)
165       &     +factorZ*(alphRho(i-1,j)+alphRho(i,j))       &     +factorZ*(alphRho(i-1,j)+alphRho(i,j))
166       &             *(varLoc(i,j)-varLoc(i-1,j))       &             *(varLoc(i,j)-varLoc(i-1,j))
167       &             *recip_dxC(i,j,bi,bj)       &             *recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
168            dPhiHydY(i,j) = dPhiHydY(i,j)            dPhiHydY(i,j) = dPhiHydY(i,j)
169       &     +factorZ*(alphRho(i,j-1)+alphRho(i,j))       &     +factorZ*(alphRho(i,j-1)+alphRho(i,j))
170       &             *(varLoc(i,j)-varLoc(i,j-1))       &             *(varLoc(i,j)-varLoc(i,j-1))
171       &             *recip_dyC(i,j,bi,bj)         &             *recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
172           ENDDO           ENDDO
173          ENDDO          ENDDO
174         ELSEIF (buoyancyRelation .EQ. 'OCEANICP' ) THEN         ELSEIF (buoyancyRelation .EQ. 'OCEANICP' ) THEN
# Line 180  C--    p* coordinate slope term: alpha' Line 179  C--    p* coordinate slope term: alpha'
179            dPhiHydX(i,j) = dPhiHydX(i,j)            dPhiHydX(i,j) = dPhiHydX(i,j)
180       &     +factorP*(alphRho(i-1,j)+alphRho(i,j))       &     +factorP*(alphRho(i-1,j)+alphRho(i,j))
181       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))
182       &             *rC(k)*recip_dxC(i,j,bi,bj)         &             *rC(k)*recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
183            dPhiHydY(i,j) = dPhiHydY(i,j)            dPhiHydY(i,j) = dPhiHydY(i,j)
184       &     +factorP*(alphRho(i,j-1)+alphRho(i,j))       &     +factorP*(alphRho(i,j-1)+alphRho(i,j))
185       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))
186       &             *rC(k)*recip_dyC(i,j,bi,bj)         &             *rC(k)*recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
187           ENDDO           ENDDO
188          ENDDO          ENDDO
189         ELSEIF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN         ELSEIF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN
# Line 196  C--    p* coordinate slope term: alpha' Line 195  C--    p* coordinate slope term: alpha'
195            dPhiHydX(i,j) = dPhiHydX(i,j)            dPhiHydX(i,j) = dPhiHydX(i,j)
196       &     +factorP*(alphRho(i-1,j)+alphRho(i,j))       &     +factorP*(alphRho(i-1,j)+alphRho(i,j))
197       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))
198       &             *rC(k)*recip_dxC(i,j,bi,bj)         &             *rC(k)*recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
199            dPhiHydY(i,j) = dPhiHydY(i,j)            dPhiHydY(i,j) = dPhiHydY(i,j)
200       &     +factorP*(alphRho(i,j-1)+alphRho(i,j))       &     +factorP*(alphRho(i,j-1)+alphRho(i,j))
201       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))       &             *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))
202       &             *rC(k)*recip_dyC(i,j,bi,bj)         &             *rC(k)*recip_dyC(i,j,bi,bj)*recip_deepFacC(k)
203           ENDDO           ENDDO
204          ENDDO          ENDDO
205         ENDIF         ENDIF
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22