source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/lib/psmile/src/mod_oasis_ioshr.F90 @ 6331

Last change on this file since 6331 was 6331, checked in by aclsce, 17 months ago

Moved oasis-mct_5.0 in oasis3-mct/branches directory.
File size: 50.9 KB
Line 
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
18module mod_oasis_ioshr
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
28  use mod_oasis_string, only: oasis_string_toupper
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!=================================================================================
106contains
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
303subroutine 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
321end 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
336subroutine 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(file=__FILE__,line=__LINE__)
399    else
400       ! filename is already open, just return
401    endif
402
403end 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
418subroutine 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(file=__FILE__,line=__LINE__)
443    endif
444
445    wfilename = ''
446
447end subroutine oasis_ioshr_close
448
449!===============================================================================
450
451subroutine 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)
458end subroutine oasis_ioshr_redef
459
460!===============================================================================
461
462subroutine 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)
469end subroutine oasis_ioshr_enddef
470
471!===============================================================================
472
473character(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(file=__FILE__,line=__LINE__)
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
49980 format(i4.4,'-',i2.2,'-',i2.2)
500
501end function oasis_ioshr_date2yyyymmdd
502
503!===============================================================================
504
505character(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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
538   end if
539
540   write(oasis_ioshr_sec2hms,80) hours, minutes, secs
54180 format(i2.2,':',i2.2,':',i2.2)
542
543end 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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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
1075subroutine 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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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(file=__FILE__,line=__LINE__)
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!===============================================================================
1517end module mod_oasis_ioshr
Note: See TracBrowser for help on using the repository browser.