!
! extracted from ASPEN v1.4 nchist_mod.for, July 2003
!
      module netcdf_module
      implicit none
      
!
! Module to create, read and write netcdf history files:
!
!      include "/opt/local/include/netcdf.inc"
      include "netcdf.inc"
!
      integer,private ::
     |  id_time,                   ! dimension id for time (unlimited)
     |  id_mtime,                  ! dimension id for model time (3)
     |  id_lon,id_lat,id_lev,      ! dimension ids for 3d model grid
     |  id_mlon,id_mlat,id_mlev,   ! dimension ids for 3d magnetic grid
     |  id_latlon,                 ! dimension id for coords (2)
     |  id_dtide,                  ! dimension id for dtide (2)
     |  id_sdtide,                 ! dimension id for sdtide (10)
     |  id_fake,                   ! fake dimension id (1)
     |  ids1(1),ids2(2),ids4(4),	! vectors of dim id's
! These next 4 should probably be made local
     |  start_2d(2),count_2d(2),	! start loc and count for 2d vars
     |  start_4d(4),count_4d(4),	! start loc and count for 4d vars
!
! Variable id's (idv_xxxx). Note lon, lat, lev, and time are
!   coordinate variables (lon(lon), lat(lat), lev(lev), time(time)).
! Variables starting at mtime are "primary" variables.
! idv_fprog(nfprog) are id's for prognostic fields.
!
     |  idv_time,idv_mtime,idv_ut,      ! variable id's
     |  idv_lon,idv_lat,idv_lev,
     |  idv_mlon,idv_mlat,idv_mlev,
     |  idv_step,idv_iter,idv_year,idv_day,idv_p0,
     |  idv_hpower,idv_ctpoten,idv_byimf,idv_colfac,idv_ncep,
     |  idv_gpi,idv_f107d,idv_f107a,idv_mag,idv_dtide,idv_sdtide,
     |  idv_nflds,idv_alfa30,idv_e30,idv_ed2,
     |  idv_alfad2
      integer,allocatable :: idv_sech(:)
!
      contains
!-----------------------------------------------------------------------
      subroutine nc_open(ncid,flnm,status,rdwr)
!
! Open or create a netcdf dataset flnm, returning netcdf file
!   id handle in ncid.
! If status=='NEW' or 'REPLACE', a new netcdf file is created,
!   otherwise (status=='OLD'), open existing dataset).
! If an existing file is opened and rdwr=='READ', the dataset is
!   opened read-only (NF_NOWRITE), otherwise (rdwr=='WRITE' or
!   'APPEND') the dataset is opened read/write (NF_WRITE).
! If the open fails, print error msg and return ncid == 0.
!
! Args:
      integer,intent(out) :: ncid    ! netcdf file id
      character(len=*),intent(in) :: flnm,status,rdwr
!
! Local:
      integer :: istat
      character(len=120) :: char120
!
      ncid = 0
      if (status=='NEW'.or.status=='REPLACE') then
!
! Create new dataset (clobber old one if it pre-exists):
!
        istat = nf_create(flnm,NF_CLOBBER,ncid)
        if (istat /= NF_NOERR) then
          write(char120,"('Error return from nf_create for netcdf ',
     |      'file ',a,' status=',a)") trim(flnm),status
          call handle_ncerr(istat,char120)
          ncid = 0
        else
          write(6,"('Created netcdf file ',a,' ncid=',i8)")
     |      trim(flnm),ncid
        endif
!
! Open pre-existing dataset:
! NF_WRITE opens with read-write, where write means append, change, etc
! NF_NOWRITE is read-only.
!
      elseif (status=='OLD') then
        if (rdwr=='WRITE'.or.rdwr=='APPEND') then
          istat = nf_open(flnm,NF_WRITE,ncid)
        elseif (rdwr=='READ') then
          istat = nf_open(flnm,NF_NOWRITE,ncid)
          write(*,*) "nf_open istat=",istat,ncid
        else
          write(6,"('>>> nc_open: unrecognized rdwr=',a)") trim(rdwr)
          write(6,"('  Will open NF_WRITE (read/write).')")
          istat = nf_open(flnm,NF_WRITE,ncid)
        endif
        if (istat /= NF_NOERR) then
          write(char120,"('Error return from nf_open for netcdf ',
     |      'file ',a,' status=',a)") trim(flnm),status
          call handle_ncerr(istat,char120)
          ncid = 0
        else
!         write(6,"('Opened existing netcdf file ',a,' ncid=',i8)")
!    |      trim(flnm),ncid
        endif
!
! Unknown status request:
      else
        write(6,"(/,'>>> nc_open: unrecognized status = ',a)")
     |    status
        ncid = 0
      endif
      end subroutine nc_open
!-------------------------------------------------------------------
      subroutine nc_close(ncid)
!
! Close a netcdf dataset file:
!
! Arg:
      integer,intent(in) :: ncid
!
! Local:
      integer :: istat
!
      istat = nf_close(ncid)
      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |  'Error return from nf_close')
      end subroutine nc_close
