16 use ensemble_manager_mod,
only : get_ensemble_id
17 use fms_mod,
only : write_version_number, open_namelist_file, check_nml_error
18 use fms_io_mod,
only : file_exist, field_size, read_data
19 use fms_io_mod,
only : field_exists => field_exist, io_infra_end=>fms_io_exit
20 use fms_io_mod,
only : get_filename_appendix => get_filename_appendix
21 use mpp_domains_mod,
only : domain1d, domain2d, mpp_get_domain_components
22 use mpp_domains_mod,
only : center, corner, north_face=>north, east_face=>east
23 use mpp_io_mod,
only : open_file => mpp_open, close_file => mpp_close
24 use mpp_io_mod,
only : mpp_write_meta, write_field => mpp_write, mpp_get_info
25 use mpp_io_mod,
only : mpp_get_atts, mpp_get_axes, get_axis_data=>mpp_get_axis_data, axistype
26 use mpp_io_mod,
only : mpp_get_fields, fieldtype, axistype, flush_file => mpp_flush
27 use mpp_io_mod,
only : append_file=>mpp_append, ascii_file=>mpp_ascii
28 use mpp_io_mod,
only : multiple=>mpp_multi, netcdf_file=>mpp_netcdf
29 use mpp_io_mod,
only : overwrite_file=>mpp_overwr, readonly_file=>mpp_rdonly
30 use mpp_io_mod,
only : single_file=>mpp_single, writeonly_file=>mpp_wronly
31 use mpp_io_mod,
only : mpp_append, mpp_multi, mpp_overwr, mpp_netcdf, mpp_rdonly
32 use mpp_io_mod,
only : get_file_info=>mpp_get_info, get_file_atts=>mpp_get_atts
33 use mpp_io_mod,
only : get_file_fields=>mpp_get_fields, get_file_times=>mpp_get_times
34 use mpp_io_mod,
only : io_infra_init=>mpp_io_init
38 implicit none ;
private
40 public :: close_file,
create_file, field_exists, field_size, fieldtype, get_filename_appendix
41 public ::
file_exists, flush_file, get_file_info, get_file_atts, get_file_fields
45 public :: open_namelist_file, check_nml_error, io_infra_init, io_infra_end
46 public :: append_file, ascii_file, multiple, netcdf_file, overwrite_file
47 public :: readonly_file, single_file, writeonly_file
48 public :: center, corner, north_face, east_face
50 public :: get_axis_data
54 character(len=64) :: name
55 character(len=48) :: units
56 character(len=240) :: longname
57 character(len=8) :: hor_grid
58 character(len=8) :: z_grid
59 character(len=8) :: t_grid
60 character(len=64) :: cmor_field_name
61 character(len=64) :: cmor_units
62 character(len=240) :: cmor_longname
92 subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit, G, dG, GV, checksums)
93 integer,
intent(out) :: unit
95 character(len=*),
intent(in) :: filename
96 type(
vardesc),
intent(in) :: vars(:)
97 integer,
intent(in) :: novars
98 type(fieldtype),
intent(inout) :: fields(:)
99 integer,
optional,
intent(in) :: threading
100 real,
optional,
intent(in) :: timeunit
111 integer(kind=8),
optional,
intent(in) :: checksums(:,:)
113 logical :: use_lath, use_lonh, use_latq, use_lonq, use_time
114 logical :: use_layer, use_int, use_periodic
115 logical :: one_file, domain_set
116 type(axistype) :: axis_lath, axis_latq, axis_lonh, axis_lonq
117 type(axistype) :: axis_layer, axis_int, axis_time, axis_periodic
118 type(axistype) :: axes(4)
120 type(domain1d) :: x_domain, y_domain
121 integer :: numaxes, pack, thread, k
122 integer :: isg, ieg, jsg, jeg, isgb, iegb, jsgb, jegb
123 integer :: var_periods, num_periods=0
124 real,
dimension(:),
allocatable :: period_val
125 real,
pointer,
dimension(:) :: &
126 gridlatt => null(), &
127 gridlatb => null(), &
128 gridlont => null(), gridlonb => null()
129 character(len=40) :: time_units, x_axis_units, y_axis_units
130 character(len=8) :: t_grid, t_grid_read
132 use_lath = .false. ; use_lonh = .false.
133 use_latq = .false. ; use_lonq = .false.
134 use_time = .false. ; use_periodic = .false.
135 use_layer = .false. ; use_int = .false.
138 if (
PRESENT(threading)) thread = threading
142 domain_set = .true. ; domain => g%Domain
143 gridlatt => g%gridLatT ; gridlatb => g%gridLatB
144 gridlont => g%gridLonT ; gridlonb => g%gridLonB
145 x_axis_units = g%x_axis_units ; y_axis_units = g%y_axis_units
146 isg = g%isg ; ieg = g%ieg ; jsg = g%jsg ; jeg = g%jeg
147 isgb = g%IsgB ; iegb = g%IegB ; jsgb = g%JsgB ; jegb = g%JegB
148 elseif (
present(dg))
then
149 domain_set = .true. ; domain => dg%Domain
150 gridlatt => dg%gridLatT ; gridlatb => dg%gridLatB
151 gridlont => dg%gridLonT ; gridlonb => dg%gridLonB
152 x_axis_units = dg%x_axis_units ; y_axis_units = dg%y_axis_units
153 isg = dg%isg ; ieg = dg%ieg ; jsg = dg%jsg ; jeg = dg%jeg
154 isgb = dg%IsgB ; iegb = dg%IegB ; jsgb = dg%JsgB ; jegb = dg%JegB
158 if (domain_set) one_file = (thread == single_file)
161 call open_file(unit, filename, mpp_overwr, mpp_netcdf, threading=thread)
163 call open_file(unit, filename, mpp_overwr, mpp_netcdf, domain=domain%mpp_domain)
168 select case (vars(k)%hor_grid)
169 case (
'h') ; use_lath = .true. ; use_lonh = .true.
170 case (
'q') ; use_latq = .true. ; use_lonq = .true.
171 case (
'u') ; use_lath = .true. ; use_lonq = .true.
172 case (
'v') ; use_latq = .true. ; use_lonh = .true.
173 case (
'T') ; use_lath = .true. ; use_lonh = .true.
174 case (
'Bu') ; use_latq = .true. ; use_lonq = .true.
175 case (
'Cu') ; use_lath = .true. ; use_lonq = .true.
176 case (
'Cv') ; use_latq = .true. ; use_lonh = .true.
179 call mom_error(warning,
"MOM_io create_file: "//trim(vars(k)%name)//&
180 " has unrecognized hor_grid "//trim(vars(k)%hor_grid))
182 select case (vars(k)%z_grid)
183 case (
'L') ; use_layer = .true.
184 case (
'i') ; use_int = .true.
187 call mom_error(fatal,
"MOM_io create_file: "//trim(vars(k)%name)//&
188 " has unrecognized z_grid "//trim(vars(k)%z_grid))
190 t_grid = adjustl(vars(k)%t_grid)
191 select case (t_grid(1:1))
192 case (
's',
'a',
'm') ; use_time = .true.
193 case (
'p') ; use_periodic = .true.
194 if (len_trim(t_grid(2:8)) <= 0)
call mom_error(fatal, &
195 "MOM_io create_file: No periodic axis length was specified in "//&
196 trim(vars(k)%t_grid) //
" in the periodic axes of variable "//&
197 trim(vars(k)%name)//
" in file "//trim(filename))
198 var_periods = -9999999
199 t_grid_read = adjustl(t_grid(2:8))
200 read(t_grid_read,*) var_periods
201 if (var_periods == -9999999)
call mom_error(fatal, &
202 "MOM_io create_file: Failed to read the number of periods from "//&
203 trim(vars(k)%t_grid) //
" in the periodic axes of variable "//&
204 trim(vars(k)%name)//
" in file "//trim(filename))
205 if (var_periods < 1)
call mom_error(fatal,
"MOM_io create_file: "//&
206 "variable "//trim(vars(k)%name)//
" in file "//trim(filename)//&
207 " uses a periodic time axis, and must have a positive "//&
208 "value for the number of periods in "//vars(k)%t_grid )
209 if ((num_periods > 0) .and. (var_periods /= num_periods)) &
210 call mom_error(fatal,
"MOM_io create_file: "//&
211 "Only one value of the number of periods can be used in the "//&
212 "create_file call for file "//trim(filename)//
". The second is "//&
213 "variable "//trim(vars(k)%name)//
" with t_grid "//vars(k)%t_grid )
215 num_periods = var_periods
218 call mom_error(warning,
"MOM_io create_file: "//trim(vars(k)%name)//&
219 " has unrecognized t_grid "//trim(vars(k)%t_grid))
223 if ((use_lath .or. use_lonh .or. use_latq .or. use_lonq))
then
224 if (.not.domain_set)
call mom_error(fatal,
"create_file: "//&
225 "An ocean_grid_type or dyn_horgrid_type is required to create a file with a horizontal coordinate.")
227 call mpp_get_domain_components(domain%mpp_domain, x_domain, y_domain)
229 if ((use_layer .or. use_int) .and. .not.
present(gv))
call mom_error(fatal, &
230 "create_file: A vertical grid type is required to create a file with a vertical coordinate.")
236 call mpp_write_meta(unit, axis_lath, name=
"lath", units=y_axis_units, longname=
"Latitude", &
237 cartesian=
'Y', domain = y_domain, data=gridlatt(jsg:jeg))
240 call mpp_write_meta(unit, axis_lonh, name=
"lonh", units=x_axis_units, longname=
"Longitude", &
241 cartesian=
'X', domain = x_domain, data=gridlont(isg:ieg))
244 call mpp_write_meta(unit, axis_latq, name=
"latq", units=y_axis_units, longname=
"Latitude", &
245 cartesian=
'Y', domain = y_domain, data=gridlatb(jsgb:jegb))
248 call mpp_write_meta(unit, axis_lonq, name=
"lonq", units=x_axis_units, longname=
"Longitude", &
249 cartesian=
'X', domain = x_domain, data=gridlonb(isgb:iegb))
252 call mpp_write_meta(unit, axis_layer, name=
"Layer", units=trim(gv%zAxisUnits), &
253 longname=
"Layer "//trim(gv%zAxisLongName), cartesian=
'Z', &
254 sense=1, data=gv%sLayer(1:gv%ke))
257 call mpp_write_meta(unit, axis_int, name=
"Interface", units=trim(gv%zAxisUnits), &
258 longname=
"Interface "//trim(gv%zAxisLongName), cartesian=
'Z', &
259 sense=1, data=gv%sInterface(1:gv%ke+1))
261 if (use_time)
then ;
if (
present(timeunit))
then
263 if (timeunit < 0.0)
then
265 elseif ((timeunit >= 0.99) .and. (timeunit < 1.01))
then
266 time_units =
"seconds"
267 elseif ((timeunit >= 3599.0) .and. (timeunit < 3601.0))
then
269 elseif ((timeunit >= 86399.0) .and. (timeunit < 86401.0))
then
271 elseif ((timeunit >= 3.0e7) .and. (timeunit < 3.2e7))
then
274 write(time_units,
'(es8.2," s")') timeunit
277 call mpp_write_meta(unit, axis_time, name=
"Time", units=time_units, longname=
"Time", cartesian=
'T')
279 call mpp_write_meta(unit, axis_time, name=
"Time", units=
"days", longname=
"Time",cartesian=
'T')
282 if (use_periodic)
then
283 if (num_periods <= 1)
call mom_error(fatal,
"MOM_io create_file: "//&
284 "num_periods for file "//trim(filename)//
" must be at least 1.")
286 allocate(period_val(num_periods))
287 do k=1,num_periods ; period_val(k) = real(k) ;
enddo
288 call mpp_write_meta(unit, axis_periodic, name=
"Period", units=
"nondimensional", &
289 longname=
"Periods for cyclical varaiables", cartesian=
't', data=period_val)
290 deallocate(period_val)
295 select case (vars(k)%hor_grid)
296 case (
'h') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath
297 case (
'q') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq
298 case (
'u') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath
299 case (
'v') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq
300 case (
'T') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_lath
301 case (
'Bu') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_latq
302 case (
'Cu') ; numaxes = 2 ; axes(1) = axis_lonq ; axes(2) = axis_lath
303 case (
'Cv') ; numaxes = 2 ; axes(1) = axis_lonh ; axes(2) = axis_latq
306 call mom_error(warning,
"MOM_io create_file: "//trim(vars(k)%name)//&
307 " has unrecognized hor_grid "//trim(vars(k)%hor_grid))
309 select case (vars(k)%z_grid)
310 case (
'L') ; numaxes = numaxes+1 ; axes(numaxes) = axis_layer
311 case (
'i') ; numaxes = numaxes+1 ; axes(numaxes) = axis_int
314 call mom_error(fatal,
"MOM_io create_file: "//trim(vars(k)%name)//&
315 " has unrecognized z_grid "//trim(vars(k)%z_grid))
317 t_grid = adjustl(vars(k)%t_grid)
318 select case (t_grid(1:1))
319 case (
's',
'a',
'm') ; numaxes = numaxes+1 ; axes(numaxes) = axis_time
320 case (
'p') ; numaxes = numaxes+1 ; axes(numaxes) = axis_periodic
323 call mom_error(warning,
"MOM_io create_file: "//trim(vars(k)%name)//&
324 " has unrecognized t_grid "//trim(vars(k)%t_grid))
328 if (
present(checksums))
then
329 call mpp_write_meta(unit, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, &
330 vars(k)%longname, pack = pack, checksum=checksums(k,:))
332 call mpp_write_meta(unit, fields(k), axes(1:numaxes), vars(k)%name, vars(k)%units, &
333 vars(k)%longname, pack = pack)
337 if (use_lath)
call write_field(unit, axis_lath)
338 if (use_latq)
call write_field(unit, axis_latq)
339 if (use_lonh)
call write_field(unit, axis_lonh)
340 if (use_lonq)
call write_field(unit, axis_lonq)
341 if (use_layer)
call write_field(unit, axis_layer)
342 if (use_int)
call write_field(unit, axis_int)
343 if (use_periodic)
call write_field(unit, axis_periodic)
352 subroutine reopen_file(unit, filename, vars, novars, fields, threading, timeunit, G, dG, GV)
353 integer,
intent(out) :: unit
355 character(len=*),
intent(in) :: filename
356 type(
vardesc),
intent(in) :: vars(:)
357 integer,
intent(in) :: novars
358 type(fieldtype),
intent(inout) :: fields(:)
359 integer,
optional,
intent(in) :: threading
360 real,
optional,
intent(in) :: timeunit
373 character(len=200) :: check_name, mesg
374 integer :: length, ndim, nvar, natt, ntime, thread
375 logical :: exists, one_file, domain_set
378 if (
PRESENT(threading)) thread = threading
380 check_name = filename
381 length = len(trim(check_name))
382 if (check_name(length-2:length) /=
".nc") check_name = trim(check_name)//
".nc"
383 if (thread /= single_file) check_name = trim(check_name)//
".0000"
385 inquire(file=check_name,exist=exists)
387 if (.not.exists)
then
388 call create_file(unit, filename, vars, novars, fields, threading, timeunit, &
394 domain_set = .true. ; domain => g%Domain
395 elseif (
present(dg))
then
396 domain_set = .true. ; domain => dg%Domain
400 if (domain_set) one_file = (thread == single_file)
403 call open_file(unit, filename, mpp_append, mpp_netcdf, threading=thread)
405 call open_file(unit, filename, mpp_append, mpp_netcdf, domain=domain%mpp_domain)
409 call mpp_get_info(unit, ndim, nvar, natt, ntime)
412 write (mesg,*)
"Reopening file ",trim(filename),
" apparently had ",nvar,&
413 " variables. Clobbering and creating file with ",novars,
" instead."
415 call create_file(unit, filename, vars, novars, fields, threading, timeunit, g=g, gv=gv)
416 elseif (nvar /= novars)
then
417 write (mesg,*)
"Reopening file ",trim(filename),
" with ",novars,&
418 " variables instead of ",nvar,
"."
422 if (nvar>0)
call mpp_get_fields(unit,fields(1:nvar))
438 character(len=*),
intent(in) :: filename
439 character(len=*),
intent(in) :: axis_name
440 real,
dimension(:),
intent(out) :: var
442 integer :: i,len,unit, ndim, nvar, natt, ntime
443 logical :: axis_found
444 type(axistype),
allocatable :: axes(:)
445 type(axistype) :: time_axis
446 character(len=32) :: name, units
448 call open_file(unit, trim(filename), action=mpp_rdonly, form=mpp_netcdf, &
449 threading=mpp_multi, fileset=single_file)
452 call mpp_get_info(unit, ndim, nvar, natt, ntime)
457 call mpp_get_axes(unit, axes, time_axis)
461 call mpp_get_atts(axes(i), name=name,len=len,units=units)
462 if (name == axis_name)
then
464 call get_axis_data(axes(i),var)
469 if (.not.axis_found)
call mom_error(fatal,
"MOM_io read_axis_data: "//&
470 "Unable to find axis "//trim(axis_name)//
" in file "//trim(filename))
477 function num_timelevels(filename, varname, min_dims)
result(n_time)
478 character(len=*),
intent(in) :: filename
479 character(len=*),
intent(in) :: varname
481 integer,
optional,
intent(in) :: min_dims
487 character(len=200) :: msg
488 character(len=nf90_max_name) :: name
489 integer :: ncid, nvars, status, varid, ndims, n
490 integer,
allocatable :: varids(:)
491 integer,
dimension(nf90_max_var_dims) :: dimids
496 status = nf90_open(filename, nf90_nowrite, ncid)
497 if (status /= nf90_noerr)
then
498 call mom_error(warning,
"num_timelevels: "//&
499 " Difficulties opening "//trim(filename)//
" - "//&
500 trim(nf90_strerror(status)))
504 status = nf90_inquire(ncid, nvariables=nvars)
505 if (status /= nf90_noerr)
then
506 call mom_error(warning,
"num_timelevels: "//&
507 " Difficulties getting the number of variables in file "//&
508 trim(filename)//
" - "//trim(nf90_strerror(status)))
513 call mom_error(warning,
"num_timelevels: "//&
514 " There appear not to be any variables in "//trim(filename))
519 allocate(varids(nvars))
521 status = nf90_inq_varids(ncid, nvars, varids)
522 if (status /= nf90_noerr)
then
523 call mom_error(warning,
"num_timelevels: "//&
524 " Difficulties getting the variable IDs in file "//&
525 trim(filename)//
" - "//trim(nf90_strerror(status)))
526 deallocate(varids) ;
return
530 status = nf90_inquire_variable(ncid, varids(n), name=name)
531 if (status /= nf90_noerr)
then
532 call mom_error(warning,
"num_timelevels: "//&
533 " Difficulties getting a variable name in file "//&
534 trim(filename)//
" - "//trim(nf90_strerror(status)))
539 call mom_error(warning,
"num_timelevels: "//&
540 " Two variables match the case-insensitive name "//trim(varname)//&
541 " in file "//trim(filename)//
" - "//trim(nf90_strerror(status)))
543 varid = varids(n) ; found = .true.
551 call mom_error(warning,
"num_timelevels: "//&
552 " variable "//trim(varname)//
" was not found in file "//&
557 status = nf90_inquire_variable(ncid, varid, ndims = ndims)
558 if (status /= nf90_noerr)
then
559 call mom_error(warning,
"num_timelevels: "//&
560 trim(nf90_strerror(status))//
" Getting number of dimensions of "//&
561 trim(varname)//
" in "//trim(filename))
565 if (
present(min_dims))
then
566 if (ndims < min_dims-1)
then
567 write(msg,
'(I3)') min_dims
568 call mom_error(warning,
"num_timelevels: variable "//trim(varname)//&
569 " in file "//trim(filename)//
" has fewer than min_dims = "//trim(msg)//&
571 elseif (ndims == min_dims - 1)
then
576 status = nf90_inquire_variable(ncid, varid, dimids = dimids(1:ndims))
577 if (status /= nf90_noerr)
then
578 call mom_error(warning,
"num_timelevels: "//&
579 trim(nf90_strerror(status))//
" Getting last dimension ID for "//&
580 trim(varname)//
" in "//trim(filename))
584 status = nf90_inquire_dimension(ncid, dimids(ndims), len=n_time)
585 if (status /= nf90_noerr)
call mom_error(warning,
"num_timelevels: "//&
586 trim(nf90_strerror(status))//
" Getting number of time levels of "//&
587 trim(varname)//
" in "//trim(filename))
598 function var_desc(name, units, longname, hor_grid, z_grid, t_grid, &
599 cmor_field_name, cmor_units, cmor_longname, conversion, caller)
result(vd)
600 character(len=*),
intent(in) :: name
601 character(len=*),
optional,
intent(in) :: units
602 character(len=*),
optional,
intent(in) :: longname
603 character(len=*),
optional,
intent(in) :: hor_grid
604 character(len=*),
optional,
intent(in) :: z_grid
605 character(len=*),
optional,
intent(in) :: t_grid
606 character(len=*),
optional,
intent(in) :: cmor_field_name
607 character(len=*),
optional,
intent(in) :: cmor_units
608 character(len=*),
optional,
intent(in) :: cmor_longname
609 real ,
optional,
intent(in) :: conversion
611 character(len=*),
optional,
intent(in) :: caller
614 character(len=120) :: cllr
616 if (
present(caller)) cllr = trim(caller)
620 vd%longname =
"" ; vd%units =
""
621 vd%hor_grid =
'h' ; vd%z_grid =
'L' ; vd%t_grid =
's'
623 vd%cmor_field_name =
""
625 vd%cmor_longname =
""
628 call modify_vardesc(vd, units=units, longname=longname, hor_grid=hor_grid, &
629 z_grid=z_grid, t_grid=t_grid, &
630 cmor_field_name=cmor_field_name,cmor_units=cmor_units, &
631 cmor_longname=cmor_longname, conversion=conversion, caller=cllr)
638 subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
639 cmor_field_name, cmor_units, cmor_longname, conversion, caller)
641 character(len=*),
optional,
intent(in) :: name
642 character(len=*),
optional,
intent(in) :: units
643 character(len=*),
optional,
intent(in) :: longname
644 character(len=*),
optional,
intent(in) :: hor_grid
645 character(len=*),
optional,
intent(in) :: z_grid
646 character(len=*),
optional,
intent(in) :: t_grid
647 character(len=*),
optional,
intent(in) :: cmor_field_name
648 character(len=*),
optional,
intent(in) :: cmor_units
649 character(len=*),
optional,
intent(in) :: cmor_longname
650 real ,
optional,
intent(in) :: conversion
652 character(len=*),
optional,
intent(in) :: caller
654 character(len=120) :: cllr
656 if (
present(caller)) cllr = trim(caller)
661 "vd%longname of "//trim(vd%name), cllr)
663 "vd%units of "//trim(vd%name), cllr)
665 "vd%hor_grid of "//trim(vd%name), cllr)
667 "vd%z_grid of "//trim(vd%name), cllr)
669 "vd%t_grid of "//trim(vd%name), cllr)
671 if (
present(cmor_field_name))
call safe_string_copy(cmor_field_name, vd%cmor_field_name, &
672 "vd%cmor_field_name of "//trim(vd%name), cllr)
674 "vd%cmor_units of "//trim(vd%name), cllr)
675 if (
present(cmor_longname))
call safe_string_copy(cmor_longname, vd%cmor_longname, &
676 "vd%cmor_longname of "//trim(vd%name), cllr)
683 character(len=*),
intent(in) :: longname
684 character(len=len(longname)) :: std_name
690 do k=1, len_trim(std_name)
691 if (std_name(k:k) ==
' ') std_name(k:k) =
'_'
697 subroutine query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, &
698 cmor_field_name, cmor_units, cmor_longname, conversion, caller)
700 character(len=*),
optional,
intent(out) :: name
701 character(len=*),
optional,
intent(out) :: units
702 character(len=*),
optional,
intent(out) :: longname
703 character(len=*),
optional,
intent(out) :: hor_grid
704 character(len=*),
optional,
intent(out) :: z_grid
705 character(len=*),
optional,
intent(out) :: t_grid
706 character(len=*),
optional,
intent(out) :: cmor_field_name
707 character(len=*),
optional,
intent(out) :: cmor_units
708 character(len=*),
optional,
intent(out) :: cmor_longname
709 real ,
optional,
intent(out) :: conversion
711 character(len=*),
optional,
intent(in) :: caller
714 character(len=120) :: cllr
716 if (
present(caller)) cllr = trim(caller)
719 "vd%name of "//trim(vd%name), cllr)
721 "vd%longname of "//trim(vd%name), cllr)
723 "vd%units of "//trim(vd%name), cllr)
725 "vd%hor_grid of "//trim(vd%name), cllr)
727 "vd%z_grid of "//trim(vd%name), cllr)
729 "vd%t_grid of "//trim(vd%name), cllr)
731 if (
present(cmor_field_name))
call safe_string_copy(vd%cmor_field_name, cmor_field_name, &
732 "vd%cmor_field_name of "//trim(vd%name), cllr)
734 "vd%cmor_units of "//trim(vd%name), cllr)
735 if (
present(cmor_longname))
call safe_string_copy(vd%cmor_longname, cmor_longname, &
736 "vd%cmor_longname of "//trim(vd%name), cllr)
743 character(len=*),
intent(in) :: str1
744 character(len=*),
intent(out) :: str2
745 character(len=*),
optional,
intent(in) :: fieldnm
746 character(len=*),
optional,
intent(in) :: caller
748 if (len(trim(str1)) > len(str2))
then
749 if (
present(fieldnm) .and.
present(caller))
then
750 call mom_error(fatal, trim(caller)//
" attempted to copy the overly long"//&
751 " string "//trim(str1)//
" into "//trim(fieldnm))
753 call mom_error(fatal,
"safe_string_copy: The string "//trim(str1)//&
754 " is longer than its intended target.")
762 function ensembler(name, ens_no_in)
result(en_nm)
763 character(len=*),
intent(in) :: name
764 integer,
optional,
intent(in) :: ens_no_in
765 character(len=len(name)) :: en_nm
771 character(len=len(name)) :: tmp
772 character(10) :: ens_num_char
773 character(3) :: code_str
778 if (index(name,
"%") == 0)
return
780 if (
present(ens_no_in))
then
783 ens_no = get_ensemble_id()
786 write(ens_num_char,
'(I10)') ens_no ; ens_num_char = adjustl(ens_num_char)
788 is = index(en_nm,
"%E")
790 if (len(en_nm) < len(trim(en_nm)) + len(trim(ens_num_char)) - 2) &
791 call mom_error(fatal,
"MOM_io ensembler: name "//trim(name)// &
792 " is not long enough for %E expansion for ens_no "//trim(ens_num_char))
793 tmp = en_nm(1:is-1)//trim(ens_num_char)//trim(en_nm(is+2:))
797 if (index(name,
"%") == 0)
return
799 write(ens_num_char,
'(I10.10)') ens_no
801 write(code_str,
'("%",I1,"E")') n
803 is = index(en_nm,code_str)
805 if (ens_no < 10**n)
then
806 if (len(en_nm) < len(trim(en_nm)) + n-3)
call mom_error(fatal, &
807 "MOM_io ensembler: name "//trim(name)//
" is not long enough for %E expansion.")
808 tmp = en_nm(1:is-1)//trim(ens_num_char(11-n:10))//trim(en_nm(is+3:))
810 call mom_error(fatal,
"MOM_io ensembler: Ensemble number is too large "//&
811 "to be encoded with "//code_str//
" in "//trim(name))
821 character(len=*),
intent(in) :: filename
835 character(len=*),
intent(in) :: filename
836 type(domain2d),
optional,
intent(in) :: domain
837 logical,
optional,
intent(in) :: no_domain
850 character(len=*),
intent(in) :: filename
851 character(len=*),
intent(in) :: fieldname
852 real,
dimension(:),
intent(inout) :: data
853 integer,
optional,
intent(in) :: timelevel
854 real,
optional,
intent(in) :: scale
857 call read_data(filename, fieldname,
data, timelevel=timelevel, no_domain=.true.)
859 if (
present(scale))
then ;
if (scale /= 1.0)
then
860 data(:) = scale*
data(:)
869 timelevel, position, scale)
870 character(len=*),
intent(in) :: filename
871 character(len=*),
intent(in) :: fieldname
872 real,
dimension(:,:),
intent(inout) :: data
875 integer,
optional,
intent(in) :: timelevel
876 integer,
optional,
intent(in) :: position
877 real,
optional,
intent(in) :: scale
880 integer :: is, ie, js, je
882 call read_data(filename, fieldname,
data, mom_domain%mpp_domain, &
883 timelevel=timelevel, position=position)
885 if (
present(scale))
then ;
if (scale /= 1.0)
then
888 data(is:ie,js:je) = scale*
data(is:ie,js:je)
897 timelevel, position, scale)
898 character(len=*),
intent(in) :: filename
899 character(len=*),
intent(in) :: fieldname
900 real,
dimension(:,:,:),
intent(inout) :: data
903 integer,
optional,
intent(in) :: timelevel
904 integer,
optional,
intent(in) :: position
905 real,
optional,
intent(in) :: scale
908 integer :: is, ie, js, je
910 call read_data(filename, fieldname,
data, mom_domain%mpp_domain, &
911 timelevel=timelevel, position=position)
913 if (
present(scale))
then ;
if (scale /= 1.0)
then
916 data(is:ie,js:je,:) = scale*
data(is:ie,js:je,:)
925 timelevel, position, scale)
926 character(len=*),
intent(in) :: filename
927 character(len=*),
intent(in) :: fieldname
928 real,
dimension(:,:,:,:),
intent(inout) :: data
931 integer,
optional,
intent(in) :: timelevel
932 integer,
optional,
intent(in) :: position
933 real,
optional,
intent(in) :: scale
936 integer :: is, ie, js, je
938 call read_data(filename, fieldname,
data, mom_domain%mpp_domain, &
939 timelevel=timelevel, position=position)
941 if (
present(scale))
then ;
if (scale /= 1.0)
then
944 data(is:ie,js:je,:,:) = scale*
data(is:ie,js:je,:,:)
953 subroutine mom_read_vector_2d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
954 timelevel, stagger, scalar_pair, scale)
955 character(len=*),
intent(in) :: filename
956 character(len=*),
intent(in) :: u_fieldname
957 character(len=*),
intent(in) :: v_fieldname
958 real,
dimension(:,:),
intent(inout) :: u_data
960 real,
dimension(:,:),
intent(inout) :: v_data
963 integer,
optional,
intent(in) :: timelevel
964 integer,
optional,
intent(in) :: stagger
965 logical,
optional,
intent(in) :: scalar_pair
966 real,
optional,
intent(in) :: scale
968 integer :: is, ie, js, je
969 integer :: u_pos, v_pos
971 u_pos = east_face ; v_pos = north_face
972 if (
present(stagger))
then
973 if (stagger == cgrid_ne)
then ; u_pos = east_face ; v_pos = north_face
974 elseif (stagger == bgrid_ne)
then ; u_pos = corner ; v_pos = corner
975 elseif (stagger == agrid)
then ; u_pos = center ; v_pos = center ;
endif
978 call read_data(filename, u_fieldname, u_data, mom_domain%mpp_domain, &
979 timelevel=timelevel, position=u_pos)
980 call read_data(filename, v_fieldname, v_data, mom_domain%mpp_domain, &
981 timelevel=timelevel, position=v_pos)
983 if (
present(scale))
then ;
if (scale /= 1.0)
then
986 u_data(is:ie,js:je) = scale*u_data(is:ie,js:je)
989 v_data(is:ie,js:je) = scale*v_data(is:ie,js:je)
998 subroutine mom_read_vector_3d(filename, u_fieldname, v_fieldname, u_data, v_data, MOM_Domain, &
999 timelevel, stagger, scalar_pair, scale)
1000 character(len=*),
intent(in) :: filename
1001 character(len=*),
intent(in) :: u_fieldname
1002 character(len=*),
intent(in) :: v_fieldname
1003 real,
dimension(:,:,:),
intent(inout) :: u_data
1005 real,
dimension(:,:,:),
intent(inout) :: v_data
1008 integer,
optional,
intent(in) :: timelevel
1009 integer,
optional,
intent(in) :: stagger
1010 logical,
optional,
intent(in) :: scalar_pair
1011 real,
optional,
intent(in) :: scale
1014 integer :: is, ie, js, je
1015 integer :: u_pos, v_pos
1017 u_pos = east_face ; v_pos = north_face
1018 if (
present(stagger))
then
1019 if (stagger == cgrid_ne)
then ; u_pos = east_face ; v_pos = north_face
1020 elseif (stagger == bgrid_ne)
then ; u_pos = corner ; v_pos = corner
1021 elseif (stagger == agrid)
then ; u_pos = center ; v_pos = center ;
endif
1024 call read_data(filename, u_fieldname, u_data, mom_domain%mpp_domain, &
1025 timelevel=timelevel, position=u_pos)
1026 call read_data(filename, v_fieldname, v_data, mom_domain%mpp_domain, &
1027 timelevel=timelevel, position=v_pos)
1029 if (
present(scale))
then ;
if (scale /= 1.0)
then
1032 u_data(is:ie,js:je,:) = scale*u_data(is:ie,js:je,:)
1035 v_data(is:ie,js:je,:) = scale*v_data(is:ie,js:je,:)
1047 #include "version_variable.h"
1048 character(len=40) :: mdl =
"MOM_io"