UPP  11.0.0
 All Data Structures Files Functions Variables Pages
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(*,*)'xml_perl_data read Post flat file'
112 
113 ! Allocate paramset array size
114  if(me==0)write(*,*)'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(*,*)'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(*,*)'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 
ctlblk_mod
Definition: CTLBLK.f:1
xml_perl_data::paramset_t
Definition: xml_perl_data.f:48
rqstfld_mod
Definition: RQSTFLD.f:1
xml_perl_data::param_t
Definition: xml_perl_data.f:13
xml_perl_data::post_avblfld_t
Definition: xml_perl_data.f:70
xml_perl_data
Definition: xml_perl_data.f:1