Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_ioshr.F90
Go to the documentation of this file.
1 
2 !> IO interfaces based on pio (not supported yet)
3 
4 !===============================================================================
5 !BOP ===========================================================================
6 !
7 ! !MODULE: mod_oasis_ioshr -- reads and writes driver files
8 !
9 ! !DESCRIPTION:
10 ! Writes attribute vectors to netcdf
11 !
12 ! !REMARKS:
13 !
14 ! !REVISION HISTORY:
15 !
16 ! !INTERFACE: ------------------------------------------------------------------
17 
19 
20 #if (PIO_DEFINED)
21 
22  ! !USES:
23 
24  use mod_oasis_kinds, only: r8 => ip_r8_p, in => ip_intwp_p
25  use mod_oasis_kinds, only: cl => ic_long
26  use mod_oasis_data
27  use mod_oasis_sys
29  use mod_oasis_mpi
30  use mct_mod ! mct wrappers
31  use pio
32 
33  implicit none
34  private
35 
36 ! !PUBLIC TYPES:
37 
38  ! none
39 
40 ! !PUBLIC MEMBER FUNCTIONS:
41 
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
52 ! public oasis_ioshr_getiosys
53  public oasis_ioshr_getiotype
54  public oasis_ioshr_getioroot
55 
56 ! !PUBLIC DATA MEMBERS
57 
58  ! none
59 
60 !EOP
61 
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
69  end interface
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
78  end interface
79 
80 !-------------------------------------------------------------------------------
81 ! Local data
82 !-------------------------------------------------------------------------------
83 
84  character(*),parameter :: prefix = "oasis_ioshr_"
85  character(CL) :: wfilename = ''
86  real(r8) ,parameter :: fillvalue = rspval
87  character(CL) :: charvar ! buffer for string read/write
88 
89  character(*),parameter :: modname = "(mod_oasis_ioshr) "
90  integer(in) ,parameter :: debug = 1 ! internal debug level
91 
92  character(*),parameter :: version ='oasis_ioshr_v00'
93 
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
102 
103  integer(IN),parameter :: pio_root_default = 0
104 
105 !=================================================================================
106 contains
107 !=================================================================================
108 
109 !=================================================================================
110 !BOP =============================================================================
111 !
112 ! !IROUTINE: oasis_ioshr_init - initialize io for coupler
113 !
114 ! !DESCRIPTION:
115 ! Read the pio_inparm namelist and initialize the pio subsystem
116 !
117 ! !REVISION HISTORY:
118 ! 2009-Sep-30 - B. Kauffman - consolidation, clean up
119 ! 2009-Feb-17 - J. Edwards - initial version
120 !
121 ! !INTERFACE: --------------------------------------------------------------------
122 
123  subroutine oasis_ioshr_init(mpicomm,typename,stride,root,numtasks)
124  implicit none
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
130 
131  integer :: npes
132  character(*),parameter :: subname = '(oasis_ioshr_init) '
133  character(*),parameter :: f00 = "('(oasis_ioshr_init) ',4a)"
134  character(*),parameter :: f01 = "('(oasis_ioshr_init) ',a,i6)"
135 
136  !--------------------------------------------------------------------------
137  ! init pio library
138  !--------------------------------------------------------------------------
139 
140  pio_mpicomm = mpicomm
141  pio_stride = stride
142  pio_numtasks = numtasks
143  pio_root = root
144  call getiotypefromname(typename, pio_iotype, pio_iotype_netcdf)
145  call oasis_mpi_commsize(pio_mpicomm,npes)
146  call oasis_mpi_commrank(pio_mpicomm,pio_iam)
147 
148  call namelist_set(npes, pio_mpicomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
149 
150  if(pio_iam==0) then
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'
163  end select
164  write(nulprt,f01) ' pio_iotype = ',pio_iotype
165  write(nulprt,f01) ' pio_numtasks = ',pio_numtasks
166  end if
167  call pio_init(pio_iam, pio_mpicomm, pio_numtasks, 0, pio_stride, &
168  pio_rearr_box, pio_iosystem, base=pio_root)
169 
170  end subroutine oasis_ioshr_init
171 
172 !===============================================================================
173 
174  subroutine getiotypefromname(itypename, iotype, defaulttype)
175  implicit none
176  character(len=*), intent(in) :: itypename
177  integer, intent(out) :: iotype
178  integer, intent(in) :: defaulttype
179 
180  character(len=len(itypename)) :: typename
181  character(*),parameter :: subname = '(oasis_ioshr_getiotypefromname) '
182 
183  typename = oasis_string_toupper(itypename)
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
193  iotype = defaulttype
194  else
195  write(nulprt,*) subname,wstr,'Bad io_type argument - using iotype_netcdf'
196  iotype=pio_iotype_netcdf
197  end if
198  end subroutine getiotypefromname
199 
200 !===============================================================================
201 
202  subroutine namelist_set(npes,mycomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
203  implicit none
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) '
208 
209 
210  call oasis_mpi_bcast(pio_iotype , mycomm)
211  call oasis_mpi_bcast(pio_stride , mycomm)
212  call oasis_mpi_bcast(pio_root , mycomm)
213  call oasis_mpi_bcast(pio_numtasks, mycomm)
214 
215  !--------------------------------------------------------------------------
216  ! check/set/correct io pio parameters
217  !--------------------------------------------------------------------------
218 
219 
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
225  pio_stride = 4
226  pio_numtasks = npes/pio_stride
227  pio_numtasks = max(1, pio_numtasks)
228  end if
229 
230  if (pio_root<0) then
231  pio_root = pio_root_default
232  endif
233  pio_root = min(pio_root,npes-1)
234 
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
238  if(npes<100) then
239  pio_stride = max(1,npes/4)
240  else if(npes<1000) then
241  pio_stride = max(1,npes/8)
242  else
243  pio_stride = max(1,npes/16)
244  end if
245  if(pio_stride>1) then
246  pio_numtasks = npes/pio_stride
247  pio_root = min(1,npes-1)
248  else
249  pio_numtasks = npes
250  pio_root = 0
251  end if
252  if(debug>0) then
253  write(nulprt,*) subname,'pio_stride, iotasks or root out of bounds - resetting to defaults: ',&
254  pio_stride,pio_numtasks, pio_root
255  end if
256  end if
257 
258 
259  end subroutine namelist_set
260 
261 !===============================================================================
262  subroutine oasis_ioshr_finalize
263  implicit none
264  integer :: ierr
265  character(*),parameter :: subname = '(oasis_ioshr_finalize) '
266 
267  call pio_finalize(pio_iosystem, ierr)
268 
269  end subroutine oasis_ioshr_finalize
270 
271 !===============================================================================
272 ! function oasis_ioshr_getiosys() result(iosystem)
273 ! implicit none
274 ! type(iosystem_desc_t), pointer :: iosystem
275 ! character(*),parameter :: subName = '(oasis_ioshr_getiosys) '
276 !
277 ! iosystem => pio_iosystem
278 !
279 ! end function oasis_ioshr_getiosys
280 !
281 !===============================================================================
282  function oasis_ioshr_getiotype() result(io_type)
283  implicit none
284  integer :: io_type
285  character(*),parameter :: subname = '(oasis_ioshr_getiotype) '
286 
287  io_type = pio_iotype
288 
289  end function oasis_ioshr_getiotype
290 !===============================================================================
291  function oasis_ioshr_getioroot() result(io_root)
292  implicit none
293  integer :: io_root
294  character(*),parameter :: subname = '(oasis_ioshr_getioroot) '
295 
296  io_root = pio_root
297 
298  end function oasis_ioshr_getioroot
299 
300 
301 !===============================================================================
302 
303 subroutine oasis_ioshr_flds_lookup(fldname,longname,stdname,units)
304  implicit none
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) '
310 
311  if (present(longname)) then
312  longname = 'unknown'
313  endif
314  if (present(stdname)) then
315  stdname = 'unknown'
316  endif
317  if (present(units)) then
318  units = 'unknown'
319  endif
320 
321 end subroutine oasis_ioshr_flds_lookup
322 
323 !===============================================================================
324 !BOP ===========================================================================
325 !
326 ! !IROUTINE: oasis_ioshr_wopen - open netcdf file
327 !
328 ! !DESCRIPTION:
329 ! open netcdf file
330 !
331 ! !REVISION HISTORY:
332 ! 2007-Oct-26 - T. Craig - initial version
333 !
334 ! !INTERFACE: ------------------------------------------------------------------
335 
336 subroutine oasis_ioshr_wopen(filename,clobber,cdf64)
337 
338  ! !INPUT/OUTPUT PARAMETERS:
339  implicit none
340  character(*),intent(in) :: filename
341  logical,optional,intent(in):: clobber
342  logical,optional,intent(in):: cdf64
343 
344  !EOP
345 
346  logical :: exists
347  logical :: lclobber
348  logical :: lcdf64
349  integer :: rcode
350  integer :: nmode
351  character(CL) :: lversion
352  character(*),parameter :: subname = '(oasis_ioshr_wopen) '
353 
354 !-------------------------------------------------------------------------------
355 !
356 !-------------------------------------------------------------------------------
357 
358  lclobber = .false.
359  if (present(clobber)) lclobber=clobber
360 
361  lcdf64 = .false.
362  if (present(cdf64)) lcdf64=cdf64
363 
364  if (.not. pio_file_is_open(pio_file)) then
365  ! filename not open
366  if (pio_iam==0) inquire(file=trim(filename),exist=exists)
367  call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_wopen exists')
368  if (exists) then
369  if (lclobber) then
370  nmode = pio_clobber
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)
375  else
376 
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)
386  endif
387  endif
388  else
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)
394  endif
395  elseif (trim(wfilename) /= trim(filename)) then
396  ! filename is open, better match open filename
397  write(nulprt,*) subname,estr,'different file currently open ',trim(filename)
398  call oasis_abort()
399  else
400  ! filename is already open, just return
401  endif
402 
403 end subroutine oasis_ioshr_wopen
404 
405 !===============================================================================
406 !BOP ===========================================================================
407 !
408 ! !IROUTINE: oasis_ioshr_close - close netcdf file
409 !
410 ! !DESCRIPTION:
411 ! close netcdf file
412 !
413 ! !REVISION HISTORY:
414 ! 2007-Oct-26 - T. Craig - initial version
415 !
416 ! !INTERFACE: ------------------------------------------------------------------
417 
418 subroutine oasis_ioshr_close(filename)
419 
420  implicit none
421 
422  ! !INPUT/OUTPUT PARAMETERS:
423  character(*),intent(in) :: filename
424 
425  !EOP
426 
427  integer :: rcode
428  character(*),parameter :: subname = '(oasis_ioshr_close) '
429 
430 !-------------------------------------------------------------------------------
431 !
432 !-------------------------------------------------------------------------------
433 
434  if (.not. pio_file_is_open(pio_file)) then
435  ! filename not open, just return
436  elseif (trim(wfilename) /= trim(filename)) then
437  ! filename matches, close it
438  call pio_closefile(pio_file)
439  else
440  ! different filename is open, abort
441  write(nulprt,*) subname,estr,'different file currently open ',trim(filename)
442  call oasis_abort()
443  endif
444 
445  wfilename = ''
446 
447 end subroutine oasis_ioshr_close
448 
449 !===============================================================================
450 
451 subroutine oasis_ioshr_redef(filename)
452  implicit none
453  character(len=*), intent(in) :: filename
454  integer :: rcode
455  character(*),parameter :: subname = '(oasis_ioshr_redef) '
456 
457  rcode = pio_redef(pio_file)
458 end subroutine oasis_ioshr_redef
459 
460 !===============================================================================
461 
462 subroutine oasis_ioshr_enddef(filename)
463  implicit none
464  character(len=*), intent(in) :: filename
465  integer :: rcode
466  character(*),parameter :: subname = '(oasis_ioshr_enddef) '
467 
468  rcode = pio_enddef(pio_file)
469 end subroutine oasis_ioshr_enddef
470 
471 !===============================================================================
472 
473 character(len=10) function oasis_ioshr_date2yyyymmdd (date)
474  implicit none
475 
476 ! Input arguments
477 
478  integer, intent(in) :: date
479 
480 ! Local workspace
481 
482  integer :: year ! year of yyyy-mm-dd
483  integer :: month ! month of yyyy-mm-dd
484  integer :: day ! day of yyyy-mm-dd
485  character(*),parameter :: subname = '(oasis_ioshr_date2yyyymmdd) '
486 
487 !-------------------------------------------------------------------------------
488 
489  if (date < 0) then
490  WRITE(nulprt,*) subname,estr,'oasis_ioshr_date2yyyymmdd: negative date not allowed'
491  CALL oasis_abort()
492  end if
493 
494  year = date / 10000
495  month = (date - year*10000) / 100
496  day = date - year*10000 - month*100
497 
498  write(oasis_ioshr_date2yyyymmdd,80) year, month, day
499 80 format(i4.4,'-',i2.2,'-',i2.2)
500 
501 end function oasis_ioshr_date2yyyymmdd
502 
503 !===============================================================================
504 
505 character(len=8) function oasis_ioshr_sec2hms (seconds)
506  implicit none
507 
508 ! Input arguments
509 
510  integer, intent(in) :: seconds
511 
512 ! Local workspace
513 
514  integer :: hours ! hours of hh:mm:ss
515  integer :: minutes ! minutes of hh:mm:ss
516  integer :: secs ! seconds of hh:mm:ss
517  character(*),parameter :: subname = '(oasis_ioshr_sec2hms) '
518 
519 !-------------------------------------------------------------------------------
520 
521  if (seconds < 0 .or. seconds > 86400) then
522  WRITE(nulprt,*) subname,estr,'oasis_ioshr_sec2hms: bad input seconds:', seconds
523  CALL oasis_abort()
524  end if
525 
526  hours = seconds / 3600
527  minutes = (seconds - hours*3600) / 60
528  secs = (seconds - hours*3600 - minutes*60)
529 
530  if (minutes < 0 .or. minutes > 60) then
531  WRITE(nulprt,*) subname,estr,'oasis_ioshr_sec2hms: bad minutes = ',minutes
532  CALL oasis_abort()
533  end if
534 
535  if (secs < 0 .or. secs > 60) then
536  WRITE(nulprt,*) subname,estr,'oasis_ioshr_sec2hms: bad secs = ',secs
537  CALL oasis_abort()
538  end if
539 
540  write(oasis_ioshr_sec2hms,80) hours, minutes, secs
541 80 format(i2.2,':',i2.2,':',i2.2)
542 
543 end function oasis_ioshr_sec2hms
544 
545 !===============================================================================
546 !BOP ===========================================================================
547 !
548 ! !IROUTINE: oasis_ioshr_write_av - write AV to netcdf file
549 !
550 ! !DESCRIPTION:
551 ! Write AV to netcdf file
552 !
553 ! !REVISION HISTORY:
554 ! 2007-Oct-26 - T. Craig - initial version
555 !
556 ! !INTERFACE: ------------------------------------------------------------------
557 
558  subroutine oasis_ioshr_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,use_float)
559 
560  ! !INPUT/OUTPUT PARAMETERS:
561  implicit none
562  character(len=*),intent(in) :: filename ! file
563  type(mct_gsmap), intent(in) :: gsmap
564  type(mct_avect) ,intent(in) :: av ! data to be written
565  character(len=*),intent(in) :: dname ! name of data
566  logical,optional,intent(in) :: whead ! write header
567  logical,optional,intent(in) :: wdata ! write data
568  integer(in),optional,intent(in) :: nx ! 2d grid size if available
569  integer(in),optional,intent(in) :: ny ! 2d grid size if available
570  integer(in),optional,intent(in) :: nt ! time sample
571  real(r8),optional,intent(in) :: fillval ! fill value
572  character(len=*),optional,intent(in) :: pre ! prefix to variable name
573  logical,optional,intent(in) :: tavg ! is this a tavg
574  logical,optional,intent(in) :: use_float ! write output as float rather than double
575 
576  !EOP
577 
578  integer(in) :: rcode
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 ! mct char type
588  character(CL) :: itemc ! string converted to char
589  character(CL) :: name1 ! var name
590  character(CL) :: cunit ! var units
591  character(CL) :: lname ! long name
592  character(CL) :: sname ! standard name
593  character(CL) :: lpre ! local prefix
594  logical :: exists
595  logical :: lwhead, lwdata
596  integer(in) :: lnx,lny
597  real(r8) :: lfillvalue
598  type(mct_avect) :: avroot
599  real(r8),pointer :: fld1(:,:) ! needed to convert AVroot ng rAttr to 2d nx,ny
600  character(*),parameter :: subname = '(oasis_ioshr_write_av) '
601  integer :: lbnum
602  integer, pointer :: dof(:)
603 
604  !-------------------------------------------------------------------------------
605  !
606  !-------------------------------------------------------------------------------
607 
608  lfillvalue = fillvalue
609  if (present(fillval)) then
610  lfillvalue = fillval
611  endif
612 
613  lpre = trim(dname)
614  if (present(pre)) then
615  lpre = trim(pre)
616  endif
617 
618  lwhead = .true.
619  lwdata = .true.
620  if (present(whead)) lwhead = whead
621  if (present(wdata)) lwdata = wdata
622 
623  if (.not.lwhead .and. .not.lwdata) then
624  ! should we write a warning?
625  return
626  endif
627 
628  ng = mct_gsmap_gsize(gsmap)
629  lnx = ng
630  lny = 1
631 
632  nf = mct_avect_nrattr(av)
633  if (nf < 1) then
634  write(nulprt,*) subname,estr,'nf = ',nf,trim(dname)
635  call oasis_abort()
636  endif
637 
638  if (present(nx)) then
639  if (nx /= 0) lnx = nx
640  endif
641  if (present(ny)) then
642  if (ny /= 0) lny = ny
643  endif
644  if (lnx*lny /= ng) then
645  write(nulprt,*) subname,estr,'grid2d size not consistent ',ng,lnx,lny,trim(dname)
646  call oasis_abort()
647  endif
648 
649  if (lwhead) then
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))
652 
653  if (present(nt)) then
654  dimid3(1:2) = dimid2
655  rcode = pio_inq_dimid(pio_file,'time',dimid3(3))
656  dimid => dimid3
657  else
658  dimid => dimid2
659  endif
660 
661  do k = 1,nf
662  call mct_avect_getrlist(mstring,k,av)
663  itemc = mct_string_tochar(mstring)
664  call mct_string_clean(mstring)
665 ! "v0" name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
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)
670  else
671  rcode = pio_def_var(pio_file,trim(name1),pio_double,dimid,varid)
672  end if
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
679  if (tavg) then
680  rcode = pio_put_att(pio_file,varid,"cell_methods","time: mean")
681  endif
682  endif
683  enddo
684  if (lwdata) call oasis_ioshr_enddef(filename)
685  end if
686 
687  if (lwdata) then
688  call mct_gsmap_orderedpoints(gsmap, pio_iam, dof)
689  call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
690  deallocate(dof)
691 
692  do k = 1,nf
693  call mct_avect_getrlist(mstring,k,av)
694  itemc = mct_string_tochar(mstring)
695  call mct_string_clean(mstring)
696 ! "v0" name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
697  name1 = trim(lpre)//'_'//trim(itemc)
698  rcode = pio_inq_varid(pio_file,trim(name1),varid)
699  if (present(nt)) then
700  frame = nt
701  else
702  frame = 1
703  endif
704  call pio_setframe(varid,frame)
705  call pio_write_darray(pio_file, varid, iodesc, av%rattr(k,:), rcode, fillval=lfillvalue)
706  enddo
707 
708  call pio_freedecomp(pio_file, iodesc)
709 
710  end if
711  end subroutine oasis_ioshr_write_av
712 
713  !===============================================================================
714  !BOP ===========================================================================
715  !
716  ! !IROUTINE: oasis_ioshr_write_int - write scalar integer to netcdf file
717  !
718  ! !DESCRIPTION:
719  ! Write scalar integer to netcdf file
720  !
721  ! !REVISION HISTORY:
722  ! 2007-Oct-26 - T. Craig - initial version
723  !
724  ! !INTERFACE: ------------------------------------------------------------------
725 
726  subroutine oasis_ioshr_write_int(filename,idata,dname,whead,wdata)
727 
728  ! !INPUT/OUTPUT PARAMETERS:
729  implicit none
730  character(len=*),intent(in) :: filename ! file
731  integer(in) ,intent(in) :: idata ! data to be written
732  character(len=*),intent(in) :: dname ! name of data
733  logical,optional,intent(in) :: whead ! write header
734  logical,optional,intent(in) :: wdata ! write data
735 
736  !EOP
737 
738  integer(in) :: rcode
739  type(var_desc_t) :: varid
740  character(CL) :: cunit ! var units
741  character(CL) :: lname ! long name
742  character(CL) :: sname ! standard name
743  logical :: exists
744  logical :: lwhead, lwdata
745  character(*),parameter :: subname = '(oasis_ioshr_write_int) '
746 
747  !-------------------------------------------------------------------------------
748  !
749  !-------------------------------------------------------------------------------
750 
751  lwhead = .true.
752  lwdata = .true.
753  if (present(whead)) lwhead = whead
754  if (present(wdata)) lwdata = wdata
755 
756  if (.not.lwhead .and. .not.lwdata) then
757  ! should we write a warning?
758  return
759  endif
760 
761  if (lwhead) then
762  call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
763 ! rcode = pio_def_dim(pio_file,trim(dname)//'_nx',1,dimid(1))
764 ! rcode = pio_def_var(pio_file,trim(dname),PIO_INT,dimid,varid)
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)
770  endif
771 
772  if (lwdata) then
773  rcode = pio_inq_varid(pio_file,trim(dname),varid)
774  rcode = pio_put_var(pio_file,varid,idata)
775 
776  ! write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
777  endif
778 
779  end subroutine oasis_ioshr_write_int
780 
781  !===============================================================================
782  !BOP ===========================================================================
783  !
784  ! !IROUTINE: oasis_ioshr_write_int1d - write 1d integer array to netcdf file
785  !
786  ! !DESCRIPTION:
787  ! Write 1d integer array to netcdf file
788  !
789  ! !REVISION HISTORY:
790  ! 2007-Oct-26 - T. Craig - initial version
791  !
792  ! !INTERFACE: ------------------------------------------------------------------
793 
794  subroutine oasis_ioshr_write_int1d(filename,idata,dname,whead,wdata)
795 
796  ! !INPUT/OUTPUT PARAMETERS:
797  implicit none
798  character(len=*),intent(in) :: filename ! file
799  integer(in) ,intent(in) :: idata(:) ! data to be written
800  character(len=*),intent(in) :: dname ! name of data
801  logical,optional,intent(in) :: whead ! write header
802  logical,optional,intent(in) :: wdata ! write data
803 
804  !EOP
805 
806  integer(in) :: rcode
807  integer(in) :: dimid(1)
808  type(var_desc_t) :: varid
809  character(CL) :: cunit ! var units
810  character(CL) :: lname ! long name
811  character(CL) :: sname ! standard name
812  integer(in) :: lnx
813  logical :: exists
814  logical :: lwhead, lwdata
815  character(*),parameter :: subname = '(oasis_ioshr_write_int1d) '
816 
817  !-------------------------------------------------------------------------------
818  !
819  !-------------------------------------------------------------------------------
820 
821  lwhead = .true.
822  lwdata = .true.
823  if (present(whead)) lwhead = whead
824  if (present(wdata)) lwdata = wdata
825 
826  if (.not.lwhead .and. .not.lwdata) then
827  ! should we write a warning?
828  return
829  endif
830 
831  if (lwhead) then
832  call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
833  lnx = size(idata)
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)
840  endif
841 
842  if (lwdata) then
843  rcode = pio_inq_varid(pio_file,trim(dname),varid)
844  rcode = pio_put_var(pio_file,varid,idata)
845  endif
846 
847  ! write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
848 
849  end subroutine oasis_ioshr_write_int1d
850 
851  !===============================================================================
852  !BOP ===========================================================================
853  !
854  ! !IROUTINE: oasis_ioshr_write_r8 - write scalar double to netcdf file
855  !
856  ! !DESCRIPTION:
857  ! Write scalar double to netcdf file
858  !
859  ! !REVISION HISTORY:
860  ! 2007-Oct-26 - T. Craig - initial version
861  !
862  ! !INTERFACE: ------------------------------------------------------------------
863 
864  subroutine oasis_ioshr_write_r8(filename,rdata,dname,whead,wdata)
865 
866  ! !INPUT/OUTPUT PARAMETERS:
867  implicit none
868  character(len=*),intent(in) :: filename ! file
869  real(r8) ,intent(in) :: rdata ! data to be written
870  character(len=*),intent(in) :: dname ! name of data
871  logical,optional,intent(in) :: whead ! write header
872  logical,optional,intent(in) :: wdata ! write data
873 
874  !EOP
875 
876  integer(in) :: rcode
877  type(var_desc_t) :: varid
878  character(CL) :: cunit ! var units
879  character(CL) :: lname ! long name
880  character(CL) :: sname ! standard name
881  logical :: exists
882  logical :: lwhead, lwdata
883  character(*),parameter :: subname = '(oasis_ioshr_write_r8) '
884 
885  !-------------------------------------------------------------------------------
886  !
887  !-------------------------------------------------------------------------------
888 
889  lwhead = .true.
890  lwdata = .true.
891  if (present(whead)) lwhead = whead
892  if (present(wdata)) lwdata = wdata
893 
894  if (.not.lwhead .and. .not.lwdata) then
895  ! should we write a warning?
896  return
897  endif
898 
899  if (lwhead) then
900  call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
901 ! rcode = pio_def_dim(pio_file,trim(dname)//'_nx',1,dimid(1))
902 ! rcode = pio_def_var(pio_file,trim(dname),PIO_DOUBLE,dimid,varid)
903 
904 
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)
911  end if
912  endif
913 
914  if (lwdata) then
915  rcode = pio_inq_varid(pio_file,trim(dname),varid)
916  rcode = pio_put_var(pio_file,varid,rdata)
917  endif
918 
919 
920  end subroutine oasis_ioshr_write_r8
921 
922  !===============================================================================
923  !BOP ===========================================================================
924  !
925  ! !IROUTINE: oasis_ioshr_write_r81d - write 1d double array to netcdf file
926  !
927  ! !DESCRIPTION:
928  ! Write 1d double array to netcdf file
929  !
930  ! !REVISION HISTORY:
931  ! 2007-Oct-26 - T. Craig - initial version
932  !
933  ! !INTERFACE: ------------------------------------------------------------------
934 
935  subroutine oasis_ioshr_write_r81d(filename,rdata,dname,whead,wdata)
936 
937  ! !INPUT/OUTPUT PARAMETERS:
938  implicit none
939  character(len=*),intent(in) :: filename ! file
940  real(r8) ,intent(in) :: rdata(:) ! data to be written
941  character(len=*),intent(in) :: dname ! name of data
942  logical,optional,intent(in) :: whead ! write header
943  logical,optional,intent(in) :: wdata ! write data
944 
945  !EOP
946 
947  integer(in) :: rcode
948  integer(in) :: dimid(1)
949  type(var_desc_t) :: varid
950  character(CL) :: cunit ! var units
951  character(CL) :: lname ! long name
952  character(CL) :: sname ! standard name
953  integer(in) :: lnx
954  logical :: exists
955  logical :: lwhead, lwdata
956  character(*),parameter :: subname = '(oasis_ioshr_write_r81d) '
957 
958  !-------------------------------------------------------------------------------
959  !
960  !-------------------------------------------------------------------------------
961 
962  lwhead = .true.
963  lwdata = .true.
964  if (present(whead)) lwhead = whead
965  if (present(wdata)) lwdata = wdata
966 
967  if (.not.lwhead .and. .not.lwdata) then
968  ! should we write a warning?
969  return
970  endif
971 
972  if (lwhead) then
973  call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
974  lnx = size(rdata)
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)
981  endif
982 
983  if (lwdata) then
984  rcode = pio_inq_varid(pio_file,trim(dname),varid)
985  rcode = pio_put_var(pio_file,varid,rdata)
986 
987  ! write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
988  endif
989 
990  end subroutine oasis_ioshr_write_r81d
991 
992  !===============================================================================
993  !BOP ===========================================================================
994  !
995  ! !IROUTINE: oasis_ioshr_write_char - write char string to netcdf file
996  !
997  ! !DESCRIPTION:
998  ! Write char string to netcdf file
999  !
1000  ! !REVISION HISTORY:
1001  ! 2010-July-06 - T. Craig - initial version
1002  !
1003  ! !INTERFACE: ------------------------------------------------------------------
1004 
1005  subroutine oasis_ioshr_write_char(filename,rdata,dname,whead,wdata)
1006 
1007  ! !INPUT/OUTPUT PARAMETERS:
1008  implicit none
1009  character(len=*),intent(in) :: filename ! file
1010  character(len=*),intent(in) :: rdata ! data to be written
1011  character(len=*),intent(in) :: dname ! name of data
1012  logical,optional,intent(in) :: whead ! write header
1013  logical,optional,intent(in) :: wdata ! write data
1014 
1015  !EOP
1016 
1017  integer(in) :: rcode
1018  integer(in) :: dimid(1)
1019  type(var_desc_t) :: varid
1020  character(CL) :: cunit ! var units
1021  character(CL) :: lname ! long name
1022  character(CL) :: sname ! standard name
1023  integer(in) :: lnx
1024  logical :: exists
1025  logical :: lwhead, lwdata
1026  character(*),parameter :: subname = '(oasis_ioshr_write_char) '
1027 
1028  !-------------------------------------------------------------------------------
1029  !
1030  !-------------------------------------------------------------------------------
1031 
1032  lwhead = .true.
1033  lwdata = .true.
1034  if (present(whead)) lwhead = whead
1035  if (present(wdata)) lwdata = wdata
1036 
1037  if (.not.lwhead .and. .not.lwdata) then
1038  ! should we write a warning?
1039  return
1040  endif
1041 
1042  if (lwhead) then
1043  call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
1044  lnx = len(charvar)
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)
1051  endif
1052 
1053  if (lwdata) then
1054  charvar = ''
1055  charvar = trim(rdata)
1056  rcode = pio_inq_varid(pio_file,trim(dname),varid)
1057  rcode = pio_put_var(pio_file,varid,charvar)
1058  endif
1059 
1060  end subroutine oasis_ioshr_write_char
1061 
1062  !===============================================================================
1063 !BOP ===========================================================================
1064 !
1065 ! !IROUTINE: oasis_ioshr_write_time - write time variable to netcdf file
1066 !
1067 ! !DESCRIPTION:
1068 ! Write time variable to netcdf file
1069 !
1070 ! !REVISION HISTORY:
1071 ! 2009-Feb-11 - M. Vertenstein - initial version
1072 !
1073 ! !INTERFACE: ------------------------------------------------------------------
1074 
1075 subroutine oasis_ioshr_write_time(filename,time_units,time_cal,time_val,nt,whead,wdata,tbnds)
1076 
1077 ! !INPUT/OUTPUT PARAMETERS:
1078  implicit none
1079  character(len=*),intent(in) :: filename ! file
1080  character(len=*),intent(in) :: time_units ! units of time
1081  character(len=*),intent(in) :: time_cal ! calendar type
1082  real(r8) ,intent(in) :: time_val ! data to be written
1083  integer(in),optional,intent(in) :: nt
1084  logical,optional,intent(in) :: whead ! write header
1085  logical,optional,intent(in) :: wdata ! write data
1086  real(r8),optional,intent(in) :: tbnds(2) ! time bounds
1087 
1088 !EOP
1089 
1090  integer(in) :: rcode
1091  integer(in) :: dimid(1)
1092  integer(in) :: dimid2(2)
1093  type(var_desc_t) :: varid
1094  integer(in) :: lnx
1095  logical :: exists
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) '
1101 
1102 !-------------------------------------------------------------------------------
1103 !
1104 !-------------------------------------------------------------------------------
1105 
1106  lwhead = .true.
1107  lwdata = .true.
1108  if (present(whead)) lwhead = whead
1109  if (present(wdata)) lwdata = wdata
1110 
1111  if (.not.lwhead .and. .not.lwdata) then
1112  ! should we write a warning?
1113  return
1114  endif
1115 
1116  if (lwhead) 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')
1124  dimid2(2)=dimid(1)
1125  rcode = pio_def_dim(pio_file,'ntb',2,dimid2(1))
1126  rcode = pio_def_var(pio_file,'time_bnds',pio_double,dimid2,varid)
1127  endif
1128  if (lwdata) call oasis_ioshr_enddef(filename)
1129  endif
1130 
1131  if (lwdata) then
1132  start = 1
1133  count = 1
1134  if (present(nt)) then
1135  start(1) = nt
1136  endif
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)
1142  start = 1
1143  count = 1
1144  if (present(nt)) then
1145  start(2) = nt
1146  endif
1147  count(1) = 2
1148  rcode = pio_put_var(pio_file,varid,start,count,tbnds)
1149  endif
1150 
1151  ! write(nulprt,*) subname,' wrote time ',lwhead,lwdata
1152  endif
1153 
1154  end subroutine oasis_ioshr_write_time
1155 
1156 !===============================================================================
1157  !BOP ===========================================================================
1158  !
1159  ! !IROUTINE: oasis_ioshr_read_av - read AV from netcdf file
1160  !
1161  ! !DESCRIPTION:
1162  ! Read AV from netcdf file
1163  !
1164  ! !REVISION HISTORY:
1165  ! 2007-Oct-26 - T. Craig - initial version
1166  !
1167  ! !INTERFACE: ------------------------------------------------------------------
1168 
1169  subroutine oasis_ioshr_read_av(filename,gsmap,AV,dname,pre)
1170 
1171  ! !INPUT/OUTPUT PARAMETERS:
1172  implicit none
1173  character(len=*),intent(in) :: filename ! file
1174  type(mct_gsmap), intent(in) :: gsmap
1175  type(mct_avect) ,intent(inout):: av ! data to be written
1176  character(len=*),intent(in) :: dname ! name of data
1177  character(len=*),intent(in),optional :: pre ! prefix name
1178 
1179  !EOP
1180 
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 ! mct char type
1189  character(CL) :: itemc ! string converted to char
1190  logical :: exists
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) '
1197  !-------------------------------------------------------------------------------
1198  !
1199  !-------------------------------------------------------------------------------
1200 
1201  lpre = trim(dname)
1202  if (present(pre)) then
1203  lpre = trim(pre)
1204  endif
1205 
1206  call mct_gsmap_orderedpoints(gsmap, pio_iam, dof)
1207 
1208  ns = mct_avect_lsize(av)
1209  nf = mct_avect_nrattr(av)
1210 
1211  if (pio_iam==0) inquire(file=trim(filename),exist=exists)
1212  call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_av exists')
1213  if (exists) then
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)
1219  else
1220  write(nulprt,*) subname,estr,'file invalid ',trim(filename),' ',trim(dname)
1221  call oasis_abort()
1222  endif
1223 
1224  do k = 1,nf
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
1232  if (k==1) 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)
1236  if (ndims==2) then
1237  rcode = pio_inq_dimlen(pioid, dimid(2), lny)
1238  else
1239  lny = 1
1240  end if
1241  ng = lnx * 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)
1245  CALL oasis_abort()
1246  end if
1247  call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
1248  deallocate(dof)
1249  end if
1250  call pio_read_darray(pioid,varid,iodesc, av%rattr(k,:), rcode)
1251  else
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
1255  end if
1256  call pio_seterrorhandling(pioid,pio_internal_error)
1257 
1258  !--- zero out fill value, this is somewhat arbitrary
1259  do n = 1,ns
1260  if (av%rAttr(k,n) == fillvalue) then
1261  av%rAttr(k,n) = 0.0_r8
1262  endif
1263  enddo
1264  enddo
1265 
1266  call pio_freedecomp(pioid, iodesc)
1267  call pio_closefile(pioid)
1268 
1269  end subroutine oasis_ioshr_read_av
1270 
1271  !===============================================================================
1272  !BOP ===========================================================================
1273  !
1274  ! !IROUTINE: oasis_ioshr_read_int - read scalar integer from netcdf file
1275  !
1276  ! !DESCRIPTION:
1277  ! Read scalar integer from netcdf file
1278  !
1279  ! !REVISION HISTORY:
1280  ! 2007-Oct-26 - T. Craig - initial version
1281  !
1282  ! !INTERFACE: ------------------------------------------------------------------
1283 
1284  subroutine oasis_ioshr_read_int(filename,idata,dname)
1285 
1286  ! !INPUT/OUTPUT PARAMETERS:
1287  implicit none
1288  character(len=*),intent(in) :: filename ! file
1289  integer ,intent(inout):: idata ! integer data
1290  character(len=*),intent(in) :: dname ! name of data
1291 
1292  !EOP
1293 
1294  integer :: i1d(1)
1295  character(*),parameter :: subname = '(oasis_ioshr_read_int) '
1296 
1297  !-------------------------------------------------------------------------------
1298  !
1299  !-------------------------------------------------------------------------------
1300 
1301  call oasis_ioshr_read_int1d(filename,i1d,dname)
1302  idata = i1d(1)
1303 
1304  end subroutine oasis_ioshr_read_int
1305 
1306  !===============================================================================
1307  !BOP ===========================================================================
1308  !
1309  ! !IROUTINE: oasis_ioshr_read_int1d - read 1d integer from netcdf file
1310  !
1311  ! !DESCRIPTION:
1312  ! Read 1d integer array from netcdf file
1313  !
1314  ! !REVISION HISTORY:
1315  ! 2007-Oct-26 - T. Craig - initial version
1316  !
1317  ! !INTERFACE: ------------------------------------------------------------------
1318 
1319  subroutine oasis_ioshr_read_int1d(filename,idata,dname)
1320 
1321  ! !INPUT/OUTPUT PARAMETERS:
1322  implicit none
1323  character(len=*),intent(in) :: filename ! file
1324  integer(in) ,intent(inout):: idata(:) ! integer data
1325  character(len=*),intent(in) :: dname ! name of data
1326 
1327  !EOP
1328 
1329  integer(in) :: rcode
1330  type(file_desc_t) :: pioid
1331  type(var_desc_t) :: varid
1332  logical :: exists
1333  character(CL) :: lversion
1334  character(CL) :: name1
1335  character(*),parameter :: subname = '(oasis_ioshr_read_int1d) '
1336  !-------------------------------------------------------------------------------
1337  !
1338  !-------------------------------------------------------------------------------
1339 
1340  if (pio_iam==0) inquire(file=trim(filename),exist=exists)
1341  call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_int1d exists')
1342  if (exists) then
1343  rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1344  ! write(nulprt,*) subname,' open file ',trim(filename)
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)
1348  else
1349  WRITE(nulprt,*) subname,estr,'file invalid ',trim(filename),' ',trim(dname)
1350  CALL oasis_abort()
1351  endif
1352 
1353  name1 = trim(dname)
1354  rcode = pio_inq_varid(pioid,trim(name1),varid)
1355  rcode = pio_get_var(pioid,varid,idata)
1356 
1357  call pio_closefile(pioid)
1358 
1359  ! write(nulprt,*) subname,' read int ',trim(dname)
1360 
1361 
1362  end subroutine oasis_ioshr_read_int1d
1363 
1364  !===============================================================================
1365  !BOP ===========================================================================
1366  !
1367  ! !IROUTINE: oasis_ioshr_read_r8 - read scalar double from netcdf file
1368  !
1369  ! !DESCRIPTION:
1370  ! Read scalar double from netcdf file
1371  !
1372  ! !REVISION HISTORY:
1373  ! 2007-Oct-26 - T. Craig - initial version
1374  !
1375  ! !INTERFACE: ------------------------------------------------------------------
1376 
1377  subroutine oasis_ioshr_read_r8(filename,rdata,dname)
1378 
1379  ! !INPUT/OUTPUT PARAMETERS:
1380  implicit none
1381  character(len=*),intent(in) :: filename ! file
1382  real(r8) ,intent(inout):: rdata ! real data
1383  character(len=*),intent(in) :: dname ! name of data
1384 
1385  !EOP
1386 
1387  real(r8) :: r1d(1)
1388  character(*),parameter :: subname = '(oasis_ioshr_read_r8) '
1389 
1390  !-------------------------------------------------------------------------------
1391  !
1392  !-------------------------------------------------------------------------------
1393 
1394  call oasis_ioshr_read_r81d(filename,r1d,dname)
1395  rdata = r1d(1)
1396 
1397  end subroutine oasis_ioshr_read_r8
1398 
1399  !===============================================================================
1400  !BOP ===========================================================================
1401  !
1402  ! !IROUTINE: oasis_ioshr_read_r81d - read 1d double array from netcdf file
1403  !
1404  ! !DESCRIPTION:
1405  ! Read 1d double array from netcdf file
1406  !
1407  ! !REVISION HISTORY:
1408  ! 2007-Oct-26 - T. Craig - initial version
1409  !
1410  ! !INTERFACE: ------------------------------------------------------------------
1411 
1412  subroutine oasis_ioshr_read_r81d(filename,rdata,dname)
1413 
1414  ! !INPUT/OUTPUT PARAMETERS:
1415  implicit none
1416  character(len=*),intent(in) :: filename ! file
1417  real(r8) ,intent(inout):: rdata(:) ! real data
1418  character(len=*),intent(in) :: dname ! name of data
1419 
1420  !EOP
1421 
1422  integer(in) :: rcode
1423  type(file_desc_t) :: pioid
1424  type(var_desc_t) :: varid
1425  logical :: exists
1426  character(CL) :: lversion
1427  character(CL) :: name1
1428  character(*),parameter :: subname = '(oasis_ioshr_read_r81d) '
1429 
1430  !-------------------------------------------------------------------------------
1431  !
1432  !-------------------------------------------------------------------------------
1433 
1434  if (pio_iam==0) inquire(file=trim(filename),exist=exists)
1435  call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_r81d exists')
1436  if (exists) then
1437  rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1438  ! write(nulprt,*) subname,' open file ',trim(filename)
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)
1442  else
1443  WRITE(nulprt,*) subname,estr,'file invalid ',trim(filename),' ',trim(dname)
1444  CALL oasis_abort()
1445  endif
1446 
1447  name1 = trim(dname)
1448  rcode = pio_inq_varid(pioid,trim(name1),varid)
1449  rcode = pio_get_var(pioid,varid,rdata)
1450 
1451  call pio_closefile(pioid)
1452 
1453  ! write(nulprt,*) subname,' read int ',trim(dname)
1454 
1455  end subroutine oasis_ioshr_read_r81d
1456 
1457  !===============================================================================
1458  !BOP ===========================================================================
1459  !
1460  ! !IROUTINE: oasis_ioshr_read_char - read char string from netcdf file
1461  !
1462  ! !DESCRIPTION:
1463  ! Read char string from netcdf file
1464  !
1465  ! !REVISION HISTORY:
1466  ! 2010-July-06 - T. Craig - initial version
1467  !
1468  ! !INTERFACE: ------------------------------------------------------------------
1469 
1470  subroutine oasis_ioshr_read_char(filename,rdata,dname)
1471 
1472  ! !INPUT/OUTPUT PARAMETERS:
1473  implicit none
1474  character(len=*),intent(in) :: filename ! file
1475  character(len=*),intent(inout):: rdata ! character data
1476  character(len=*),intent(in) :: dname ! name of data
1477 
1478  !EOP
1479 
1480  integer(in) :: rcode
1481  type(file_desc_t) :: pioid
1482  type(var_desc_t) :: varid
1483  logical :: exists
1484  character(CL) :: lversion
1485  character(CL) :: name1
1486  character(*),parameter :: subname = '(oasis_ioshr_read_char) '
1487 
1488  !-------------------------------------------------------------------------------
1489  !
1490  !-------------------------------------------------------------------------------
1491 
1492  if (pio_iam==0) inquire(file=trim(filename),exist=exists)
1493  call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_char exists')
1494  if (exists) then
1495  rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
1496  ! write(nulprt,*) subname,' open file ',trim(filename)
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)
1500  else
1501  WRITE(nulprt,*) subname,estr,'file invalid ',trim(filename),' ',trim(dname)
1502  CALL oasis_abort()
1503  endif
1504 
1505  name1 = trim(dname)
1506  rcode = pio_inq_varid(pioid,trim(name1),varid)
1507  rcode = pio_get_var(pioid,varid,charvar)
1508  rdata = trim(charvar)
1509 
1510  call pio_closefile(pioid)
1511 
1512  end subroutine oasis_ioshr_read_char
1513 
1514 #endif
1515  !===============================================================================
1516 !===============================================================================
1517 end module mod_oasis_ioshr
System type methods.
Provides a generic and simpler interface into MPI calls for OASIS.
Generic overloaded interface into MPI broadcast.
subroutine, public oasis_mpi_commsize(comm, size, string)
Get the total number of tasks associated with a communicator.
Provides a common location for several OASIS variables.
Defines kinds for OASIS.
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 string manipulation methods.
IO interfaces based on pio (not supported yet)
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.