!-----------------------------------------------------------------------
      subroutine defvar_time_dbl(ncid,name,idtime,idvar,
     |  longname,units)

!     call defvar_time_dbl(ncid,"ut",ids1,idv_ut,
!    |  "universal time (from model time hour and minute)",
!    |  "hours")
!
! Define time-dependent variable "name" on open netcdf file ncid.
! Variable has a single dimension in time (e.g., ut(time)).
! Also define long_name and units attributes.
!
! Args:
      integer,intent(in)  :: ncid,idtime(1)
      integer,intent(out) :: idvar
      character(len=*),intent(in) :: name,longname,units
!
! Local:
      integer :: istat
      character(len=80) :: char80
!
! Define the variable:
      istat = nf_def_var(ncid,name,NF_DOUBLE,1,idtime,idvar)
      if (istat /= NF_NOERR) then
        write(char80,"('Error defining double variable ',a)") name
        call handle_ncerr(istat,trim(char80))
      endif
!
! Give long name attribute:
      if (len_trim(longname) > 0) then
        istat = nf_put_att_text(ncid,idvar,"long_name",
     |    len_trim(longname),longname)
        if (istat /= NF_NOERR) then
          write(char80,"('Error defining long_name of double variable ',
     |      a)") name
          call handle_ncerr(istat,trim(char80))
        endif
      endif
!
! Give units attribute:
      if (len_trim(units) > 0) then
        istat = nf_put_att_text(ncid,idvar,"units",len_trim(units),
     |    units)
        if (istat /= NF_NOERR) then
          write(char80,"('Error defining units of variable ',a)") name
          call handle_ncerr(istat,trim(char80))
        endif
      endif
      end subroutine defvar_time_dbl
!-------------------------------------------------------------------
      subroutine handle_ncerr(istat,msg)
!
! Handle a netcdf lib error:
!
      integer,intent(in) :: istat
      character(len=*),intent(in) :: msg
!
      write(6,"(/72('-'))")
      write(6,"('>>> Error from netcdf library:')")
      write(6,"(a)") trim(msg)
      write(6,"('istat=',i5)") istat
      write(6,"(a)") nf_strerror(istat)
      write(6,"(72('-')/)")
      return
      end subroutine handle_ncerr
!-------------------------------------------------------------------
!
! Remaining functions are netcdf wrappers for 32-bit vs 64-bit platforms.
!
!-------------------------------------------------------------------
      integer function nc_put_att_real(ncid,varid,name,len,vals)
!
! Args:
      integer,intent(in) :: ncid,varid,len
      character(len=*),intent(in) :: name
      real,intent(in) :: vals(len)
!
! Local:
      integer :: istat
!




      istat = nf_put_att_double(ncid,varid,name,NF_DOUBLE,
     |  len,vals)

      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |  'nc_put_att_real: error from nf_put_att_real/double')
      nc_put_att_real = istat
      end function nc_put_att_real
!-------------------------------------------------------------------
      integer function nc_put_var_real(ncid,idvar,vals)
!
! Args:
      integer,intent(in) :: ncid,idvar
      real,intent(in) :: vals(*)
!
! Local:
      integer :: istat
!



      istat = nf_put_var_double(ncid,idvar,vals)

      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |  'nc_put_var_real: error from nf_put_var_real/double')
      nc_put_var_real = istat
      end function nc_put_var_real
!-------------------------------------------------------------------
      integer function nc_get_var_real(ncid,idvar,vals)
!
! Args:
      integer,intent(in) :: ncid,idvar
      real,intent(out) :: vals(*)
!
! Local:
      integer :: istat
!



      istat = nf_get_var_double(ncid,idvar,vals)

      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |  'nc_get_var_real: error from nf_get_var_real/double')
      nc_get_var_real = istat
      end function nc_get_var_real
!-------------------------------------------------------------------
      integer function nc_get_var1_real(ncid,idvar,index,val)
!
! Args:
      integer,intent(in) :: ncid,idvar,index
      real,intent(out) :: val
!
! Local:
      integer :: istat
!



      istat = nf_get_var1_double(ncid,idvar,index,val)

      if (istat /= NF_NOERR) call handle_ncerr(istat,
     |  'nc_get_var1_real: error from nf_get_var1_real/double')
      nc_get_var1_real = istat
      end function nc_get_var1_real
!-------------------------------------------------------------------
      integer function nc_put_var1_real(ncid,idvar,index,val,name)
!
! Args:
      integer,intent(in) :: ncid,idvar,index
      real,intent(in) :: val
      character(len=*),intent(in) :: name
!
! Local:
      integer :: istat
      character(len=80) :: msg
!



      istat = nf_put_var1_double(ncid,idvar,index,val)

      if (istat /= NF_NOERR) then
        write(msg,"('nc_put_var1_real: error from nf_put_var1_real',
     |    '/double for variable ',a)") trim(name)
        call handle_ncerr(istat,msg)
      endif
      nc_put_var1_real = istat
      end function nc_put_var1_real
      end module netcdf_module
