9 use utilities,
only : error_handler, netcdf_err
15 integer,
public,
parameter :: n_tiles=6
17 integer,
public,
parameter :: vtype_water=0, & !< non-land
20 integer,
public,
parameter :: mtype_water=0, & !< water
22 type,
public :: grid_setup_type
23 character(7) :: descriptor
24 character(100) :: fname
26 character(15) :: mask_variable(1)
27 character(100) :: fname_mask
28 character(100) :: dir_mask
29 logical :: mask_from_input
30 character(100) :: fname_coord
31 character(100) :: dir_coord
36 public :: setup_grid, &
49 subroutine setup_grid(localpet, npets, grid_setup, mod_grid, timestamp )
54 type(grid_setup_type),
intent(in) :: grid_setup
55 integer,
intent(in) :: localpet, npets
56 integer,
intent(in),
optional :: timestamp
59 type(esmf_grid),
intent(out) :: mod_grid
63 type(esmf_field) :: mask_field(1,1)
64 real(esmf_kind_r8),
pointer :: ptr_maskvar(:,:)
65 integer(esmf_kind_i4),
pointer :: ptr_mask(:,:)
67 integer :: ierr, ncid, tile
68 character(len=128) :: fname_mask
69 character(len=3) :: tstr
74 select case (grid_setup%descriptor)
76 call create_grid_fv3(grid_setup%ires, trim(grid_setup%dir_coord), npets, localpet ,mod_grid)
78 call create_grid_gauss(grid_setup, npets, localpet, mod_grid)
80 call error_handler(
"unknown grid_setup%descriptor in setup_grid", 1)
86 mask_field(1,1) = esmf_fieldcreate(mod_grid, &
87 typekind=esmf_typekind_r8, &
88 staggerloc=esmf_staggerloc_center, &
89 name=
"input variable for mask", &
91 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
92 call error_handler(
"IN FieldCreate, mask_variable", ierr)
94 if (
present(timestamp))
then 95 write(tstr,
"(I3.3)") timestamp
96 fname_mask = trim(grid_setup%fname_mask)//tstr//
".nc" 98 fname_mask = trim(grid_setup%fname_mask)
101 call read_into_fields(localpet, grid_setup%ires, grid_setup%jres, trim(fname_mask), &
102 trim(grid_setup%dir_mask), grid_setup, 1, &
103 grid_setup%mask_variable(1), mask_field(1,1))
106 call esmf_fieldget(mask_field(1,1), &
107 farrayptr=ptr_maskvar, &
109 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
110 call error_handler(
"IN FieldGet", ierr)
113 call esmf_gridadditem(mod_grid, &
114 itemflag=esmf_griditem_mask, &
115 staggerloc=esmf_staggerloc_center, &
117 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
118 call error_handler(
"in GridAddItem mask", ierr)
120 call esmf_gridgetitem(mod_grid, &
121 itemflag=esmf_griditem_mask, &
122 farrayptr=ptr_mask, &
124 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
125 call error_handler(
"in GridGetItem mask", ierr)
129 select case (trim(grid_setup%mask_variable(1)))
130 case(
"vegetation_type")
131 where (nint(ptr_maskvar) == vtype_water ) ptr_mask = 0
132 where (nint(ptr_maskvar) == vtype_landice ) ptr_mask = 0
133 case(
"soilsnow_mask")
134 where (nint(ptr_maskvar) == mtype_water ) ptr_mask = 0
135 where (nint(ptr_maskvar) == mtype_snow ) ptr_mask = 0
137 call error_handler(
"unknown mask_variable", 1)
141 call esmf_fielddestroy(mask_field(1,1),rc=ierr)
142 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
143 call error_handler(
"DESTROYING FIELD", ierr)
145 end subroutine setup_grid
158 subroutine read_into_fields(localpet, i_dim, j_dim , fname_read, dir_read, &
159 grid_setup, n_vars, variable_list, fields)
164 integer,
intent(in) :: localpet, i_dim, j_dim, n_vars
165 character(*),
intent(in) :: fname_read
166 character(*),
intent(in) :: dir_read
167 type(grid_setup_type),
intent(in) :: grid_setup
169 character(len=15),
dimension(n_vars),
intent(in) :: variable_list
172 type(esmf_field),
dimension(1,n_vars),
intent(inout) :: fields
175 integer :: tt, id_var, ncid, ierr, v, j
177 character(len=1) :: tchar
178 character(len=500) :: fname
179 real(esmf_kind_r8),
allocatable :: array2d(:,:)
180 real(esmf_kind_r8),
allocatable :: array_in(:,:,:)
181 real(esmf_kind_r8),
allocatable :: temp_array(:,:,:)
183 allocate(array_in(n_vars,i_dim, j_dim))
184 allocate(array2d(i_dim, j_dim))
186 select case (grid_setup%descriptor)
192 call error_handler(
"unknown grid_setup%descriptor in read into fields", 1)
198 if (localpet == 0)
then 200 if ( n_files > 1)
then 201 write(tchar,
'(i1)') tt
202 fname = dir_read//
"/"//fname_read//
".tile"//tchar//
".nc" 204 fname = dir_read//
"/"//fname_read
207 print *,
'Reading ', trim(fname)
209 ierr=nf90_open(trim(fname),nf90_nowrite,ncid)
210 call netcdf_err(ierr,
'opening: '//trim(fname) )
213 print *,
'Reading ', trim(variable_list(v))
214 ierr=nf90_inq_varid(ncid, trim(variable_list(v)), id_var)
215 call netcdf_err(ierr,
'reading variable id' )
217 ierr=nf90_get_var(ncid, id_var, array_in(v,:,:))
218 call netcdf_err(ierr,
'reading variable' )
220 ierr = nf90_close(ncid)
223 if ( grid_setup%descriptor ==
'gau_inc')
then 224 allocate(temp_array(n_vars,i_dim, j_dim))
225 temp_array = array_in
227 array_in(:,:,j) = temp_array(:,:,j_dim-j+1)
229 deallocate(temp_array)
235 array2d=array_in(v,:,:)
236 call esmf_fieldscatter(fields(1,v), array2d, rootpet=0, tile=tt, rc=ierr)
237 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
238 call error_handler(
"IN FieldScatter", ierr)
248 end subroutine read_into_fields
262 subroutine write_from_fields(localpet, i_dim, j_dim , fname_out, dir_out, &
263 n_vars, n_tims, variable_list, fields, add_time_dim)
268 integer,
intent(in) :: localpet, i_dim, j_dim, n_vars, n_tims
269 character(*),
intent(in) :: fname_out
270 character(*),
intent(in) :: dir_out
271 character(15),
dimension(n_vars),
intent(in) :: variable_list
272 type(esmf_field),
dimension(n_tims,n_vars),
intent(in) :: fields
273 logical,
intent(in) :: add_time_dim
276 integer :: tt, id_var, ncid, ierr, &
277 id_x, id_y, id_t, v, t
278 character(len=1) :: tchar
279 character(len=500) :: fname
280 real(esmf_kind_r8),
allocatable :: array2d(:,:)
281 real(esmf_kind_r8),
allocatable :: array_out(:,:,:,:)
284 if (localpet == 0) print *,
'Writing ', trim(variable_list(v)),
' into field' 287 if (localpet==0)
then 288 allocate(array_out(n_vars, i_dim, j_dim, n_tims))
289 allocate(array2d(i_dim, j_dim))
291 allocate(array_out(0,0,0,0))
292 allocate(array2d(0,0))
300 call esmf_fieldgather(fields(t,v), array2d, rootpet=0, tile=tt, rc=ierr)
301 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
302 call error_handler(
"IN FieldGather", ierr)
303 array_out(v,:,:,t) = array2d
308 if (localpet == 0)
then 311 write(tchar,
'(i1)') tt
312 fname = dir_out//
"/"//fname_out//
".tile"//tchar//
".nc" 314 ierr = nf90_create(trim(fname), nf90_netcdf4, ncid)
315 call netcdf_err(ierr,
'creating file='//trim(fname) )
317 if (add_time_dim)
then 320 ierr = nf90_def_dim(ncid,
'Time', n_tims, id_t)
321 call netcdf_err(ierr,
'defining taxis dimension' )
324 ierr = nf90_def_dim(ncid,
'xaxis_1', i_dim, id_x)
325 call netcdf_err(ierr,
'defining xaxis dimension' )
327 ierr = nf90_def_dim(ncid,
'yaxis_1', j_dim, id_y)
328 call netcdf_err(ierr,
'defining yaxis dimension' )
333 if (add_time_dim)
then 337 ierr = nf90_def_var(ncid, trim(variable_list(v)), nf90_double, &
338 (/id_x, id_y, id_t/) , id_var)
340 call netcdf_err(ierr,
'defining '//variable_list(v) )
342 ierr = nf90_def_var(ncid, trim(variable_list(v)), nf90_double, &
343 (/id_x, id_y/) , id_var)
346 call netcdf_err(ierr,
'defining '//variable_list(v) )
348 ierr = nf90_put_var( ncid, id_var, array_out(v,:,:,:) )
349 call netcdf_err(ierr,
'writing '//variable_list(v) )
353 ierr = nf90_close(ncid)
360 deallocate(array_out)
362 end subroutine write_from_fields
373 subroutine create_grid_fv3(res_atm, dir_fix, npets, localpet, fv3_grid)
376 integer,
intent(in) :: npets, localpet
377 integer,
intent(in) :: res_atm
378 character(*),
intent(in) :: dir_fix
381 type(esmf_grid),
intent(out) :: fv3_grid
383 integer :: ierr, extra, tile
384 integer :: decomptile(2,n_tiles)
386 character(len=5) :: rchar
387 character(len=200) :: fname
389 if (localpet == 0) print*,
" creating fv3 grid for ", res_atm
392 extra = npets / n_tiles
394 decomptile(:,tile)=(/1,extra/)
398 write(rchar,
'(i5)') res_atm
399 fname = trim(dir_fix)//
"/C"//trim(adjustl(rchar))//
"_mosaic.nc" 402 fv3_grid = esmf_gridcreatemosaic(filename=trim(fname), &
403 regdecompptile=decomptile, &
404 staggerloclist=(/esmf_staggerloc_center, esmf_staggerloc_corner, &
405 esmf_staggerloc_edge1, esmf_staggerloc_edge2/), &
406 indexflag=esmf_index_global, &
407 tilefilepath=trim(dir_fix), &
409 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
410 call error_handler(
"IN GridCreateMosaic", ierr)
412 end subroutine create_grid_fv3
421 subroutine create_grid_gauss(grid_setup, npets, localpet, gauss_grid)
424 type(grid_setup_type),
intent(in) :: grid_setup
425 integer,
intent(in) :: npets, localpet
428 type(esmf_grid) :: gauss_grid
431 character(len=200) :: fname
433 fname = trim(grid_setup%dir_coord)//trim(grid_setup%fname_coord)
435 if (localpet == 0) print*,
" creating gauss grid for ", trim(fname)
437 fac = npets / n_tiles
438 gauss_grid = esmf_gridcreate(filename=trim(fname), &
439 fileformat=esmf_fileformat_scrip, &
440 regdecomp=(/n_tiles,fac/), addcornerstagger=.true., rc=ierr)
441 if(esmf_logfounderror(rctocheck=ierr,msg=esmf_logerr_passthru,line=__line__,file=__file__)) &
442 call error_handler(
"IN Gauss GridCreate", ierr)
444 end subroutine create_grid_gauss