UPP (develop)
Loading...
Searching...
No Matches
NGMSLP.f
Go to the documentation of this file.
1
2!
90 SUBROUTINE ngmslp
91
92!
93 use vrbls3d, only: zint, pint, t, q, zmid
94 use vrbls2d, only: slp, fis, z1000
95 use masks, only: lmh
96 use params_mod, only: rd, gi, g, h1, d608, gamma, d50, p1000
97 use ctlblk_mod, only: jsta, jend, im, jm, spval, ista, iend
98!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99 implicit none
100!
101 real,PARAMETER :: ZSL=0.0
102 real,PARAMETER :: TAUCR=rd*gi*290.66,const=0.005*g/rd
103 real,PARAMETER :: GORD=g/rd,dp=60.e2
104!
105! DECLARE VARIABLES
106!
107 integer I,J,LLMH
108 real ZSFC,PSFC,TVRT,TAU,TVRSFC,TAUSFC,TVRSL,TAUSL,TAUAVG, &
109 alpavg,pavg,rhoavg,rrhog
110!
111!**********************************************************************
112! START NGMSLP HERE.
113!
114! LOOP OVER HORIZONTAL GRID.
115!
116!!$omp parallel do
117!!$omp& private(llmh,pavg,psfc,qavg,rhoavg,rrhog,
118!!$omp& tau,tauavg,tausfc,tausl,tavg,tvrbar,tvrsfc,tvrsl,
119!!$omp& tvrt,tvrtal,zbar,zl,zsfc)
120 DO j=jsta,jend
121 DO i=ista,iend
122 llmh = nint(lmh(i,j))
123
124 if( pint(i,j,llmh+1)<spval) then
125
126 zsfc = zint(i,j,llmh+1)
127 psfc = pint(i,j,llmh+1)
128 slp(i,j) = psfc
129!
130! COMPUTE LAYER TAU (VIRTUAL TEMP*RD/G).
131 tvrt = t(i,j,llmh)*(h1+d608*q(i,j,llmh))
132 tau = tvrt*rd*gi
133!
134! COMPUTE TAU AT THE GROUND (Z=ZSFC) AND SEA LEVEL (Z=0)
135! ASSUMING A CONSTANT LAPSE RATE OF GAMMA=6.5DEG/KM.
136! TVRSFC = TVRT + (ZSFC- ZSL)*GAMMA
137 tvrsfc = tvrt + (zmid(i,j,llmh) - zsfc)*gamma ! Chuang
138 tausfc = tvrsfc*rd*gi
139! TVRSL = TVRT + (ZSFC- ZSL)*GAMMA
140 tvrsl = tvrt + (zmid(i,j,llmh) - zsl)*gamma
141 tausl = tvrsl*rd*gi
142!
143! IF NEED BE APPLY SHEULL CORRECTION.
144 IF ((tausl>taucr).AND.(tausfc<=taucr)) THEN
145 tausl=taucr
146 ELSEIF ((tausl>taucr).AND.(tausfc>taucr)) THEN
147 tausl = taucr-const*(tausfc-taucr)**2
148 ENDIF
149!
150! COMPUTE MEAN TAU.
151 tauavg = d50*(tausl+tausfc)
152!
153! COMPUTE SEA LEVEL PRESSURE.
154 IF (abs(fis(i,j))>1.0)slp(i,j) = psfc*exp(zsfc/tauavg)
155!
156! COMPUTE 1000MB HEIGHTS.
157 alpavg = d50*(alog(psfc)+alog(slp(i,j)))
158 pavg = exp(alpavg)
159 rhoavg = pavg*gi/tauavg
160 rrhog = h1/(rhoavg*g)
161 z1000(i,j) = (slp(i,j)-p1000)*rrhog
162
163 else
164 slp(i,j) = spval
165 z1000(i,j) = spval
166 endif
167
168!
169! MOVE TO NEXT HORIZONTAL GRIDPOINT.
170 ENDDO
171 ENDDO
172!
173!
174! END OF ROUTINE.
175!
176
177 RETURN
178 END
subroutine ngmslp
SUBPROGRAM: NGMSLP NMC SEA LEVEL PRESSURE REDUCTION PRGRMMR: TREADON ORG: W/NP2 DATE: 93-02-02
Definition NGMSLP.f:91