UPP v11.0.0
Loading...
Searching...
No Matches
xml_perl_data.f
1 module xml_perl_data
2!------------------------------------------------------------------------
3!
4! This module read in Perl XML processed flat file and
5! handle parameter marshalling for existing POST program
6!
7! program log:
8! March, 2015 Lin Gan Initial Code
9! July, 2016 J. Carley Clean up prints
10!
11!------------------------------------------------------------------------
12 implicit none
13 type param_t
14 integer :: post_avblfldidx=-9999
15 character(len=80) :: shortname=''
16 character(len=300) :: longname=''
17 integer :: mass_windpoint=1
18 character(len=30) :: pdstmpl='tmpl4_0'
19 character(len=30) :: pname=''
20 character(len=10) :: table_info=''
21 character(len=80) :: stats_proc=''
22 character(len=80) :: fixed_sfc1_type=''
23 integer, dimension(:), pointer :: scale_fact_fixed_sfc1 => null()
24 real, dimension(:), pointer :: level => null()
25 character(len=80) :: fixed_sfc2_type=''
26 integer, dimension(:), pointer :: scale_fact_fixed_sfc2 => null()
27 real, dimension(:), pointer :: level2 => null()
28 character(len=80) :: aerosol_type=''
29 character(len=80) :: typ_intvl_size=''
30 integer :: scale_fact_1st_size=0
31 real :: scale_val_1st_size=0.0
32 integer :: scale_fact_2nd_size=0
33 real :: scale_val_2nd_size=0.0
34 character(len=80) :: typ_intvl_wvlen=''
35 integer :: scale_fact_1st_wvlen=0
36 real :: scale_val_1st_wvlen=0.0
37 integer :: scale_fact_2nd_wvlen=0
38 real :: scale_val_2nd_wvlen=0.0
39 real, dimension(:), pointer :: scale => null()
40 integer :: stat_miss_val=0
41 integer :: leng_time_range_prev=0
42 integer :: time_inc_betwn_succ_fld=0
43 character(len=80) :: type_of_time_inc=''
44 character(len=20) :: stat_unit_time_key_succ=''
45 character(len=20) :: bit_map_flag=''
46 end type param_t
47
48 type paramset_t
49 character(len=6) :: datset=''
50 integer :: grid_num=255
51 character(len=20) :: sub_center=''
52 character(len=20) :: version_no=''
53 character(len=20) :: local_table_vers_no=''
54 character(len=20) :: sigreftime=''
55 character(len=20) :: prod_status=''
56 character(len=20) :: data_type=''
57 character(len=20) :: gen_proc_type=''
58 character(len=30) :: time_range_unit=''
59 character(len=50) :: orig_center=''
60 character(len=30) :: gen_proc=''
61 character(len=50) :: packing_method=''
62 character(len=30) :: order_of_sptdiff='1st_ord_sptdiff'
63 character(len=20) :: field_datatype=''
64 character(len=30) :: comprs_type=''
65 character(len=50) :: type_ens_fcst=''
66 character(len=50) :: type_derived_fcst=''
67 type(param_t), dimension(:), pointer :: param => null()
68 end type paramset_t
69
70 type post_avblfld_t
71 type(param_t), dimension(:), pointer :: param => null()
72 end type post_avblfld_t
73
74 type (paramset_t), dimension(:), pointer :: paramset
75 type (post_avblfld_t),save :: post_avblflds
76
77 contains
78 subroutine read_postxconfig()
79
80 use rqstfld_mod,only: num_post_afld,mxlvl,lvlsxml
81 use ctlblk_mod, only:tprec,tclod,trdlw,trdsw,tsrfc &
82 ,tmaxmin,td3d,me,filenameflat
83 implicit none
84
85! Read in the flat file postxconfig-NT.txt
86! for current working parameters and param
87 integer paramset_count, param_count
88
89! temp array count
90 integer cc
91 integer level_array_count
92 integer cv
93 integer level2_array_count
94 integer scale_array_count
95 integer i,j
96
97! evil for empty default char "?"
98 character(len=80) testcharname
99 character dummy_char
100 integer testintname
101
102! open the Post flat file
103! open(UNIT=22,file="postxconfig-NT.txt", &
104 open(unit=22,file=trim(filenameflat), &
105 form="formatted", access="sequential", &
106 status="old", position="rewind")
107
108! Take the first line as paramset_count
109 read(22,*)paramset_count
110
111 if(me==0)write(0,*)'xml_perl_data read Post flat file'
112
113! Allocate paramset array size
114 if(me==0)write(0,*)'allocate paramset to :', paramset_count
115
116 allocate(paramset(paramset_count))
117
118! Take the second line as param_count (on n..1 down loop)
119! stored as FILO
120
121! Initialize num_post_afld here
122 num_post_afld = 0
123
124 do i = paramset_count, 1, -1
125 read(22,*)param_count
126 if(me==0)write(0,*)'allocate param to :', param_count
127
128 allocate(paramset(i)%param(param_count))
129
130! LinGan lvlsxml is now a sum of flat file read out
131! Also allocate lvlsxml for rqstfld_mod
132 num_post_afld = num_post_afld + param_count
133 if(me==0)write(0,*)'sum num_post_afld :', num_post_afld
134
135 end do
136
137 if(allocated(lvlsxml)) deallocate(lvlsxml)
138 allocate(lvlsxml(mxlvl,num_post_afld))
139
140! For each paramset_count to read in all 16 control contain
141 do i = 1, paramset_count
142! allocate array size from param for current paramset
143! filter_char_inp is to check if "?" is found
144! then replace to empty string because it means no input.
145
146 read(22,*)paramset(i)%datset
147 call filter_char_inp(paramset(i)%datset)
148
149 param_count = size (paramset(i)%param)
150
151 read(22,*)paramset(i)%grid_num
152 read(22,*)paramset(i)%sub_center
153 call filter_char_inp(paramset(i)%sub_center)
154 read(22,*)paramset(i)%version_no
155 call filter_char_inp(paramset(i)%version_no)
156 read(22,*)paramset(i)%local_table_vers_no
157 call filter_char_inp(paramset(i)%local_table_vers_no)
158 read(22,*)paramset(i)%sigreftime
159 call filter_char_inp(paramset(i)%sigreftime)
160 read(22,*)paramset(i)%prod_status
161 call filter_char_inp(paramset(i)%prod_status)
162 read(22,*)paramset(i)%data_type
163 call filter_char_inp(paramset(i)%data_type)
164 read(22,*)paramset(i)%gen_proc_type
165 call filter_char_inp(paramset(i)%gen_proc_type)
166 if(me==0)print*,'gen_proc_type= ',paramset(i)%gen_proc_type
167 read(22,*)paramset(i)%time_range_unit
168 call filter_char_inp(paramset(i)%time_range_unit)
169 read(22,*)paramset(i)%orig_center
170 call filter_char_inp(paramset(i)%orig_center)
171 read(22,*)paramset(i)%gen_proc
172 call filter_char_inp(paramset(i)%gen_proc)
173 read(22,*)paramset(i)%packing_method
174 call filter_char_inp(paramset(i)%packing_method)
175 read(22,*)paramset(i)%order_of_sptdiff
176 read(22,*)paramset(i)%field_datatype
177 call filter_char_inp(paramset(i)%field_datatype)
178 read(22,*)paramset(i)%comprs_type
179 call filter_char_inp(paramset(i)%comprs_type)
180 if(me==0)print*,'finish reading comprs_type'
181 if(paramset(i)%gen_proc_type=='ens_fcst')then
182 read(22,*)paramset(i)%type_ens_fcst
183 call filter_char_inp(paramset(i)%type_ens_fcst)
184 tprec = 6 ! always 6 hr bucket for gefs
185 tclod = tprec
186 trdlw = tprec
187 trdsw = tprec
188 tsrfc = tprec
189 tmaxmin = tprec
190 td3d = tprec
191 end if
192 if(me==0)print*,'type_ens_fcst= ',paramset(i)%type_ens_fcst
193! Loop param_count (param datas 161) for gfsprs
194 do j = 1, param_count
195 read(22,*)paramset(i)%param(j)%post_avblfldidx
196 read(22,*)paramset(i)%param(j)%shortname
197 read(22,'(A300)')paramset(i)%param(j)%longname
198 call filter_char_inp(paramset(i)%param(j)%longname)
199
200 read(22,*)paramset(i)%param(j)%mass_windpoint
201 read(22,*)paramset(i)%param(j)%pdstmpl
202 read(22,*)paramset(i)%param(j)%pname
203 call filter_char_inp(paramset(i)%param(j)%pname)
204
205 read(22,*)paramset(i)%param(j)%table_info
206 call filter_char_inp(paramset(i)%param(j)%table_info)
207 read(22,*)paramset(i)%param(j)%stats_proc
208 call filter_char_inp(paramset(i)%param(j)%stats_proc)
209 read(22,*)paramset(i)%param(j)%fixed_sfc1_type
210 call filter_char_inp(paramset(i)%param(j)%fixed_sfc1_type)
211! Read array count for scale_fact_fixed_sfc1
212 read(22,*)cc
213!
214 allocate( paramset(i)%param(j)%scale_fact_fixed_sfc1(1))
215
216 if (cc > 0) then
217!
218 deallocate( paramset(i)%param(j)%scale_fact_fixed_sfc1)
219
220 allocate( paramset(i)%param(j)%scale_fact_fixed_sfc1(cc))
221 read(22,*)paramset(i)%param(j)%scale_fact_fixed_sfc1
222 else
223! If array count is zero dummy out the line
224!
225 paramset(i)%param(j)%scale_fact_fixed_sfc1(1)=0
226
227 read(22,*)dummy_char
228 endif
229
230 read(22,*)level_array_count
231 allocate( paramset(i)%param(j)%level(1))
232 if (level_array_count > 0) then
233 deallocate( paramset(i)%param(j)%level)
234 allocate( paramset(i)%param(j)%level(level_array_count))
235 read(22,*)paramset(i)%param(j)%level
236 else
237 paramset(i)%param(j)%level(1)=0
238 read(22,*)dummy_char
239 endif
240
241 read(22,*)paramset(i)%param(j)%fixed_sfc2_type
242 call filter_char_inp(paramset(i)%param(j)%fixed_sfc2_type)
243 read(22,*)cv
244 allocate( paramset(i)%param(j)%scale_fact_fixed_sfc2(1))
245 if (cv > 0) then
246 deallocate(paramset(i)%param(j)%scale_fact_fixed_sfc2)
247 allocate(paramset(i)%param(j)%scale_fact_fixed_sfc2(cv))
248 read(22,*)paramset(i)%param(j)%scale_fact_fixed_sfc2
249 else
250 paramset(i)%param(j)%scale_fact_fixed_sfc2(1)=0
251 read(22,*)dummy_char
252 endif
253
254 read(22,*)level2_array_count
255 if (level2_array_count > 0) then
256 allocate(paramset(i)%param(j)%level2(level2_array_count))
257 read(22,*)paramset(i)%param(j)%level2
258 else
259 read(22,*)dummy_char
260 endif
261
262 read(22,*)paramset(i)%param(j)%aerosol_type
263 call filter_char_inp(paramset(i)%param(j)%aerosol_type)
264 read(22,*)paramset(i)%param(j)%typ_intvl_size
265 call filter_char_inp(paramset(i)%param(j)%typ_intvl_size)
266
267 read(22,*)paramset(i)%param(j)%scale_fact_1st_size
268 read(22,*)paramset(i)%param(j)%scale_val_1st_size
269 read(22,*)paramset(i)%param(j)%scale_fact_2nd_size
270 read(22,*)paramset(i)%param(j)%scale_val_2nd_size
271 read(22,*)paramset(i)%param(j)%typ_intvl_wvlen
272 call filter_char_inp(paramset(i)%param(j)%typ_intvl_wvlen)
273
274 read(22,*)paramset(i)%param(j)%scale_fact_1st_wvlen
275 read(22,*)paramset(i)%param(j)%scale_val_1st_wvlen
276 read(22,*)paramset(i)%param(j)%scale_fact_2nd_wvlen
277 read(22,*)paramset(i)%param(j)%scale_val_2nd_wvlen
278 read(22,*)scale_array_count
279 allocate(paramset(i)%param(j)%scale(1))
280 if (scale_array_count > 0) then
281 deallocate(paramset(i)%param(j)%scale)
282 allocate(paramset(i)%param(j)%scale(scale_array_count))
283 read(22,*)paramset(i)%param(j)%scale
284 else
285 paramset(i)%param(j)%scale(1)=0
286 read(22,*)dummy_char
287 endif
288 read(22,*)paramset(i)%param(j)%stat_miss_val
289 read(22,*)paramset(i)%param(j)%leng_time_range_prev
290 read(22,*)paramset(i)%param(j)%time_inc_betwn_succ_fld
291 read(22,*)paramset(i)%param(j)%type_of_time_inc
292
293 call filter_char_inp(paramset(i)%param(j)%type_of_time_inc)
294 read(22,*)paramset(i)%param(j)%stat_unit_time_key_succ
295 call filter_char_inp(paramset(i)%param(j)%stat_unit_time_key_succ)
296 read(22,*)paramset(i)%param(j)%bit_map_flag
297 call filter_char_inp(paramset(i)%param(j)%bit_map_flag)
298
299! End of reading param
300 end do
301
302 post_avblflds%param => paramset(i)%param
303
304! End of reading paramset
305 end do
306 close (unit=22)
307
308 end subroutine read_postxconfig
309
310
311 subroutine filter_char_inp (inpchar)
312 implicit none
313 character, intent(inout) :: inpchar
314 if (inpchar == "?") then
315 inpchar = ""
316 endif
317 end subroutine filter_char_inp
318
319 end module
320