FV3DYCORE  Version 1.1.0
nh_core.F90
Go to the documentation of this file.
1 
2 !***********************************************************************
3 !* GNU Lesser General Public License
4 !*
5 !* This file is part of the FV3 dynamical core.
6 !*
7 !* The FV3 dynamical core is free software: you can redistribute it
8 !* and/or modify it under the terms of the
9 !* GNU Lesser General Public License as published by the
10 !* Free Software Foundation, either version 3 of the License, or
11 !* (at your option) any later version.
12 !*
13 !* The FV3 dynamical core is distributed in the hope that it will be
14 !* useful, but WITHOUT ANYWARRANTY; without even the implied warranty
15 !* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16 !* See the GNU General Public License for more details.
17 !*
18 !* You should have received a copy of the GNU Lesser General Public
19 !* License along with the FV3 dynamical core.
20 !* If not, see <http://www.gnu.org/licenses/>.
21 !***********************************************************************
22 
25 
27 
28 ! Modules Included:
29 ! <table>
30 ! <tr>
31 ! <th>Module Name</th>
32 ! <th>Functions Included</th>
33 ! </tr>
34 ! <tr>
35 ! <td>constants_mod</td>
36 ! <td>rdgas, cp_air, grav</td>
37 ! </tr>
38 ! <tr>
39 ! <td>nh_utils_mod</td>
40 ! <td>update_dz_c, update_dz_d, nest_halo_nh, sim3p0_solver, rim_2d,
41 ! sim_solver, sim1_solver, sim3_solver</td>
42 ! </tr>
43 ! <tr>
44 ! <td>tp_core_mod</td>
45 ! <td>fv_tp_2d</td>
46 ! </tr>
47 ! </table>
48 
49  use constants_mod, only: rdgas, cp_air, grav
50  use tp_core_mod, only: fv_tp_2d
54  use nh_utils_mod, only: riem_solver_c
55 
56  implicit none
57  private
58 
59  public riem_solver3, riem_solver_c, update_dz_c, update_dz_d, nest_halo_nh
60  real, parameter:: r3 = 1./3.
61 
62 CONTAINS
63 
64 
65  subroutine riem_solver3(ms, dt, is, ie, js, je, km, ng, &
66  isd, ied, jsd, jed, akap, cappa, cp, &
67 #ifdef MULTI_GASES
68  kapad, &
69 #endif
70  ptop, zs, q_con, w, delz, pt, &
71  delp, zh, pe, ppe, pk3, pk, peln, &
72  ws, scale_m, p_fac, a_imp, &
73  use_logp, last_call, fp_out)
74 !--------------------------------------------
75 ! !OUTPUT PARAMETERS
76 ! Ouput: gz: grav*height at edges
77 ! pe: full hydrostatic pressure
78 ! ppe: non-hydrostatic pressure perturbation
79 !--------------------------------------------
80  integer, intent(in):: ms, is, ie, js, je, km, ng
81  integer, intent(in):: isd, ied, jsd, jed
82  real, intent(in):: dt
83  real, intent(in):: akap, cp, ptop, p_fac, a_imp, scale_m
84  real, intent(in):: zs(isd:ied,jsd:jed)
85  logical, intent(in):: last_call, use_logp, fp_out
86  real, intent(in):: ws(is:ie,js:je)
87  real, intent(in), dimension(isd:,jsd:,1:):: q_con, cappa
88 #ifdef MULTI_GASES
89  real, intent(in), dimension(isd:ied,jsd:jed,km):: kapad
90 #endif
91  real, intent(in), dimension(isd:ied,jsd:jed,km):: delp, pt
92  real, intent(inout), dimension(isd:ied,jsd:jed,km+1):: zh
93  real, intent(inout), dimension(isd:ied,jsd:jed,km):: w
94  real, intent(inout):: pe(is-1:ie+1,km+1,js-1:je+1)
95  real, intent(out):: peln(is:ie,km+1,js:je)
96  real, intent(out), dimension(isd:ied,jsd:jed,km+1):: ppe
97  real, intent(out):: delz(is-ng:ie+ng,js-ng:je+ng,km)
98  real, intent(out):: pk(is:ie,js:je,km+1)
99  real, intent(out):: pk3(isd:ied,jsd:jed,km+1)
100 ! Local:
101  real, dimension(is:ie,km):: dm, dz2, pm2, w2, gm2, cp2
102  real, dimension(is:ie,km+1)::pem, pe2, peln2, peg, pelng
103 #ifdef MULTI_GASES
104  real, dimension(is:ie,km):: kapad2
105 #endif
106  real gama, rgrav, ptk, peln1
107  integer i, j, k
108 
109  gama = 1./(1.-akap)
110  rgrav = 1./grav
111  peln1 = log(ptop)
112  ptk = exp(akap*peln1)
113 
114 !$OMP parallel do default(none) shared(is,ie,js,je,km,delp,ptop,peln1,pk3,ptk,akap,rgrav,zh,pt, &
115 !$OMP w,a_imp,dt,gama,ws,p_fac,scale_m,ms,delz,last_call, &
116 #ifdef MULTI_GASES
117 !$OMP peln,pk,fp_out,ppe,use_logp,zs,pe,cappa,q_con,kapad ) &
118 !$OMP private(cp2, gm2, dm, dz2, pm2, pem, peg, pelng, pe2, peln2, w2,kapad2)
119 #else
120 !$OMP peln,pk,fp_out,ppe,use_logp,zs,pe,cappa,q_con ) &
121 !$OMP private(cp2, gm2, dm, dz2, pm2, pem, peg, pelng, pe2, peln2, w2)
122 #endif
123  do 2000 j=js, je
124 
125  do k=1,km
126  do i=is, ie
127  dm(i,k) = delp(i,j,k)
128 #ifdef MOIST_CAPPA
129  cp2(i,k) = cappa(i,j,k)
130 #endif
131 #ifdef MULTI_GASES
132  kapad2(i,k) = kapad(i,j,k)
133 #endif
134  enddo
135  enddo
136 
137  do i=is,ie
138  pem(i,1) = ptop
139  peln2(i,1) = peln1
140  pk3(i,j,1) = ptk
141 #ifdef USE_COND
142  peg(i,1) = ptop
143  pelng(i,1) = peln1
144 #endif
145  enddo
146  do k=2,km+1
147  do i=is,ie
148  pem(i,k) = pem(i,k-1) + dm(i,k-1)
149  peln2(i,k) = log(pem(i,k))
150 #ifdef USE_COND
151 ! Excluding contribution from condensates:
152 ! peln used during remap; pk3 used only for p_grad
153  peg(i,k) = peg(i,k-1) + dm(i,k-1)*(1.-q_con(i,j,k-1))
154  pelng(i,k) = log(peg(i,k))
155 #endif
156 !hmhj pk3 at interface , interface pk is using constant akap
157  pk3(i,j,k) = exp(akap*peln2(i,k))
158  enddo
159  enddo
160 
161  do k=1,km
162  do i=is, ie
163 #ifdef USE_COND
164  pm2(i,k) = (peg(i,k+1)-peg(i,k))/(pelng(i,k+1)-pelng(i,k))
165 
166 #ifdef MOIST_CAPPA
167  gm2(i,k) = 1. / (1.-cp2(i,k))
168 #endif
169 
170 #else
171  pm2(i,k) = dm(i,k)/(peln2(i,k+1)-peln2(i,k))
172 #endif
173  dm(i,k) = dm(i,k) * rgrav
174  dz2(i,k) = zh(i,j,k+1) - zh(i,j,k)
175  w2(i,k) = w(i,j,k)
176  enddo
177  enddo
178 
179 
180  if ( a_imp < -0.999 ) then
181  call sim3p0_solver(dt, is, ie, km, rdgas, gama, akap, &
182 #ifdef MULTI_GASES
183  kapad2, &
184 #endif
185  pe2, dm, &
186  pem, w2, dz2, pt(is:ie,j,1:km), ws(is,j), p_fac, scale_m )
187  elseif ( a_imp < -0.5 ) then
188  call sim3_solver(dt, is, ie, km, rdgas, gama, akap, &
189 #ifdef MULTI_GASES
190  kapad2, &
191 #endif
192  pe2, dm, &
193  pem, w2, dz2, pt(is:ie,j,1:km), ws(is,j), abs(a_imp), p_fac, scale_m)
194  elseif ( a_imp <= 0.5 ) then
195  call rim_2d(ms, dt, is, ie, km, rdgas, gama, gm2, &
196 #ifdef MULTI_GASES
197  kapad2, &
198 #endif
199  pe2, &
200  dm, pm2, w2, dz2, pt(is:ie,j,1:km), ws(is,j), .false.)
201  elseif ( a_imp > 0.999 ) then
202  call sim1_solver(dt, is, ie, km, rdgas, gama, gm2, cp2, akap, &
203 #ifdef MULTI_GASES
204  kapad2, &
205 #endif
206  pe2, dm, &
207  pm2, pem, w2, dz2, pt(is:ie,j,1:km), ws(is,j), p_fac)
208  else
209  call sim_solver(dt, is, ie, km, rdgas, gama, gm2, cp2, akap, &
210 #ifdef MULTI_GASES
211  kapad2, &
212 #endif
213  pe2, dm, &
214  pm2, pem, w2, dz2, pt(is:ie,j,1:km), ws(is,j), &
215  a_imp, p_fac, scale_m)
216  endif
217 
218 
219  do k=1, km
220  do i=is, ie
221  w(i,j,k) = w2(i,k)
222  delz(i,j,k) = dz2(i,k)
223  enddo
224  enddo
225 
226  if ( last_call ) then
227  do k=1,km+1
228  do i=is,ie
229  peln(i,k,j) = peln2(i,k)
230  pk(i,j,k) = pk3(i,j,k)
231  pe(i,k,j) = pem(i,k)
232  enddo
233  enddo
234  endif
235 
236  if( fp_out ) then
237  do k=1,km+1
238  do i=is, ie
239  ppe(i,j,k) = pe2(i,k) + pem(i,k)
240  enddo
241  enddo
242  else
243  do k=1,km+1
244  do i=is, ie
245  ppe(i,j,k) = pe2(i,k)
246  enddo
247  enddo
248  endif
249 
250  if ( use_logp ) then
251  do k=2,km+1
252  do i=is, ie
253  pk3(i,j,k) = peln2(i,k)
254  enddo
255  enddo
256  endif
257 
258  do i=is, ie
259  zh(i,j,km+1) = zs(i,j)
260  enddo
261  do k=km,1,-1
262  do i=is, ie
263  zh(i,j,k) = zh(i,j,k+1) - dz2(i,k)
264  enddo
265  enddo
266 
267 2000 continue
268 
269  end subroutine riem_solver3
270 
271 
272 end module nh_core_mod
subroutine, public sim_solver(dt, is, ie, km, rgas, gama, gm2, cp2, kappa, pe2, dm2, pm2, pem, w2, dz2, pt2, ws, alpha, p_fac, scale_m)
Definition: nh_utils.F90:1550
subroutine, public sim3_solver(dt, is, ie, km, rgas, gama, kappa, pe2, dm, pem, w2, dz2, pt2, ws, alpha, p_fac, scale_m)
Definition: nh_utils.F90:1012
real, parameter r3
Definition: nh_core.F90:60
The module &#39;nh_utils&#39; peforms non-hydrostatic computations.
Definition: nh_utils.F90:26
The module &#39;tp_core&#39; is a collection of routines to support FV transport.
Definition: tp_core.F90:24
subroutine, public update_dz_c(is, ie, js, je, km, ng, dt, dp0, zs, area, ut, vt, gz, ws, npx, npy, sw_corner, se_corner, ne_corner, nw_corner, bd, grid_type)
Definition: nh_utils.F90:76
subroutine, public riem_solver3(ms, dt, is, ie, js, je, km, ng, isd, ied, jsd, jed, akap, cappa, cp, ptop, zs, q_con, w, delz, pt, delp, zh, pe, ppe, pk3, pk, peln, ws, scale_m, p_fac, a_imp, use_logp, last_call, fp_out)
Definition: nh_core.F90:74
subroutine, public sim1_solver(dt, is, ie, km, rgas, gama, gm2, cp2, kappa, pe, dm2, pm2, pem, w2, dz2, pt2, ws, p_fac)
Definition: nh_utils.F90:1379
subroutine, public sim3p0_solver(dt, is, ie, km, rgas, gama, kappa, pe2, dm, pem, w2, dz2, pt2, ws, p_fac, scale_m)
Definition: nh_utils.F90:1199
subroutine, public nest_halo_nh(ptop, grav, kappa, cp, delp, delz, pt, phis, pkc, gz, pk3, npx, npy, npz, nested, pkc_pertn, computepk3, fullhalo, bd, regional)
Definition: nh_utils.F90:1910
subroutine, public fv_tp_2d(q, crx, cry, npx, npy, hord, fx, fy, xfx, yfx, gridstruct, bd, ra_x, ra_y, lim_fac, regional, mfx, mfy, mass, nord, damp_c)
The subroutine &#39;fv_tp_2d&#39; contains the FV advection scheme .
Definition: tp_core.F90:110
subroutine, public rim_2d(ms, bdt, is, ie, km, rgas, gama, gm2, pe2, dm2, pm2, w2, dz2, pt2, ws, c_core)
Definition: nh_utils.F90:747
subroutine, public update_dz_d(ndif, damp, hord, is, ie, js, je, km, ng, npx, npy, area, rarea, dp0, zs, zh, crx, cry, xfx, yfx, delz, ws, rdt, gridstruct, bd, lim_fac, regional)
Definition: nh_utils.F90:216
The module &#39;nh_core&#39; peforms non-hydrostatic computations.
Definition: nh_core.F90:26
subroutine, public riem_solver_c(ms, dt, is, ie, js, je, km, ng, akap, cappa, cp, ptop, hs, w3, pt, q_con, delp, gz, pef, ws, p_fac, a_imp, scale_m)
Definition: nh_utils.F90:338