42 public oasis_ioshr_init
43 public oasis_ioshr_finalize
44 public oasis_ioshr_wopen
45 public oasis_ioshr_close
46 public oasis_ioshr_redef
47 public oasis_ioshr_enddef
48 public oasis_ioshr_date2yyyymmdd
49 public oasis_ioshr_sec2hms
50 public oasis_ioshr_read
51 public oasis_ioshr_write
53 public oasis_ioshr_getiotype
54 public oasis_ioshr_getioroot
62 interface oasis_ioshr_read
63 module procedure oasis_ioshr_read_av
64 module procedure oasis_ioshr_read_int
65 module procedure oasis_ioshr_read_int1d
66 module procedure oasis_ioshr_read_r8
67 module procedure oasis_ioshr_read_r81d
68 module procedure oasis_ioshr_read_char
70 interface oasis_ioshr_write
71 module procedure oasis_ioshr_write_av
72 module procedure oasis_ioshr_write_int
73 module procedure oasis_ioshr_write_int1d
74 module procedure oasis_ioshr_write_r8
75 module procedure oasis_ioshr_write_r81d
76 module procedure oasis_ioshr_write_char
77 module procedure oasis_ioshr_write_time
84 character(*),
parameter :: prefix =
"oasis_ioshr_" 85 character(CL) :: wfilename =
'' 86 real(r8) ,
parameter :: fillvalue =
rspval 87 character(CL) :: charvar
89 character(*),
parameter :: modname =
"(mod_oasis_ioshr) " 90 integer(in) ,
parameter :: debug = 1
92 character(*),
parameter :: version =
'oasis_ioshr_v00' 94 type(file_desc_t),
save :: pio_file
95 type(iosystem_desc_t),
save :: pio_iosystem
96 integer(IN),
save :: pio_mpicomm
97 integer(IN),
save :: pio_iam
98 integer(IN),
save :: pio_iotype
99 integer(IN),
save :: pio_stride
100 integer(IN),
save :: pio_numtasks
101 integer(IN),
save :: pio_root
103 integer(IN),
parameter :: pio_root_default = 0
123 subroutine oasis_ioshr_init(mpicomm,typename,stride,root,numtasks)
125 integer(IN),
intent(in) :: mpicomm
126 character(len=*),
intent(in) :: typename
127 integer(IN),
intent(in) :: stride
128 integer(IN),
intent(in) :: numtasks
129 integer(IN),
intent(in) :: root
132 character(*),
parameter :: subname =
'(oasis_ioshr_init) ' 133 character(*),
parameter :: f00 =
"('(oasis_ioshr_init) ',4a)" 134 character(*),
parameter :: f01 =
"('(oasis_ioshr_init) ',a,i6)" 140 pio_mpicomm = mpicomm
142 pio_numtasks = numtasks
144 call getiotypefromname(typename, pio_iotype, pio_iotype_netcdf)
148 call namelist_set(npes, pio_mpicomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
151 write(
nulprt,f00)
'pio init parameters for : ' 152 write(
nulprt,f01)
' pio_stride = ',pio_stride
153 write(
nulprt,f01)
' pio_root = ',pio_root
154 select case(pio_iotype)
155 case (pio_iotype_netcdf)
156 write(
nulprt,*)
' pio iotype is netcdf' 157 case (pio_iotype_netcdf4p)
158 write(
nulprt,*)
' pio iotype is netcdf4p' 159 case (pio_iotype_netcdf4c)
160 write(
nulprt,*)
' pio iotype is netcdf4c' 161 case (pio_iotype_pnetcdf)
162 write(
nulprt,*)
' pio iotype is pnetcdf' 164 write(
nulprt,f01)
' pio_iotype = ',pio_iotype
165 write(
nulprt,f01)
' pio_numtasks = ',pio_numtasks
167 call pio_init(pio_iam, pio_mpicomm, pio_numtasks, 0, pio_stride, &
168 pio_rearr_box, pio_iosystem, base=pio_root)
170 end subroutine oasis_ioshr_init
174 subroutine getiotypefromname(itypename, iotype, defaulttype)
176 character(len=*),
intent(in) :: itypename
177 integer,
intent(out) :: iotype
178 integer,
intent(in) :: defaulttype
180 character(len=len(itypename)) :: typename
181 character(*),
parameter :: subname =
'(oasis_ioshr_getiotypefromname) ' 184 if ( typename .eq.
'NETCDF' )
then 185 iotype = pio_iotype_netcdf
186 else if ( typename .eq.
'PNETCDF')
then 187 iotype = pio_iotype_pnetcdf
188 else if ( typename .eq.
'NETCDF4P')
then 189 iotype = pio_iotype_netcdf4p
190 else if ( typename .eq.
'NETCDF4C')
then 191 iotype = pio_iotype_netcdf4c
192 else if ( typename .eq.
'NOTHING')
then 195 write(
nulprt,*) subname,
wstr,
'Bad io_type argument - using iotype_netcdf' 196 iotype=pio_iotype_netcdf
198 end subroutine getiotypefromname
202 subroutine namelist_set(npes,mycomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
204 integer,
intent(in) :: npes, mycomm
205 integer,
intent(inout) :: pio_stride, pio_root, pio_numtasks
206 integer,
intent(inout) :: pio_iotype
207 character(*),
parameter :: subname =
'(oasis_ioshr_namelist_set) ' 220 if (pio_stride>0.and.pio_numtasks<0)
then 221 pio_numtasks = npes/pio_stride
222 else if(pio_numtasks>0 .and. pio_stride<0)
then 223 pio_stride = npes/pio_numtasks
224 else if(pio_numtasks<0 .and. pio_stride<0)
then 226 pio_numtasks = npes/pio_stride
227 pio_numtasks = max(1, pio_numtasks)
231 pio_root = pio_root_default
233 pio_root = min(pio_root,npes-1)
235 if (pio_root + (pio_stride)*(pio_numtasks-1) >= npes .or. &
236 pio_stride<=0 .or. pio_numtasks<=0 .or. pio_root < 0 .or. &
237 pio_root > npes-1)
then 239 pio_stride = max(1,npes/4)
240 else if(npes<1000)
then 241 pio_stride = max(1,npes/8)
243 pio_stride = max(1,npes/16)
245 if(pio_stride>1)
then 246 pio_numtasks = npes/pio_stride
247 pio_root = min(1,npes-1)
253 write(
nulprt,*) subname,
'pio_stride, iotasks or root out of bounds - resetting to defaults: ',&
254 pio_stride,pio_numtasks, pio_root
259 end subroutine namelist_set
262 subroutine oasis_ioshr_finalize
265 character(*),
parameter :: subname =
'(oasis_ioshr_finalize) ' 267 call pio_finalize(pio_iosystem, ierr)
269 end subroutine oasis_ioshr_finalize
282 function oasis_ioshr_getiotype()
result(io_type)
285 character(*),
parameter :: subname =
'(oasis_ioshr_getiotype) ' 289 end function oasis_ioshr_getiotype
291 function oasis_ioshr_getioroot()
result(io_root)
294 character(*),
parameter :: subname =
'(oasis_ioshr_getioroot) ' 298 end function oasis_ioshr_getioroot
303 subroutine oasis_ioshr_flds_lookup(fldname,longname,stdname,units)
305 character(len=*),
intent(in) :: fldname
306 character(len=*),
intent(out),
optional :: longname
307 character(len=*),
intent(out),
optional :: stdname
308 character(len=*),
intent(out),
optional :: units
309 character(*),
parameter :: subname =
'(oasis_ioshr_flds_lookup) ' 311 if (
present(longname))
then 314 if (
present(stdname))
then 317 if (
present(units))
then 321 end subroutine oasis_ioshr_flds_lookup
336 subroutine oasis_ioshr_wopen(filename,clobber,cdf64)
340 character(*),
intent(in) :: filename
341 logical,
optional,
intent(in):: clobber
342 logical,
optional,
intent(in):: cdf64
351 character(CL) :: lversion
352 character(*),
parameter :: subname =
'(oasis_ioshr_wopen) ' 359 if (
present(clobber)) lclobber=clobber
362 if (
present(cdf64)) lcdf64=cdf64
364 if (.not. pio_file_is_open(pio_file))
then 366 if (pio_iam==0)
inquire(file=trim(filename),exist=exists)
371 if (lcdf64) nmode = ior(nmode,pio_64bit_offset)
372 rcode = pio_createfile(pio_iosystem, pio_file, pio_iotype, trim(filename), nmode)
373 if(pio_iam==0)
write(
nulprt,*) subname,
' create file ',trim(filename)
374 rcode = pio_put_att(pio_file,pio_global,
"file_version",version)
377 rcode = pio_openfile(pio_iosystem, pio_file, pio_iotype, trim(filename), pio_write)
378 if(pio_iam==0)
write(
nulprt,*) subname,
' open file ',trim(filename)
379 call pio_seterrorhandling(pio_file,pio_bcast_error)
380 rcode = pio_get_att(pio_file,pio_global,
"file_version",lversion)
381 call pio_seterrorhandling(pio_file,pio_internal_error)
382 if (trim(lversion) /= trim(version))
then 383 rcode = pio_redef(pio_file)
384 rcode = pio_put_att(pio_file,pio_global,
"file_version",version)
385 rcode = pio_enddef(pio_file)
389 nmode = pio_noclobber
390 if (lcdf64) nmode = ior(nmode,pio_64bit_offset)
391 rcode = pio_createfile(pio_iosystem, pio_file, pio_iotype, trim(filename), nmode)
392 if(pio_iam==0)
write(
nulprt,*) subname,
' create file ',trim(filename)
393 rcode = pio_put_att(pio_file,pio_global,
"file_version",version)
395 elseif (trim(wfilename) /= trim(filename))
then 397 write(
nulprt,*) subname,
estr,
'different file currently open ',trim(filename)
403 end subroutine oasis_ioshr_wopen
418 subroutine oasis_ioshr_close(filename)
423 character(*),
intent(in) :: filename
428 character(*),
parameter :: subname =
'(oasis_ioshr_close) ' 434 if (.not. pio_file_is_open(pio_file))
then 436 elseif (trim(wfilename) /= trim(filename))
then 438 call pio_closefile(pio_file)
441 write(
nulprt,*) subname,
estr,
'different file currently open ',trim(filename)
447 end subroutine oasis_ioshr_close
451 subroutine oasis_ioshr_redef(filename)
453 character(len=*),
intent(in) :: filename
455 character(*),
parameter :: subname =
'(oasis_ioshr_redef) ' 457 rcode = pio_redef(pio_file)
458 end subroutine oasis_ioshr_redef
462 subroutine oasis_ioshr_enddef(filename)
464 character(len=*),
intent(in) :: filename
466 character(*),
parameter :: subname =
'(oasis_ioshr_enddef) ' 468 rcode = pio_enddef(pio_file)
469 end subroutine oasis_ioshr_enddef
473 character(len=10) function oasis_ioshr_date2yyyymmdd (date)
478 integer,
intent(in) :: date
485 character(*),
parameter :: subname =
'(oasis_ioshr_date2yyyymmdd) ' 490 WRITE(
nulprt,*) subname,
estr,
'oasis_ioshr_date2yyyymmdd: negative date not allowed' 495 month = (date - year*10000) / 100
496 day = date - year*10000 - month*100
498 write(oasis_ioshr_date2yyyymmdd,80) year, month, day
499 80
format(i4.4,
'-',i2.2,
'-',i2.2)
501 end function oasis_ioshr_date2yyyymmdd
505 character(len=8) function oasis_ioshr_sec2hms (seconds)
510 integer,
intent(in) :: seconds
517 character(*),
parameter :: subname =
'(oasis_ioshr_sec2hms) ' 521 if (seconds < 0 .or. seconds > 86400)
then 522 WRITE(
nulprt,*) subname,
estr,
'oasis_ioshr_sec2hms: bad input seconds:', seconds
526 hours = seconds / 3600
527 minutes = (seconds - hours*3600) / 60
528 secs = (seconds - hours*3600 - minutes*60)
530 if (minutes < 0 .or. minutes > 60)
then 531 WRITE(
nulprt,*) subname,
estr,
'oasis_ioshr_sec2hms: bad minutes = ',minutes
535 if (secs < 0 .or. secs > 60)
then 536 WRITE(
nulprt,*) subname,
estr,
'oasis_ioshr_sec2hms: bad secs = ',secs
540 write(oasis_ioshr_sec2hms,80) hours, minutes, secs
541 80
format(i2.2,
':',i2.2,
':',i2.2)
543 end function oasis_ioshr_sec2hms
558 subroutine oasis_ioshr_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,use_float)
562 character(len=*),
intent(in) :: filename
563 type(mct_gsmap),
intent(in) :: gsmap
564 type(mct_avect) ,
intent(in) :: av
565 character(len=*),
intent(in) :: dname
566 logical,
optional,
intent(in) :: whead
567 logical,
optional,
intent(in) :: wdata
568 integer(in),
optional,
intent(in) :: nx
569 integer(in),
optional,
intent(in) :: ny
570 integer(in),
optional,
intent(in) :: nt
571 real(r8),
optional,
intent(in) :: fillval
572 character(len=*),
optional,
intent(in) :: pre
573 logical,
optional,
intent(in) :: tavg
574 logical,
optional,
intent(in) :: use_float
579 integer(in) :: nf,ns,ng
580 integer(in) :: i,j,k,n
581 integer(in),
target :: dimid2(2)
582 integer(in),
target :: dimid3(3)
583 integer(in),
pointer :: dimid(:)
584 type(var_desc_t) :: varid
585 type(io_desc_t) :: iodesc
586 integer(kind=PIO_OffSet) :: frame
587 type(mct_string) :: mstring
588 character(CL) :: itemc
589 character(CL) :: name1
590 character(CL) :: cunit
591 character(CL) :: lname
592 character(CL) :: sname
593 character(CL) :: lpre
595 logical :: lwhead, lwdata
596 integer(in) :: lnx,lny
597 real(r8) :: lfillvalue
598 type(mct_avect) :: avroot
599 real(r8),
pointer :: fld1(:,:)
600 character(*),
parameter :: subname =
'(oasis_ioshr_write_av) ' 602 integer,
pointer :: dof(:)
608 lfillvalue = fillvalue
609 if (
present(fillval))
then 614 if (
present(pre))
then 620 if (
present(whead)) lwhead = whead
621 if (
present(wdata)) lwdata = wdata
623 if (.not.lwhead .and. .not.lwdata)
then 628 ng = mct_gsmap_gsize(gsmap)
632 nf = mct_avect_nrattr(av)
634 write(
nulprt,*) subname,
estr,
'nf = ',nf,trim(dname)
638 if (
present(nx))
then 639 if (nx /= 0) lnx = nx
641 if (
present(ny))
then 642 if (ny /= 0) lny = ny
644 if (lnx*lny /= ng)
then 645 write(
nulprt,*) subname,
estr,
'grid2d size not consistent ',ng,lnx,lny,trim(dname)
650 rcode = pio_def_dim(pio_file,trim(lpre)//
'_nx',lnx,dimid2(1))
651 rcode = pio_def_dim(pio_file,trim(lpre)//
'_ny',lny,dimid2(2))
653 if (
present(nt))
then 655 rcode = pio_inq_dimid(pio_file,
'time',dimid3(3))
662 call mct_avect_getrlist(mstring,k,av)
663 itemc = mct_string_tochar(mstring)
664 call mct_string_clean(mstring)
666 name1 = trim(lpre)//
'_'//trim(itemc)
667 call oasis_ioshr_flds_lookup(itemc,longname=lname,stdname=sname,units=cunit)
668 if (
present(use_float))
then 669 rcode = pio_def_var(pio_file,trim(name1),pio_real,dimid,varid)
671 rcode = pio_def_var(pio_file,trim(name1),pio_double,dimid,varid)
673 rcode = pio_put_att(pio_file,varid,
"_FillValue",lfillvalue)
674 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
675 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
676 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
677 rcode = pio_put_att(pio_file,varid,
"internal_dname",trim(dname))
678 if (
present(tavg))
then 680 rcode = pio_put_att(pio_file,varid,
"cell_methods",
"time: mean")
684 if (lwdata)
call oasis_ioshr_enddef(filename)
688 call mct_gsmap_orderedpoints(gsmap, pio_iam, dof)
689 call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
693 call mct_avect_getrlist(mstring,k,av)
694 itemc = mct_string_tochar(mstring)
695 call mct_string_clean(mstring)
697 name1 = trim(lpre)//
'_'//trim(itemc)
698 rcode = pio_inq_varid(pio_file,trim(name1),varid)
699 if (
present(nt))
then 704 call pio_setframe(varid,frame)
705 call pio_write_darray(pio_file, varid, iodesc, av%rattr(k,:), rcode, fillval=lfillvalue)
708 call pio_freedecomp(pio_file, iodesc)
711 end subroutine oasis_ioshr_write_av
726 subroutine oasis_ioshr_write_int(filename,idata,dname,whead,wdata)
730 character(len=*),
intent(in) :: filename
731 integer(in) ,
intent(in) :: idata
732 character(len=*),
intent(in) :: dname
733 logical,
optional,
intent(in) :: whead
734 logical,
optional,
intent(in) :: wdata
739 type(var_desc_t) :: varid
740 character(CL) :: cunit
741 character(CL) :: lname
742 character(CL) :: sname
744 logical :: lwhead, lwdata
745 character(*),
parameter :: subname =
'(oasis_ioshr_write_int) ' 753 if (
present(whead)) lwhead = whead
754 if (
present(wdata)) lwdata = wdata
756 if (.not.lwhead .and. .not.lwdata)
then 762 call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
765 rcode = pio_def_var(pio_file,trim(dname),pio_int,varid)
766 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
767 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
768 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
769 if (lwdata)
call oasis_ioshr_enddef(filename)
773 rcode = pio_inq_varid(pio_file,trim(dname),varid)
774 rcode = pio_put_var(pio_file,varid,idata)
779 end subroutine oasis_ioshr_write_int
794 subroutine oasis_ioshr_write_int1d(filename,idata,dname,whead,wdata)
798 character(len=*),
intent(in) :: filename
799 integer(in) ,
intent(in) :: idata(:)
800 character(len=*),
intent(in) :: dname
801 logical,
optional,
intent(in) :: whead
802 logical,
optional,
intent(in) :: wdata
807 integer(in) :: dimid(1)
808 type(var_desc_t) :: varid
809 character(CL) :: cunit
810 character(CL) :: lname
811 character(CL) :: sname
814 logical :: lwhead, lwdata
815 character(*),
parameter :: subname =
'(oasis_ioshr_write_int1d) ' 823 if (
present(whead)) lwhead = whead
824 if (
present(wdata)) lwdata = wdata
826 if (.not.lwhead .and. .not.lwdata)
then 832 call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
834 rcode = pio_def_dim(pio_file,trim(dname)//
'_nx',lnx,dimid(1))
835 rcode = pio_def_var(pio_file,trim(dname),pio_int,dimid,varid)
836 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
837 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
838 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
839 if (lwdata)
call oasis_ioshr_enddef(filename)
843 rcode = pio_inq_varid(pio_file,trim(dname),varid)
844 rcode = pio_put_var(pio_file,varid,idata)
849 end subroutine oasis_ioshr_write_int1d
864 subroutine oasis_ioshr_write_r8(filename,rdata,dname,whead,wdata)
868 character(len=*),
intent(in) :: filename
869 real(r8) ,
intent(in) :: rdata
870 character(len=*),
intent(in) :: dname
871 logical,
optional,
intent(in) :: whead
872 logical,
optional,
intent(in) :: wdata
877 type(var_desc_t) :: varid
878 character(CL) :: cunit
879 character(CL) :: lname
880 character(CL) :: sname
882 logical :: lwhead, lwdata
883 character(*),
parameter :: subname =
'(oasis_ioshr_write_r8) ' 891 if (
present(whead)) lwhead = whead
892 if (
present(wdata)) lwdata = wdata
894 if (.not.lwhead .and. .not.lwdata)
then 900 call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
905 rcode = pio_def_var(pio_file,trim(dname),pio_double,varid)
906 if(rcode==pio_noerr)
then 907 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
908 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
909 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
910 if (lwdata)
call oasis_ioshr_enddef(filename)
915 rcode = pio_inq_varid(pio_file,trim(dname),varid)
916 rcode = pio_put_var(pio_file,varid,rdata)
920 end subroutine oasis_ioshr_write_r8
935 subroutine oasis_ioshr_write_r81d(filename,rdata,dname,whead,wdata)
939 character(len=*),
intent(in) :: filename
940 real(r8) ,
intent(in) :: rdata(:)
941 character(len=*),
intent(in) :: dname
942 logical,
optional,
intent(in) :: whead
943 logical,
optional,
intent(in) :: wdata
948 integer(in) :: dimid(1)
949 type(var_desc_t) :: varid
950 character(CL) :: cunit
951 character(CL) :: lname
952 character(CL) :: sname
955 logical :: lwhead, lwdata
956 character(*),
parameter :: subname =
'(oasis_ioshr_write_r81d) ' 964 if (
present(whead)) lwhead = whead
965 if (
present(wdata)) lwdata = wdata
967 if (.not.lwhead .and. .not.lwdata)
then 973 call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
975 rcode = pio_def_dim(pio_file,trim(dname)//
'_nx',lnx,dimid(1))
976 rcode = pio_def_var(pio_file,trim(dname),pio_double,dimid,varid)
977 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
978 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
979 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
980 if (lwdata)
call oasis_ioshr_enddef(filename)
984 rcode = pio_inq_varid(pio_file,trim(dname),varid)
985 rcode = pio_put_var(pio_file,varid,rdata)
990 end subroutine oasis_ioshr_write_r81d
1005 subroutine oasis_ioshr_write_char(filename,rdata,dname,whead,wdata)
1009 character(len=*),
intent(in) :: filename
1010 character(len=*),
intent(in) :: rdata
1011 character(len=*),
intent(in) :: dname
1012 logical,
optional,
intent(in) :: whead
1013 logical,
optional,
intent(in) :: wdata
1017 integer(in) :: rcode
1018 integer(in) :: dimid(1)
1019 type(var_desc_t) :: varid
1020 character(CL) :: cunit
1021 character(CL) :: lname
1022 character(CL) :: sname
1025 logical :: lwhead, lwdata
1026 character(*),
parameter :: subname =
'(oasis_ioshr_write_char) ' 1034 if (
present(whead)) lwhead = whead
1035 if (
present(wdata)) lwdata = wdata
1037 if (.not.lwhead .and. .not.lwdata)
then 1043 call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
1045 rcode = pio_def_dim(pio_file,trim(dname)//
'_len',lnx,dimid(1))
1046 rcode = pio_def_var(pio_file,trim(dname),pio_char,dimid,varid)
1047 rcode = pio_put_att(pio_file,varid,
"units",trim(cunit))
1048 rcode = pio_put_att(pio_file,varid,
"long_name",trim(lname))
1049 rcode = pio_put_att(pio_file,varid,
"standard_name",trim(sname))
1050 if (lwdata)
call oasis_ioshr_enddef(filename)
1055 charvar = trim(rdata)
1056 rcode = pio_inq_varid(pio_file,trim(dname),varid)
1057 rcode = pio_put_var(pio_file,varid,charvar)
1060 end subroutine oasis_ioshr_write_char
1075 subroutine oasis_ioshr_write_time(filename,time_units,time_cal,time_val,nt,whead,wdata,tbnds)
1079 character(len=*),
intent(in) :: filename
1080 character(len=*),
intent(in) :: time_units
1081 character(len=*),
intent(in) :: time_cal
1082 real(r8) ,
intent(in) :: time_val
1083 integer(in),
optional,
intent(in) :: nt
1084 logical,
optional,
intent(in) :: whead
1085 logical,
optional,
intent(in) :: wdata
1086 real(r8),
optional,
intent(in) :: tbnds(2)
1090 integer(in) :: rcode
1091 integer(in) :: dimid(1)
1092 integer(in) :: dimid2(2)
1093 type(var_desc_t) :: varid
1096 logical :: lwhead, lwdata
1097 integer :: start(4),count(4)
1098 character(len=CL) :: lcalendar
1099 real(r8) :: time_val_1d(1)
1100 character(*),
parameter :: subname =
'(oasis_ioshr_write_time) ' 1108 if (
present(whead)) lwhead = whead
1109 if (
present(wdata)) lwdata = wdata
1111 if (.not.lwhead .and. .not.lwdata)
then 1117 rcode = pio_def_dim(pio_file,
'time',pio_unlimited,dimid(1))
1118 rcode = pio_def_var(pio_file,
'time',pio_double,dimid,varid)
1119 rcode = pio_put_att(pio_file,varid,
'units',trim(time_units))
1120 lcalendar =
'noleap' 1121 rcode = pio_put_att(pio_file,varid,
'calendar',trim(lcalendar))
1122 if (
present(tbnds))
then 1123 rcode = pio_put_att(pio_file,varid,
'bounds',
'time_bnds')
1125 rcode = pio_def_dim(pio_file,
'ntb',2,dimid2(1))
1126 rcode = pio_def_var(pio_file,
'time_bnds',pio_double,dimid2,varid)
1128 if (lwdata)
call oasis_ioshr_enddef(filename)
1134 if (
present(nt))
then 1137 time_val_1d(1) = time_val
1138 rcode = pio_inq_varid(pio_file,
'time',varid)
1139 rcode = pio_put_var(pio_file,varid,start,count,time_val_1d)
1140 if (
present(tbnds))
then 1141 rcode = pio_inq_varid(pio_file,
'time_bnds',varid)
1144 if (
present(nt))
then 1148 rcode = pio_put_var(pio_file,varid,start,count,tbnds)
1154 end subroutine oasis_ioshr_write_time
1169 subroutine oasis_ioshr_read_av(filename,gsmap,AV,dname,pre)
1173 character(len=*),
intent(in) :: filename
1174 type(mct_gsmap),
intent(in) :: gsmap
1175 type(mct_avect) ,
intent(inout):: av
1176 character(len=*),
intent(in) :: dname
1177 character(len=*),
intent(in),
optional :: pre
1181 integer(in) :: rcode
1182 integer(in) :: nf,ns,ng
1183 integer(in) :: i,j,k,n, ndims
1184 type(file_desc_t) :: pioid
1185 integer(in) :: dimid(2)
1186 type(var_desc_t) :: varid
1187 integer(in) :: lnx,lny
1188 type(mct_string) :: mstring
1189 character(CL) :: itemc
1191 type(io_desc_t) :: iodesc
1192 integer(in),
pointer :: dof(:)
1193 character(CL) :: lversion
1194 character(CL) :: name1
1195 character(CL) :: lpre
1196 character(*),
parameter :: subname =
'(oasis_ioshr_read_av) ' 1202 if (
present(pre))
then 1206 call mct_gsmap_orderedpoints(gsmap, pio_iam, dof)
1208 ns = mct_avect_lsize(av)
1209 nf = mct_avect_nrattr(av)
1211 if (pio_iam==0)
inquire(file=trim(filename),exist=exists)
1214 rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1215 if(pio_iam==0)
write(
nulprt,*) subname,
' open file ',trim(filename)
1216 call pio_seterrorhandling(pioid,pio_bcast_error)
1217 rcode = pio_get_att(pioid,pio_global,
"file_version",lversion)
1218 call pio_seterrorhandling(pioid,pio_internal_error)
1220 write(
nulprt,*) subname,
estr,
'file invalid ',trim(filename),
' ',trim(dname)
1225 call mct_avect_getrlist(mstring,k,av)
1226 itemc = mct_string_tochar(mstring)
1227 call mct_string_clean(mstring)
1228 name1 = trim(lpre)//
'_'//trim(itemc)
1229 call pio_seterrorhandling(pioid, pio_bcast_error)
1230 rcode = pio_inq_varid(pioid,trim(name1),varid)
1231 if (rcode == pio_noerr)
then 1233 rcode = pio_inq_varndims(pioid, varid, ndims)
1234 rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims))
1235 rcode = pio_inq_dimlen(pioid, dimid(1), lnx)
1237 rcode = pio_inq_dimlen(pioid, dimid(2), lny)
1242 if (ng /= mct_gsmap_gsize(gsmap))
then 1243 WRITE(
nulprt,*) subname,
estr,
'dimensions do not match',&
1244 lnx,lny,mct_gsmap_gsize(gsmap)
1247 call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
1250 call pio_read_darray(pioid,varid,iodesc, av%rattr(k,:), rcode)
1252 write(
nulprt,*) subname,
wstr,
'field ',trim(itemc),
' is not on restart file' 1253 write(
nulprt,*) subname,
wstr,
'for backwards compatibility will set it to 0' 1254 av%rattr(k,:) = 0.0_r8
1256 call pio_seterrorhandling(pioid,pio_internal_error)
1260 if (av%rAttr(k,n) == fillvalue)
then 1261 av%rAttr(k,n) = 0.0_r8
1266 call pio_freedecomp(pioid, iodesc)
1267 call pio_closefile(pioid)
1269 end subroutine oasis_ioshr_read_av
1284 subroutine oasis_ioshr_read_int(filename,idata,dname)
1288 character(len=*),
intent(in) :: filename
1289 integer ,
intent(inout):: idata
1290 character(len=*),
intent(in) :: dname
1295 character(*),
parameter :: subname =
'(oasis_ioshr_read_int) ' 1301 call oasis_ioshr_read_int1d(filename,i1d,dname)
1304 end subroutine oasis_ioshr_read_int
1319 subroutine oasis_ioshr_read_int1d(filename,idata,dname)
1323 character(len=*),
intent(in) :: filename
1324 integer(in) ,
intent(inout):: idata(:)
1325 character(len=*),
intent(in) :: dname
1329 integer(in) :: rcode
1330 type(file_desc_t) :: pioid
1331 type(var_desc_t) :: varid
1333 character(CL) :: lversion
1334 character(CL) :: name1
1335 character(*),
parameter :: subname =
'(oasis_ioshr_read_int1d) ' 1340 if (pio_iam==0)
inquire(file=trim(filename),exist=exists)
1341 call oasis_mpi_bcast(exists,pio_mpicomm,
'oasis_ioshr_read_int1d exists')
1343 rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1345 call pio_seterrorhandling(pioid,pio_bcast_error)
1346 rcode = pio_get_att(pioid,pio_global,
"file_version",lversion)
1347 call pio_seterrorhandling(pioid,pio_internal_error)
1349 WRITE(
nulprt,*) subname,
estr,
'file invalid ',trim(filename),
' ',trim(dname)
1354 rcode = pio_inq_varid(pioid,trim(name1),varid)
1355 rcode = pio_get_var(pioid,varid,idata)
1357 call pio_closefile(pioid)
1362 end subroutine oasis_ioshr_read_int1d
1377 subroutine oasis_ioshr_read_r8(filename,rdata,dname)
1381 character(len=*),
intent(in) :: filename
1382 real(r8) ,
intent(inout):: rdata
1383 character(len=*),
intent(in) :: dname
1388 character(*),
parameter :: subname =
'(oasis_ioshr_read_r8) ' 1394 call oasis_ioshr_read_r81d(filename,r1d,dname)
1397 end subroutine oasis_ioshr_read_r8
1412 subroutine oasis_ioshr_read_r81d(filename,rdata,dname)
1416 character(len=*),
intent(in) :: filename
1417 real(r8) ,
intent(inout):: rdata(:)
1418 character(len=*),
intent(in) :: dname
1422 integer(in) :: rcode
1423 type(file_desc_t) :: pioid
1424 type(var_desc_t) :: varid
1426 character(CL) :: lversion
1427 character(CL) :: name1
1428 character(*),
parameter :: subname =
'(oasis_ioshr_read_r81d) ' 1434 if (pio_iam==0)
inquire(file=trim(filename),exist=exists)
1435 call oasis_mpi_bcast(exists,pio_mpicomm,
'oasis_ioshr_read_r81d exists')
1437 rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1439 call pio_seterrorhandling(pioid,pio_bcast_error)
1440 rcode = pio_get_att(pioid,pio_global,
"file_version",lversion)
1441 call pio_seterrorhandling(pioid,pio_internal_error)
1443 WRITE(
nulprt,*) subname,
estr,
'file invalid ',trim(filename),
' ',trim(dname)
1448 rcode = pio_inq_varid(pioid,trim(name1),varid)
1449 rcode = pio_get_var(pioid,varid,rdata)
1451 call pio_closefile(pioid)
1455 end subroutine oasis_ioshr_read_r81d
1470 subroutine oasis_ioshr_read_char(filename,rdata,dname)
1474 character(len=*),
intent(in) :: filename
1475 character(len=*),
intent(inout):: rdata
1476 character(len=*),
intent(in) :: dname
1480 integer(in) :: rcode
1481 type(file_desc_t) :: pioid
1482 type(var_desc_t) :: varid
1484 character(CL) :: lversion
1485 character(CL) :: name1
1486 character(*),
parameter :: subname =
'(oasis_ioshr_read_char) ' 1492 if (pio_iam==0)
inquire(file=trim(filename),exist=exists)
1493 call oasis_mpi_bcast(exists,pio_mpicomm,
'oasis_ioshr_read_char exists')
1495 rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1497 call pio_seterrorhandling(pioid,pio_bcast_error)
1498 rcode = pio_get_att(pioid,pio_global,
"file_version",lversion)
1499 call pio_seterrorhandling(pioid,pio_internal_error)
1501 WRITE(
nulprt,*) subname,
estr,
'file invalid ',trim(filename),
' ',trim(dname)
1506 rcode = pio_inq_varid(pioid,trim(name1),varid)
1507 rcode = pio_get_var(pioid,varid,charvar)
1508 rdata = trim(charvar)
1510 call pio_closefile(pioid)
1512 end subroutine oasis_ioshr_read_char
real(ip_double_p), parameter rspval
Provides a common location for several OASIS variables.
integer(kind=ip_intwp_p) nulprt
Generic overloaded interface into MPI broadcast.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
integer, parameter ip_r8_p
integer, parameter ic_long
Character string manipulation methods.
Provides a generic and simpler interface into MPI calls for OASIS.
character(len= *), parameter, public estr
subroutine, public oasis_mpi_commsize(comm, size, string)
Get the total number of tasks associated with a communicator.
IO interfaces based on pio (not supported yet)
integer, parameter ip_intwp_p
subroutine, public oasis_mpi_commrank(comm, rank, string)
Get the rank (task ID) for a task in a communicator.
character(len=len(str)) function, public oasis_string_toupper(str)
Convert the input string to upper-case.
character(len= *), parameter, public wstr