CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
module_mp_tempo_tests.F90
1! Module for TEMPO Microphysics tests
2!=================================================================================================================
4
5#if defined(mpas)
6 use mpas_kind_types, only: wp => rkind, sp => r4kind, dp => r8kind
7 use mp_radar
8#elif defined(standalone)
9 use machine, only: wp => kind_phys, sp => kind_sngl_prec, dp => kind_dbl_prec
11#else
12 use machine, only: wp => kind_phys, sp => kind_sngl_prec, dp => kind_dbl_prec
14#define ccpp_default 1
15#endif
16
17 implicit none
18
19 integer, parameter :: ids=1, ide=1, jds=1, jde=1, kds=1
20 integer, parameter :: ims=1, ime=1, jms=1, jme=1, kms=1
21 integer, parameter :: its=1, ite=1, jts=1, jte=1, kts=1
22 real, parameter :: dt_in = 1
23 integer, parameter :: integration_length_sec = 3600
24 integer :: kde, kme, kte
25 logical :: l_mp_tables, hail_aware_flag, aerosol_aware_flag
26 real(wp), allocatable :: qv(:,:,:), qc(:,:,:), qr(:,:,:), qi(:,:,:), qs(:,:,:), qg(:,:,:), &
27 ni(:,:,:), nr(:,:,:), nc(:,:,:), nwfa(:,:,:), nifa(:,:,:), ng(:,:,:), qb(:,:,:)
28 real(wp), allocatable :: th(:,:,:), pii(:,:,:), p(:,:,:), w(:,:,:), dz(:,:,:), refl_10cm(:,:,:)
29 real(wp), allocatable :: re_cloud(:,:,:), re_ice(:,:,:), re_snow(:,:,:)
30 real(wp), dimension(its:ite,jts:jte) :: nwfa2d, nifa2d, rainnc, rainncv, sr
31
32 contains
33
34 !=================================================================================================================
35
36 subroutine init_tempo_flags_for_test_all_true()
37
38 l_mp_tables = .true.
39 aerosol_aware_flag = .true.
40 hail_aware_flag = .true.
41
42 end subroutine init_tempo_flags_for_test_all_true
43
44 !=================================================================================================================
45
46 subroutine init_mpas_59lev_convective_data_for_test(nlev)
47
48 integer, intent(in) :: nlev
49 real(wp), dimension(nlev) :: klevs, qv_in, qc_in, qr_in, qi_in, qs_in, qg_in, ni_in, nr_in, nc_in, &
50 nwfa_in, nifa_in, theta_in, ng_in, volg_in, pressure_in, w_in, dz_in
51 integer :: k
52
53 kde = nlev
54 kme = nlev
55 kte = nlev
56
57 ! opening data file
58 open (2, file = './data/mpas_59lev_test.txt', status = 'old')
59 read(2,*) ! header
60
61 do k = 1, nlev
62 read(2,*) klevs(k), qv_in(k), qc_in(k), qr_in(k), qi_in(k), qs_in(k), &
63 qg_in(k), ni_in(k), nr_in(k), nc_in(k), nwfa_in(k), nifa_in(k), &
64 theta_in(k), ng_in(k), volg_in(k), pressure_in(k), w_in(k), dz_in(k)
65 end do
66 close(2)
67
68 if(.not. allocated(qv)) allocate(qv(ite-its+1, kte-kts+1, jte-jts+1))
69 if(.not. allocated(qc)) allocate(qc(ite-its+1, kte-kts+1, jte-jts+1))
70 if(.not. allocated(qr)) allocate(qr(ite-its+1, kte-kts+1, jte-jts+1))
71 if(.not. allocated(qi)) allocate(qi(ite-its+1, kte-kts+1, jte-jts+1))
72 if(.not. allocated(qs)) allocate(qs(ite-its+1, kte-kts+1, jte-jts+1))
73 if(.not. allocated(qg)) allocate(qg(ite-its+1, kte-kts+1, jte-jts+1))
74 if(.not. allocated(ni)) allocate(ni(ite-its+1, kte-kts+1, jte-jts+1))
75 if(.not. allocated(nr)) allocate(nr(ite-its+1, kte-kts+1, jte-jts+1))
76 if(.not. allocated(nc)) allocate(nc(ite-its+1, kte-kts+1, jte-jts+1))
77 if(.not. allocated(nwfa)) allocate(nwfa(ite-its+1, kte-kts+1, jte-jts+1))
78 if(.not. allocated(nifa)) allocate(nifa(ite-its+1, kte-kts+1, jte-jts+1))
79 if(.not. allocated(ng)) allocate(ng(ite-its+1, kte-kts+1, jte-jts+1))
80 if(.not. allocated(qb)) allocate(qb(ite-its+1, kte-kts+1, jte-jts+1))
81 if(.not. allocated(th)) allocate(th(ite-its+1, kte-kts+1, jte-jts+1))
82 if(.not. allocated(p)) allocate(p(ite-its+1, kte-kts+1, jte-jts+1))
83 if(.not. allocated(pii)) allocate(pii(ite-its+1, kte-kts+1, jte-jts+1))
84 if(.not. allocated(w)) allocate(w(ite-its+1, kte-kts+1, jte-jts+1))
85 if(.not. allocated(dz)) allocate(dz(ite-its+1, kte-kts+1, jte-jts+1))
86 if(.not. allocated(refl_10cm)) allocate(refl_10cm(ite-its+1, kte-kts+1, jte-jts+1))
87 if(.not. allocated(re_cloud)) allocate(re_cloud(ite-its+1, kte-kts+1, jte-jts+1))
88 if(.not. allocated(re_ice)) allocate(re_ice(ite-its+1, kte-kts+1, jte-jts+1))
89 if(.not. allocated(re_snow)) allocate(re_snow(ite-its+1, kte-kts+1, jte-jts+1))
90
91 qv = reshape(qv_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
92 qc = reshape(qc_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
93 qr = reshape(qr_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
94 qi = reshape(qi_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
95 qs = reshape(qs_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
96 qg = reshape(qg_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
97 ni = reshape(ni_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
98 nr = reshape(nr_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
99 nc = reshape(nc_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
100 nwfa = reshape(nwfa_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
101 nifa = reshape(nifa_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
102 ng = reshape(ng_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
103 qb = reshape(volg_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
104 th = reshape(theta_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
105 p = reshape(pressure_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
106 w = reshape(w_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
107 dz = reshape(dz_in, (/ite-its+1, kte-kts+1, jte-jts+1/))
108
109 pii = (p/100000.0)**0.286
110 refl_10cm = 0.
111 nwfa2d = 0.
112 nifa2d = 0.
113 rainnc = 0.
114 rainncv = 0.
115 sr = 0.
116 re_cloud = 0.
117 re_ice = 0.
118 re_snow = 0.
119
120 end subroutine init_mpas_59lev_convective_data_for_test
121
122 !=================================================================================================================
123
124 subroutine mpas_test()
125
127 use module_mp_tempo, only : tempo_init, tempo_3d_to_1d_driver
128
129 ! local variables
130 integer :: t, itimestep, i, j, k
131
132 ! Initialize input data for tests
133 call init_mpas_59lev_convective_data_for_test(nlev=59)
134
135 ! Initialize TEMPO flags for tests
136 call init_tempo_flags_for_test_all_true()
137
138 ! Initialize TEMPO
139 write(*,*) '--- calling tempo_init()'
140 call tempo_init(l_mp_tables, hail_aware_flag, aerosol_aware_flag)
141
142 ! Time integration
143 do t = 1, integration_length_sec
144 itimestep = t
145
146 if (t == 1) then
147 write(*,*) '--- calling tempo_3d_to_1d_driver()'
148 endif
149
150 if (t == integration_length_sec) then
151 write(*,*) 'Final timestep for TEMPO microphysics: ', t
152 endif
153
154 call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, nc=nc, ng=ng, qb=qb, &
155 nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nwfa2d, th=th, pii=pii, p=p, w=w, dz=dz, dt_in=dt_in, &
156 itimestep=itimestep, rainnc=rainnc, rainncv=rainncv, sr=sr, &
157 refl_10cm=refl_10cm, re_cloud=re_cloud, re_ice=re_ice, re_snow=re_snow, &
158 has_reqc=0, has_reqi=0, has_reqs=0, &
159 ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, &
160 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, &
161 its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte)
162 enddo
163
164 ! output data to file
165 open(1, file = 'mpas_59lev_test_results.txt')
166 write(1,*) 'klev qv qc qr qi qs qg ni nr nc nwfa nifa theta ng volg pressure w dz'
167 do j = jts, jte
168 do i = its, ite
169 ! k-loop
170 do k = kts, kte
171 write(1,*) k, qv(i,k,j), qc(i,k,j), qr(i,k,j), qi(i,k,j), qs(i,k,j), qg(i,k,j), ni(i,k,j), nr(i,k,j), &
172 nc(i,k,j), nwfa(i,k,j), nifa(i,k,j), th(i,k,j), ng(i,k,j), qb(i,k,j), p(i,k,j), w(i,k,j), dz(i,k,j)
173 enddo
174 enddo
175 enddo
176
177 close(1)
178
179 end subroutine mpas_test
180 !=================================================================================================================
181
182 end module module_mp_tempo_tests
This module is more library code whereas the individual microphysics schemes contains specific detail...