Line data Source code
1 : !-----------------------------------------------------------------------
2 : !BOP
3 : ! !ROUTINE: pkez --- Calculate solution to hydrostatic equation
4 : !
5 : ! !INTERFACE:
6 : !****6***0*********0*********0*********0*********0*********0**********72
7 33024 : subroutine pkez(nx, im, km, jfirst, jlast, kfirst, klast, &
8 33024 : ifirst, ilast, pe, pk, cap3v, ks, peln, pkz, eta, high_alt)
9 : !****6***0*********0*********0*********0*********0*********0**********72
10 : !
11 : ! !USES:
12 : use shr_kind_mod, only: r8 => shr_kind_r8
13 :
14 : implicit none
15 :
16 : !
17 : ! This routine may be called assuming either yz or xy decompositions.
18 : ! For xy decomposition, the effective "nx" is 1.
19 : !
20 :
21 : ! !INPUT PARAMETERS:
22 : integer, intent(in) :: nx ! SMP decomposition in x
23 : integer, intent(in) :: im, km ! Dimensions
24 : integer, intent(in) :: jfirst, jlast ! Latitude strip
25 : integer, intent(in) :: kfirst, klast ! Vertical strip
26 : integer, intent(in) :: ifirst, ilast ! Longitude strip
27 : real (r8), intent(in) :: pe(ifirst:ilast, kfirst:klast+1, jfirst:jlast) ! Edge pressure
28 : integer, intent(in) :: ks
29 : logical, intent(in) :: eta ! Is on ETA coordinate?
30 : ! True: input pe ; output pk, pkz, peln
31 : ! False: input pe, pk; output pkz, peln
32 : real (r8), intent(in) :: cap3v(ifirst:ilast,jfirst:jlast,km)
33 : logical, intent(in) :: high_alt
34 :
35 : ! !INPUT/OUTPUT PARAMETERS:
36 : real (r8), intent(inout) :: pk(ifirst:ilast,jfirst:jlast,kfirst:klast+1)
37 :
38 : ! !OUTPUT PARAMETERS
39 : real (r8), intent(out) :: pkz(ifirst:ilast,jfirst:jlast,kfirst:klast)
40 : real (r8), intent(out) :: peln(ifirst:ilast, kfirst:klast+1, jfirst:jlast) ! log pressure (pe) at layer edges
41 :
42 : ! !DESCRIPTION:
43 : !
44 : !
45 : ! !CALLED FROM:
46 : ! te_map and fvccm3
47 : !
48 : ! !REVISION HISTORY:
49 : !
50 : ! WS 99.05.19 : Removed fvcore.h
51 : ! WS 99.07.27 : Limited region to jfirst:jlast
52 : ! WS 99.10.22 : Deleted cp as argument (was not used)
53 : ! WS 99.11.05 : Documentation; pruning of arguments
54 : ! SJL 00.01.02 : SMP decomposition in i
55 : ! AAM 00.08.10 : Add kfirst:klast
56 : ! AAM 01.06.27 : Add ifirst:ilast
57 : !
58 : !EOP
59 : !---------------------------------------------------------------------
60 : !BOC
61 :
62 : ! Local
63 66048 : real (r8) pk2(ifirst:ilast, kfirst:klast+1)
64 : real (r8) pek
65 : real (r8) lnp
66 : real (r8) lnpk
67 66048 : real (r8) cap3vi(ifirst:ilast,jfirst:jlast,km+1)
68 66048 : real (r8) pkln(ifirst:ilast,km+1,jfirst:jlast) ! log pk at layer edges
69 : integer i, j, k, itot, nxu
70 : integer ixj, jp, it, i1, i2
71 :
72 33024 : itot = ilast - ifirst + 1
73 : ! Use smaller block sizes only if operating on full i domain
74 33024 : nxu = 1
75 33024 : if (itot .eq. im) nxu = nx
76 :
77 33024 : it = itot / nxu
78 33024 : jp = nxu * ( jlast - jfirst + 1 )
79 :
80 33024 : if ( eta ) then
81 0 : if (high_alt) then
82 : !$omp parallel do private(i,j,k)
83 0 : do k=2,km
84 0 : do j=jfirst,jlast
85 0 : do i=ifirst,ilast
86 0 : cap3vi(i,j,k) = 0.5_r8*(cap3v(i,j,k-1)+cap3v(i,j,k))
87 : enddo
88 : enddo
89 : enddo
90 0 : cap3vi(:,:,1) = 1.5_r8 * cap3v(:,:,1) - 0.5_r8 * cap3v(:,:,2)
91 0 : cap3vi(:,:,km+1) = 1.5_r8 * cap3v(:,:,km) - 0.5_r8 * cap3v(:,:,km-1)
92 : else
93 0 : cap3vi(:,:,:) = cap3v(ifirst,jfirst,1)
94 : endif
95 : endif
96 :
97 : !$omp parallel do &
98 : !$omp default(shared) &
99 : !$omp private(ixj, i1, i2, i, j, k, pek, lnp, pk2)
100 :
101 : ! WS 99.07.27 : Limited region to jfirst:jlast
102 :
103 132096 : do 1000 ixj=1,jp
104 :
105 99072 : j = jfirst + (ixj-1) / nxu
106 99072 : i1 = ifirst + it * mod(ixj-1, nxu)
107 99072 : i2 = i1 + it - 1
108 :
109 99072 : if ( eta ) then
110 :
111 : ! <<<<<<<<<<< Eta cordinate Coordinate >>>>>>>>>>>>>>>>>>>
112 0 : if (kfirst .eq. 1) then
113 0 : pek = pe(i1,1,j)**cap3vi(i1,j,1)
114 0 : lnp = log(pe(i1,1,j))
115 0 : lnpk = log(pek)
116 0 : do i=i1,i2
117 0 : pk2(i,1) = pek
118 0 : peln(i,1,j) = lnp
119 0 : pkln(i,1,j) = lnpk
120 : enddo
121 : endif
122 :
123 0 : if(ks .ne. 0) then
124 0 : do k=max(2,kfirst), min(ks+1,klast+1)
125 0 : pek = pe(i1,k,j)**cap3vi(i1,j,k)
126 0 : lnp = log(pe(i1,k,j))
127 0 : lnpk = log(pek)
128 0 : do i=i1,i2
129 0 : pk2(i,k) = pek
130 0 : peln(i,k,j) = lnp
131 0 : pkln(i,k,j) = lnpk
132 : enddo
133 : enddo
134 :
135 0 : do k=kfirst, min(ks,klast)
136 0 : pek = ( pk2(i1,k+1) - pk2(i1,k)) / &
137 0 : (pkln(i1,k+1,j) - pkln(i1,k,j))
138 0 : do i=i1,i2
139 0 : pkz(i,j,k) = pek
140 : enddo
141 : enddo
142 : endif
143 :
144 0 : do k=max(ks+2,kfirst), klast+1
145 : #if !defined( VECTOR_MATH )
146 0 : do i=i1,i2
147 0 : pk2(i,k) = pe(i,k,j)**cap3vi(i,j,k)
148 : enddo
149 : #else
150 : call vlog(pk2(i1,k), pe(i1,k,j), it)
151 : do i=i1,i2
152 : pk2(i,k) = cap3vi(i,j,k) * pk2(i,k)
153 : enddo
154 : call vexp(pk2(i1,k), pk2(i1,k), it)
155 : #endif
156 : enddo
157 :
158 0 : do k=max(ks+2,kfirst), klast+1
159 0 : do i=i1,i2
160 0 : peln(i,k,j) = log(pe(i,k,j))
161 0 : pkln(i,k,j) = log(pk2(i,k))
162 : enddo
163 : enddo
164 :
165 0 : do k=max(ks+1,kfirst), klast
166 0 : do i=i1,i2
167 0 : pkz(i,j,k) = (pk2(i,k+1) - pk2(i,k)) / &
168 0 : (pkln(i,k+1,j) - pkln(i,k,j))
169 : enddo
170 : enddo
171 :
172 0 : do k=kfirst, klast+1
173 0 : do i=i1,i2
174 0 : pk(i,j,k) = pk2(i,k)
175 : enddo
176 : enddo
177 :
178 : else
179 :
180 : ! <<<<<<<<<<< General Coordinate >>>>>>>>>>>>>>>>>>>
181 :
182 99072 : if (kfirst .eq. 1) then
183 99072 : lnp = log(pe(i1,1,j)) ! do log only one time at top -- assumes pe is constant at top
184 :
185 1287936 : do i=i1,i2
186 1287936 : peln(i,1,j) = lnp
187 : enddo
188 : endif
189 :
190 12978432 : do k=max(2,kfirst), klast+1
191 167530752 : do i=i1,i2
192 167431680 : peln(i,k,j) = log(pe(i,k,j))
193 : enddo
194 : enddo
195 13077504 : do k=kfirst, klast+1 ! variable pk at the top interface -->
196 168818688 : do i=i1,i2
197 168719616 : pk2(i,k) = pk(i,j,k)
198 : enddo
199 : enddo
200 99072 : if (high_alt) then
201 13077504 : do k=kfirst, klast+1 ! variable pk at the top interface -->
202 168818688 : do i=i1,i2
203 168719616 : pkln(i,k,j) = log(pk(i,j,k))
204 : enddo
205 : enddo
206 : endif
207 :
208 99072 : if (high_alt) then
209 12978432 : do k=kfirst, klast
210 167530752 : do i=i1,i2
211 618209280 : pkz(i,j,k) = ( pk2(i,k+1) - pk2(i,k) ) / &
212 785640960 : (pkln(i,k+1,j) - pkln(i,k,j))
213 : enddo
214 : enddo
215 : else
216 0 : do k=kfirst, klast
217 0 : do i=i1,i2
218 0 : pkz(i,j,k) = ( pk2(i,k+1) - pk2(i,k) ) / &
219 0 : (cap3v(i,j,k)*(peln(i,k+1,j) - peln(i,k,j)))
220 : enddo
221 : enddo
222 : endif
223 :
224 : endif
225 :
226 33024 : 1000 continue
227 :
228 33024 : return
229 : !EOC
230 : end
231 : !-----------------------------------------------------------------------
|
