Line data Source code
1 : !-----------------------------------------------------------------------
2 : !BOP
3 : ! !ROUTINE: dryairm --- Check dry air mass; set to a predefined value if
4 : ! nlres is false (initialization run)
5 : !
6 : ! !INTERFACE:
7 :
8 2304 : subroutine dryairm( grid, moun, ps, tracer, delp, &
9 2304 : pe, nlres_loc )
10 :
11 : ! !USES:
12 : use shr_kind_mod, only: r8 => shr_kind_r8
13 : use dynamics_vars, only: T_FVDYCORE_GRID
14 : #if defined( SPMD )
15 : #define CPP_PRT_PREFIX if( grid%iam == 0 )
16 : #else
17 : #define CPP_PRT_PREFIX
18 : #endif
19 :
20 : !fvitt
21 : use constituents, only: cnst_type
22 : use mean_module, only: gmeanxy
23 :
24 : use pio, only: file_desc_t
25 : use cam_initfiles, only: topo_file_get_id, scale_dry_air_mass
26 : use cam_logfile, only: iulog
27 : implicit none
28 :
29 : type (T_FVDYCORE_GRID), intent(in) :: grid
30 : logical, intent(in):: nlres_loc
31 : logical, intent(in):: moun
32 :
33 : real(r8), intent(inout) :: tracer(grid%ifirstxy:grid%ilastxy, &
34 : grid%jfirstxy:grid%jlastxy,grid%km,grid%ntotq) ! Tracers
35 : real(r8), intent(inout) :: ps(grid%ifirstxy:grid%ilastxy, &
36 : grid%jfirstxy:grid%jlastxy) ! surface pressure
37 : real(r8), intent(inout) :: delp(grid%ifirstxy:grid%ilastxy, &
38 : grid%jfirstxy:grid%jlastxy,grid%km) ! press. thickness
39 : real(r8), intent(inout) :: pe(grid%ifirstxy:grid%ilastxy,grid%km+1, &
40 : grid%jfirstxy:grid%jlastxy) ! edge pressure
41 :
42 : ! !DESCRIPTION:
43 : ! Perform adjustment of the total dry-air-mass while preserving total
44 : ! tracer mass
45 : ! Developer: S.-J. Lin, Aug 2000
46 : !
47 : ! !REVISION HISTORY:
48 : ! AAM 01.06.27 Assure agreement thru roundoff for 2D decomp.
49 : ! WS 05.07.06 Simplified interface with grid argument
50 : ! WS 05.08.26 Modified for XY decomposition
51 : ! WS 06.02.21 OMP bug fix (2nd to last DO), removed YZ ver.
52 : ! WS 06.07.01 Transitioned tracers q to T_TRACERS
53 : !
54 : !EOP
55 : !---------------------------------------------------------------------
56 : !BOC
57 :
58 : ! Use work arrays psdk/psdkg to assure identical answers through roundoff
59 : ! for different z decompositions
60 :
61 2304 : real(r8), allocatable :: psdk(:,:,:) ! local work array
62 2304 : real(r8), allocatable :: psdkg(:,:,:) ! global work array
63 : ! dry surface pressure
64 4608 : real(r8) psd(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy)
65 :
66 : integer :: im, jm, km ! Dimensions
67 : integer :: ifirstxy, ilastxy, jfirstxy, jlastxy ! XY slice
68 : integer :: nq ! Number of advective tracers
69 : real(r8):: ptop
70 :
71 : type(file_desc_t), pointer :: fh_topo
72 :
73 : integer i, j, k, ic
74 : real(r8) psm0, psm1
75 : real(r8) psdry
76 : real(r8) dpd
77 :
78 2304 : fh_topo => topo_file_get_id()
79 :
80 2304 : im = grid%im
81 2304 : jm = grid%jm
82 2304 : km = grid%km
83 :
84 2304 : ifirstxy = grid%ifirstxy
85 2304 : ilastxy = grid%ilastxy
86 2304 : jfirstxy = grid%jfirstxy
87 2304 : jlastxy = grid%jlastxy
88 2304 : nq = grid%nq
89 2304 : ptop = grid%ptop
90 :
91 2304 : if (scale_dry_air_mass <= 0.0_r8) return
92 :
93 : ! Check global maximum/minimum
94 :
95 2304 : call gmeanxy( grid, ps, psm0 )
96 :
97 11520 : allocate (psdk(ifirstxy:ilastxy,jfirstxy:jlastxy,km))
98 9216 : allocate (psdkg(ifirstxy:ilastxy,jfirstxy:jlastxy,km))
99 :
100 : !$omp parallel do private(i,j,k)
101 76032 : do k=1,km
102 297216 : do j=jfirstxy,jlastxy
103 5603328 : do i=ifirstxy,ilastxy
104 5529600 : psdk(i,j,k) = 0._r8
105 : enddo
106 : enddo
107 : enddo
108 :
109 : !$omp parallel do private(i,j,k)
110 76032 : do k=1,km
111 297216 : do j=jfirstxy,jlastxy
112 5603328 : do i=ifirstxy,ilastxy
113 5529600 : psdkg(i,j,k) = 0._r8
114 : enddo
115 : enddo
116 : enddo
117 :
118 : !$omp parallel do private(i,j)
119 9216 : do j=jfirstxy,jlastxy
120 175104 : do i=ifirstxy,ilastxy
121 172800 : psdk(i,j,1) = ptop
122 : enddo
123 : enddo
124 :
125 2304 : if( nq .ne. 0 ) then
126 : !$omp parallel do private(i,j,k)
127 76032 : do k=1,km
128 297216 : do j=jfirstxy,jlastxy
129 5603328 : do i=ifirstxy,ilastxy
130 15925248 : psdk(i,j,k) = psdk(i,j,k) + &
131 21454848 : (1._r8-tracer(i,j,k,1))*(pe(i,k+1,j)-pe(i,k,j))
132 : enddo
133 : enddo
134 : enddo
135 : else
136 :
137 : !$omp parallel do private(i,j,k)
138 0 : do k=1,km
139 0 : do j=jfirstxy,jlastxy
140 0 : do i=ifirstxy,ilastxy
141 0 : psdk(i,j,k) = psdk(i,j,k) + pe(i,k+1,j) - pe(i,k,j)
142 : enddo
143 : enddo
144 : enddo
145 :
146 : endif
147 :
148 : !$omp parallel do private(i,j,k)
149 76032 : do k=1,km
150 297216 : do j=jfirstxy,jlastxy
151 5603328 : do i=ifirstxy,ilastxy
152 5529600 : psdkg(i,j,k) = psdk(i,j,k)
153 : enddo
154 : enddo
155 : enddo
156 :
157 : !$omp parallel do private(i,j)
158 9216 : do j=jfirstxy,jlastxy
159 175104 : do i=ifirstxy,ilastxy
160 172800 : psd(i,j) = 0._r8
161 : enddo
162 : enddo
163 :
164 : !$omp parallel do private(i,j,k)
165 9216 : do j=jfirstxy,jlastxy
166 230400 : do k=1,km
167 5536512 : do i=ifirstxy,ilastxy
168 5529600 : psd(i,j) = psd(i,j) + psdkg(i,j,k)
169 : enddo
170 : enddo
171 : enddo
172 :
173 2304 : call gmeanxy( grid, psd, psdry )
174 :
175 2304 : CPP_PRT_PREFIX write(iulog,*) 'Total Mass=', 0.01_r8*psm0, '(mb), Dry Mass=', 0.01_r8*psdry, '(mb)'
176 2304 : CPP_PRT_PREFIX write(iulog,*) 'Total Precipitable Water =', (psm0-psdry)/9.80616_r8, '(kg/m**2)'
177 :
178 2304 : deallocate (psdk)
179 2304 : deallocate (psdkg)
180 :
181 2304 : if( nlres_loc ) return
182 :
183 768 : if(moun) then
184 768 : dpd = scale_dry_air_mass - psdry
185 : else
186 0 : dpd = 1000._r8*100._r8 - psdry
187 : endif
188 768 : CPP_PRT_PREFIX write(iulog,*) 'dry mass to be added =', 0.01_r8*dpd
189 :
190 : !$omp parallel do private(i, j, ic)
191 :
192 3072 : do j=jfirstxy,jlastxy
193 :
194 555264 : do ic=1,nq
195 13826304 : do i=ifirstxy,ilastxy
196 : ! fvitt
197 : ! don't want to change the initial dry mixing ratios of tracers
198 14598144 : if (cnst_type(ic).ne.'dry') tracer(i,j,km,ic) = &
199 2543616 : tracer(i,j,km,ic)*delp(i,j,km)/(delp(i,j,km)+dpd)
200 : enddo
201 : enddo
202 :
203 : ! Adjust the lowest Lagrangian layer
204 58368 : do i=ifirstxy,ilastxy
205 55296 : delp(i,j,km) = delp(i,j,km) + dpd
206 55296 : pe(i,km+1,j) = pe(i,km,j) + delp(i,j,km)
207 57600 : ps(i,j) = pe(i,km+1,j)
208 : enddo
209 : enddo
210 :
211 768 : call gmeanxy( grid, ps, psm1 )
212 :
213 768 : CPP_PRT_PREFIX write(iulog,*) 'Total moist surface pressure after adjustment (mb) = ',0.01_r8*psm1
214 :
215 : return
216 :
217 : !EOC
218 2304 : end subroutine dryairm
219 : !---------------------------------------------------------------------
|
