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

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

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

Revision 1.6 - (hide annotations) (download)
Mon Aug 4 13:20:13 2003 UTC (20 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint57m_post, checkpoint52l_pre, hrcube4, hrcube5, checkpoint57g_pre, checkpoint57s_post, checkpoint57b_post, checkpoint52d_pre, checkpoint57g_post, checkpoint56b_post, checkpoint52j_pre, checkpoint51o_pre, checkpoint54d_post, checkpoint54e_post, checkpoint51l_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint52k_post, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint52, checkpoint52f_post, checkpoint57n_post, checkpoint54f_post, checkpoint51f_post, checkpoint51t_post, checkpoint51n_post, checkpoint55i_post, checkpoint57l_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint57t_post, checkpoint55c_post, checkpoint51j_post, checkpoint52e_pre, checkpoint57v_post, checkpoint57f_post, checkpoint52e_post, checkpoint51n_pre, checkpoint53d_post, checkpoint57a_post, checkpoint57h_pre, checkpoint52b_pre, checkpoint54b_post, checkpoint57h_post, checkpoint51l_pre, checkpoint52m_post, checkpoint55g_post, checkpoint51q_post, checkpoint52b_post, checkpoint52c_post, checkpoint51h_pre, checkpoint57c_post, checkpoint52f_pre, checkpoint55d_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint55j_post, branchpoint-genmake2, checkpoint54a_post, checkpoint55h_post, checkpoint51r_post, checkpoint51i_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint55f_post, checkpoint52d_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint52a_pre, checkpoint52i_post, checkpoint51i_pre, checkpoint52h_pre, checkpoint56a_post, checkpoint53f_post, checkpoint57h_done, checkpoint52j_post, checkpoint57j_post, checkpoint57f_pre, branch-netcdf, checkpoint52l_post, checkpoint52n_post, checkpoint53b_pre, checkpoint56c_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint51o_post, checkpoint57k_post, checkpoint51f_pre, checkpoint53b_post, checkpoint52a_post, checkpoint57w_post, checkpoint51g_post, ecco_c52_e35, checkpoint51m_post, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-genmake2, branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.5: +4 -3 lines 
one line exceed 72 c : fix it.
1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/model/src/calc_grad_phi_hyd.F,v 1.5 2003/08/01 04:03:54 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: CALC_GRAD_PHI_HYD
8     C !INTERFACE:
9     SUBROUTINE CALC_GRAD_PHI_HYD(
10     I k, bi, bj, iMin,iMax, jMin,jMax,
11 jmc 1.3 I phiHydC, alphRho, tFld, sFld,
12 jmc 1.1 O dPhiHydX, dPhiHydY,
13     I myTime, myIter, myThid)
14     C !DESCRIPTION: \bv
15     C *==========================================================*
16     C | S/R CALC_GRAD_PHI_HYD
17     C | o Calculate the gradient of Hydrostatic potential anomaly
18     C *==========================================================*
19     C \ev
20    
21     C !USES:
22     IMPLICIT NONE
23     C == Global variables ==
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26     #include "PARAMS.h"
27     #include "GRID.h"
28     #include "SURFACE.h"
29 jmc 1.3 #include "DYNVARS.h"
30 jmc 1.1
31     C !INPUT/OUTPUT PARAMETERS:
32     C == Routine Arguments ==
33     C bi,bj :: tile index
34     C iMin,iMax,jMin,jMax :: Loop counters
35 jmc 1.3 C phiHydC :: Hydrostatic Potential anomaly
36 jmc 1.1 C (atmos: =Geopotential ; ocean-z: =Pressure/rho)
37     C alphRho :: Density (z-coord) or specific volume (p-coord)
38     C tFld :: Potential temp.
39     C sFld :: Salinity
40     C dPhiHydX,Y :: Gradient (X & Y directions) of Hyd. Potential
41     C myTime :: Current time
42     C myIter :: Current iteration number
43     C myThid :: Instance number for this call of the routine.
44     INTEGER k, bi,bj, iMin,iMax, jMin,jMax
45 jmc 1.3 c _RL phiHyd(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
46     _RL phiHydC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47 jmc 1.1 _RL alphRho(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48     _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
49     _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
50     _RL dPhiHydX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
51     _RL dPhiHydY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
52     _RL myTime
53     INTEGER myIter, myThid
54    
55     #ifdef INCLUDE_PHIHYD_CALCULATION_CODE
56    
57     C !LOCAL VARIABLES:
58     C == Local variables ==
59     C i,j :: Loop counters
60     INTEGER i,j
61     _RL varLoc(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
62 jmc 1.3 _RL factorZ, factorP, conv_theta2T
63 jmc 1.5 _RL factPI
64     CHARACTER*(MAX_LEN_MBUF) msgBuf
65 jmc 1.1 CEOP
66    
67 jmc 1.3 #ifdef NONLIN_FRSURF
68 jmc 1.5 IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.4 ) THEN
69     C- Integral of b.dr = rStarFac * Integral of b.dr* :
70     C and will add later (select_rStar=2) the contribution of
71     C the slope of the r* coordinate.
72     IF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN
73     C- Consistent with Phi'= Integr[ theta'.dPi ] :
74     DO j=jMin-1,jMax
75     DO i=iMin-1,iMax
76     varLoc(i,j) = phiHydC(i,j)*rStarFacC(i,j,bi,bj)**atm_kappa
77     & + phi0surf(i,j,bi,bj)
78     ENDDO
79     ENDDO
80     ELSE
81     DO j=jMin-1,jMax
82     DO i=iMin-1,iMax
83     varLoc(i,j) = phiHydC(i,j)*rStarFacC(i,j,bi,bj)
84     & + phi0surf(i,j,bi,bj)
85     ENDDO
86     ENDDO
87     ENDIF
88     ELSEIF (select_rStar.GE.1 .AND. nonlinFreeSurf.GE.4 ) THEN
89     C- Integral of b.dr but scaled to correspond to a fixed r-level (=r*)
90     C no contribution of the slope of the r* coordinate (select_rStar=1)
91     IF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN
92     C- Consistent with Phi'= Integr[ theta'.dPi ] :
93     DO j=jMin-1,jMax
94     DO i=iMin-1,iMax
95     IF (Ro_surf(i,j,bi,bj).EQ.rC(k)) THEN
96     factPI=atm_Cp*( ((etaH(i,j,bi,bj)+rC(k))/atm_Po)**atm_kappa
97     & -( rC(k) /atm_Po)**atm_kappa
98     & )
99     varLoc(i,j) = factPI*alphRho(i,j)
100     ELSEIF (Ro_surf(i,j,bi,bj).NE.0. _d 0) THEN
101     factPI = (rC(k)/Ro_surf(i,j,bi,bj))**atm_kappa
102     varLoc(i,j) = phiHydC(i,j)
103     & *(rStarFacC(i,j,bi,bj)**atm_kappa - factPI)
104     & /(1. _d 0 -factPI)
105     & + phi0surf(i,j,bi,bj)
106     ENDIF
107     ENDDO
108     ENDDO
109     ELSE
110     DO j=jMin-1,jMax
111     DO i=iMin-1,iMax
112     IF (Ro_surf(i,j,bi,bj).EQ.rC(k)) THEN
113 jmc 1.6 WRITE(msgBuf,'(3A)') 'CALC_GRAD_PHI_HYD: ',
114     & 'Problem when Ro_surf=rC',
115     & ' with select_rStar,integr_GeoPot=1,4'
116 jmc 1.5 CALL PRINT_ERROR( msgBuf , myThid)
117     STOP 'CALC_GRAD_PHI_HYD: Pb in r* options implementation'
118     ELSE
119     varLoc(i,j) = phiHydC(i,j)
120     & *(etaH(i,j,bi,bj)+Ro_surf(i,j,bi,bj)-rC(k))
121     & / (Ro_surf(i,j,bi,bj)-rC(k))
122     & + phi0surf(i,j,bi,bj)
123     ENDIF
124     ENDDO
125 jmc 1.3 ENDDO
126 jmc 1.5 ENDIF
127 jmc 1.3 ELSE
128     #else /* NONLIN_FRSURF */
129     IF (.TRUE.) THEN
130     #endif /* NONLIN_FRSURF */
131     DO j=jMin-1,jMax
132     DO i=iMin-1,iMax
133     varLoc(i,j) = phiHydC(i,j)+phi0surf(i,j,bi,bj)
134     ENDDO
135     ENDDO
136     ENDIF
137 jmc 1.1
138 jmc 1.3 C-- Zonal & Meridional gradient of potential anomaly
139 jmc 1.1 DO j=jMin,jMax
140     DO i=iMin,iMax
141     dPhiHydX(i,j) = _recip_dxC(i,j,bi,bj)
142     & *( varLoc(i,j)-varLoc(i-1,j) )
143     dPhiHydY(i,j) = _recip_dyC(i,j,bi,bj)
144     & *( varLoc(i,j)-varLoc(i,j-1) )
145     ENDDO
146     ENDDO
147 jmc 1.3
148     #ifdef NONLIN_FRSURF
149     IF (select_rStar.GE.2 .AND. nonlinFreeSurf.GE.1 ) THEN
150     IF ( buoyancyRelation .EQ. 'OCEANIC' ) THEN
151     C-- z* coordinate slope term: rho'/rho0 * Grad_r(g.z)
152     factorZ = gravity*recip_rhoConst*0.5 _d 0
153     DO j=jMin-1,jMax
154     DO i=iMin-1,iMax
155     varLoc(i,j) = etaH(i,j,bi,bj)
156     & *(1. _d 0 + rC(k)*recip_Rcol(i,j,bi,bj))
157     ENDDO
158     ENDDO
159     DO j=jMin,jMax
160     DO i=iMin,iMax
161     dPhiHydX(i,j) = dPhiHydX(i,j)
162     & +factorZ*(alphRho(i-1,j)+alphRho(i,j))
163     & *(varLoc(i,j)-varLoc(i-1,j))
164     & *recip_dxC(i,j,bi,bj)
165     dPhiHydY(i,j) = dPhiHydY(i,j)
166     & +factorZ*(alphRho(i,j-1)+alphRho(i,j))
167     & *(varLoc(i,j)-varLoc(i,j-1))
168     & *recip_dyC(i,j,bi,bj)
169     ENDDO
170     ENDDO
171     ELSEIF (buoyancyRelation .EQ. 'OCEANICP' ) THEN
172     C-- p* coordinate slope term: alpha' * Grad_r( p )
173     factorP = 0.5 _d 0
174     DO j=jMin,jMax
175     DO i=iMin,iMax
176     dPhiHydX(i,j) = dPhiHydX(i,j)
177     & +factorP*(alphRho(i-1,j)+alphRho(i,j))
178     & *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))
179     & *rC(k)*recip_dxC(i,j,bi,bj)
180     dPhiHydY(i,j) = dPhiHydY(i,j)
181     & +factorP*(alphRho(i,j-1)+alphRho(i,j))
182     & *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))
183     & *rC(k)*recip_dyC(i,j,bi,bj)
184     ENDDO
185     ENDDO
186     ELSEIF ( buoyancyRelation .EQ. 'ATMOSPHERIC' ) THEN
187     C-- p* coordinate slope term: alpha' * Grad_r( p )
188     conv_theta2T = (rC(k)/atm_Po)**atm_kappa
189     factorP = (atm_Rd/rC(k))*conv_theta2T*0.5 _d 0
190     DO j=jMin,jMax
191     DO i=iMin,iMax
192     dPhiHydX(i,j) = dPhiHydX(i,j)
193 jmc 1.5 & +factorP*(alphRho(i-1,j)+alphRho(i,j))
194 jmc 1.3 & *(rStarFacC(i,j,bi,bj)-rStarFacC(i-1,j,bi,bj))
195     & *rC(k)*recip_dxC(i,j,bi,bj)
196     dPhiHydY(i,j) = dPhiHydY(i,j)
197 jmc 1.5 & +factorP*(alphRho(i,j-1)+alphRho(i,j))
198 jmc 1.3 & *(rStarFacC(i,j,bi,bj)-rStarFacC(i,j-1,bi,bj))
199     & *rC(k)*recip_dyC(i,j,bi,bj)
200     ENDDO
201     ENDDO
202     ENDIF
203     ENDIF
204     #endif /* NONLIN_FRSURF */
205 jmc 1.1
206     #endif /* INCLUDE_PHIHYD_CALCULATION_CODE */
207    
208     RETURN
209     END
  ViewVC Help
Powered by ViewVC 1.1.22