Line data Source code
1 : !================================================================================
2 : ! utility module for driver input data
3 : !================================================================================
4 : module drv_input_data
5 :
6 : use shr_kind_mod, only: r8=>SHR_KIND_R8, cl=>SHR_KIND_CL, cs=>SHR_KIND_CS
7 : use cam_abortutils, only: endrun
8 : use spmd_utils, only: masterproc
9 : use ppgrid, only: pcols, pver, pverp, begchunk, endchunk
10 : use cam_logfile, only: iulog
11 : use pio, only: file_desc_t
12 : use time_manager, only: get_step_size
13 :
14 : implicit none
15 : private
16 : save
17 :
18 : public :: drv_input_data_open
19 : public :: drv_input_data_read
20 : public :: drv_input_data_close
21 : public :: drv_input_data_freq
22 : public :: drv_input_data_t
23 : public :: drv_input_data_get
24 :
25 : public :: drv_input_4d_t
26 : public :: drv_input_3d_t
27 : public :: drv_input_2d_t
28 : public :: drv_input_2di_t
29 :
30 : interface drv_input_data_get
31 : module procedure get_data3d
32 : module procedure get_data2d
33 : module procedure get_idata2d
34 : end interface
35 :
36 : real(r8) :: drv_input_data_freq != nan
37 :
38 : type drv_input_data_t
39 : integer :: ntimes
40 : integer, allocatable :: dates(:)
41 : integer, allocatable :: secs(:)
42 : real(r8), allocatable :: times(:)
43 : type(file_desc_t) :: piofile
44 : endtype drv_input_data_t
45 :
46 : type drv_input_4d_t
47 : real(r8), pointer :: array(:,:,:)
48 : endtype drv_input_4d_t
49 : type drv_input_3d_t
50 : real(r8), pointer :: array(:,:)
51 : endtype drv_input_3d_t
52 : type drv_input_2d_t
53 : real(r8), pointer :: array(:)
54 : endtype drv_input_2d_t
55 : type drv_input_2di_t
56 : integer, pointer :: array(:)
57 : endtype drv_input_2di_t
58 :
59 : character(len=4) :: lonname = ' '
60 : character(len=4) :: latname = ' '
61 :
62 : interface drv_input_data_read
63 : module procedure drv_input_data_read_2d
64 : module procedure drv_input_data_read_3d
65 : end interface
66 :
67 : contains
68 :
69 : !=================================================================================
70 : !=================================================================================
71 0 : subroutine drv_input_data_open( infile, indata )
72 :
73 : use cam_pio_utils, only: cam_pio_openfile
74 : use pio, only: PIO_NOCLOBBER, pio_inq_dimid, pio_inq_dimlen
75 : use pio, only: pio_inq_varid, pio_get_var
76 : use pio, only: pio_seterrorhandling, PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR
77 : use dyn_grid, only: get_horiz_grid_dim_d
78 :
79 : implicit none
80 :
81 : character(len=*), intent(in) :: infile
82 : type(drv_input_data_t), intent(out) :: indata
83 :
84 : integer :: id, ierr
85 : integer :: hdim1_d,hdim2_d, nlons
86 : integer :: dtime
87 : integer :: data_dtime
88 : character(len=*), parameter :: sub = 'drv_input_data_open: '
89 :
90 0 : dtime = get_step_size()
91 :
92 : ! open file and get fileid
93 : !
94 0 : call cam_pio_openfile( indata%piofile, infile, PIO_NOCLOBBER)
95 :
96 0 : if(masterproc) write(iulog,*) sub // 'opened: ',trim(infile)
97 :
98 : !
99 : ! check horizontal grid ...
100 : !
101 0 : call pio_seterrorhandling( indata%piofile, PIO_BCAST_ERROR)
102 0 : lonname = 'ncol'
103 0 : latname = ' '
104 0 : ierr = pio_inq_dimid( indata%piofile, lonname, id )
105 0 : if (ierr/=PIO_NOERR) then
106 0 : lonname = 'lon'
107 0 : latname = 'lat'
108 : endif
109 :
110 0 : ierr = pio_inq_dimid( indata%piofile, lonname, id )
111 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for lonname')
112 0 : ierr = pio_inq_dimlen( indata%piofile, id, nlons )
113 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for lonname')
114 :
115 0 : call get_horiz_grid_dim_d(hdim1_d,hdim2_d)
116 :
117 0 : if (hdim1_d /= nlons) then
118 0 : call endrun('drv_input_data_open: input file has incorrect horizontal resolution')
119 : endif
120 :
121 : !
122 : ! get time/date info ...
123 : !
124 0 : ierr = pio_inq_dimid( indata%piofile, 'time', id )
125 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for time')
126 0 : ierr = pio_inq_dimlen( indata%piofile, id, indata%ntimes )
127 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for time')
128 :
129 0 : allocate( indata%dates(indata%ntimes), indata%secs(indata%ntimes), indata%times(indata%ntimes) )
130 :
131 0 : ierr = pio_inq_varid( indata%piofile, 'date', id )
132 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for date')
133 0 : ierr = pio_get_var( indata%piofile, id, indata%dates )
134 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for date')
135 :
136 0 : ierr = pio_inq_varid( indata%piofile, 'datesec', id )
137 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for datesec')
138 0 : ierr = pio_get_var( indata%piofile, id, indata%secs )
139 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for datesec')
140 :
141 0 : ierr = pio_inq_varid( indata%piofile, 'time', id )
142 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for time')
143 0 : ierr = pio_get_var( indata%piofile, id, indata%times )
144 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for time')
145 :
146 0 : ierr = pio_inq_varid( indata%piofile, 'mdt', id )
147 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for mdt')
148 0 : ierr = pio_get_var( indata%piofile, id, data_dtime )
149 0 : if (ierr/=PIO_NOERR) call endrun(sub//'failed to get value for mdt')
150 :
151 0 : call pio_seterrorhandling( indata%piofile, PIO_INTERNAL_ERROR)
152 :
153 0 : if ( .not. (data_dtime == dtime)) then
154 0 : write( iulog, * ) sub//'data mdt does not match dtime... use dtime = ', data_dtime
155 0 : call endrun(sub//'data mdt does not match dtime.')
156 : endif
157 :
158 0 : end subroutine drv_input_data_open
159 :
160 : !================================================================================================
161 : !================================================================================================
162 0 : subroutine drv_input_data_close(indata)
163 0 : use pio, only: pio_closefile
164 : implicit none
165 :
166 : type(drv_input_data_t), intent(inout) :: indata
167 :
168 0 : deallocate( indata%dates, indata%secs, indata%times )
169 :
170 0 : call pio_closefile( indata%piofile )
171 :
172 0 : end subroutine drv_input_data_close
173 :
174 : !=================================================================================
175 : !=================================================================================
176 0 : function drv_input_data_read_2d( indata, fldname, recno, abort ) result(field_array)
177 : use ncdio_atm, only: infld
178 :
179 : implicit none
180 :
181 : type(drv_input_data_t), intent(inout) :: indata
182 : character(len=*), intent(in) :: fldname
183 : integer, intent(in) :: recno
184 : logical, optional,intent(in) :: abort
185 :
186 : logical :: found, abort_run
187 : real(r8) :: field_array(pcols,begchunk:endchunk)
188 :
189 0 : abort_run = .false.
190 0 : if (present(abort)) then
191 0 : abort_run = abort
192 : endif
193 :
194 : call infld( fldname, indata%piofile, trim(lonname), trim(latname), 1,pcols, begchunk,endchunk, &
195 0 : field_array, found, gridname='physgrid',timelevel=recno)
196 :
197 0 : if (.not.found) then
198 0 : if ( abort_run ) then
199 0 : call endrun('drv_input_data_read_2d: did not find '// trim(fldname))
200 : else
201 0 : if (masterproc) write( iulog, * ) 'drv_input_data_read_2d: ' // trim(fldname) // ' set to zero '
202 0 : field_array = 0._r8
203 : endif
204 : endif
205 :
206 0 : endfunction drv_input_data_read_2d
207 :
208 : !=================================================================================
209 : !=================================================================================
210 0 : function drv_input_data_read_3d( indata, fldname, vertname, vertsize, recno, abort ) result(field_array)
211 0 : use ncdio_atm, only: infld
212 : implicit none
213 :
214 : type(drv_input_data_t), intent(inout) :: indata
215 : character(len=*), intent(in) :: fldname
216 : character(len=*), intent(in) :: vertname
217 : integer, intent(in) :: vertsize
218 : integer, intent(in) :: recno
219 : logical, optional,intent(in) :: abort
220 :
221 : logical :: found, abort_run
222 : real(r8) :: field_array(pcols,vertsize,begchunk:endchunk)
223 :
224 : real(r8), allocatable :: tmp_array(:,:,:)
225 :
226 0 : abort_run = .false.
227 0 : if (present(abort)) then
228 0 : abort_run = abort
229 : endif
230 :
231 : call infld( fldname, indata%piofile, lonname, vertname, latname, 1,pcols, 1,vertsize, begchunk,endchunk, &
232 0 : field_array, found, gridname='physgrid',timelevel=recno)
233 :
234 0 : if (.not.found) then
235 0 : if ( abort_run ) then
236 0 : call endrun('drv_input_data_read_3d: did not find '// trim(fldname))
237 : else
238 0 : if (masterproc) write( iulog, * ) 'drv_input_data_read_3d: ' // trim(fldname) // ' set to zero '
239 0 : field_array = 0._r8
240 : endif
241 : endif
242 :
243 0 : endfunction drv_input_data_read_3d
244 :
245 : !================================================================================================
246 : !================================================================================================
247 0 : subroutine get_data3d(indata, infld_name, lev_name, nlev, recno, chunk_ptrs)
248 :
249 : type(drv_input_data_t), intent(inout) :: indata
250 : character(len=*), intent(in) :: infld_name
251 : character(len=*), intent(in) :: lev_name
252 : integer, intent(in) :: nlev
253 : integer, intent(in) :: recno
254 : type(drv_input_3d_t), intent(inout) :: chunk_ptrs(begchunk:endchunk)
255 :
256 0 : real(r8), allocatable :: data (:,:,:)
257 :
258 : integer :: c, ncol
259 :
260 0 : allocate( data (pcols, nlev, begchunk:endchunk) )
261 :
262 0 : data = drv_input_data_read( indata, infld_name, lev_name, nlev, recno )
263 0 : do c=begchunk,endchunk
264 0 : chunk_ptrs(c)%array(:,:) = data(:,:,c)
265 : enddo
266 :
267 0 : deallocate( data )
268 :
269 0 : end subroutine get_data3d
270 :
271 : !================================================================================================
272 : !================================================================================================
273 0 : subroutine get_data2d(indata, infld_name, recno, chunk_ptrs)
274 :
275 : type(drv_input_data_t), intent(inout) :: indata
276 : character(len=*), intent(in) :: infld_name
277 : integer, intent(in) :: recno
278 : type(drv_input_2d_t), intent(inout) :: chunk_ptrs(begchunk:endchunk)
279 :
280 0 : real(r8), allocatable :: data (:,:)
281 :
282 : integer :: c, ncol
283 :
284 0 : allocate( data (pcols, begchunk:endchunk) )
285 :
286 0 : data = drv_input_data_read( indata, infld_name, recno )
287 0 : do c=begchunk,endchunk
288 0 : chunk_ptrs(c)%array(:) = data(:,c)
289 : enddo
290 :
291 0 : deallocate( data )
292 :
293 0 : end subroutine get_data2d
294 :
295 : !================================================================================================
296 : !================================================================================================
297 0 : subroutine get_idata2d(indata, infld_name, recno, chunk_ptrs)
298 :
299 : type(drv_input_data_t), intent(inout) :: indata
300 : character(len=*), intent(in) :: infld_name
301 : integer, intent(in) :: recno
302 : type(drv_input_2di_t), intent(inout) :: chunk_ptrs(begchunk:endchunk)
303 :
304 0 : real(r8), allocatable :: data (:,:)
305 :
306 : integer :: c, ncol
307 :
308 0 : allocate( data (pcols, begchunk:endchunk) )
309 :
310 0 : data = drv_input_data_read(indata, infld_name, recno )
311 0 : do c=begchunk,endchunk
312 0 : chunk_ptrs(c)%array(:) = int(data(:,c))
313 : enddo
314 :
315 0 : deallocate( data )
316 :
317 0 : end subroutine get_idata2d
318 :
319 0 : end module drv_input_data
|
