module deptrk_io_track
  use iso_c_binding, only: fp => c_double
  use netcdf
  use nbi_com, only : nonlin,workpath,runid

  implicit none
  private :: fp
  character*150 fname !netcdf file name for track data
  integer,save :: icdf
  logical,save :: lf_open=.false.
  
  interface deptrk_io
     module procedure deptrk_read_1d,deptrk_read_2d,deptrk_read_int_1d,deptrk_read_int_2d,&
          & deptrk_write_1d,deptrk_write_2d,deptrk_io_close
  end interface
  
contains
  subroutine deptrk_read_1d(cvar,zcnvrt,fval,istart,ierr)
    integer :: ierr
    character*(*) :: cvar
    real(fp),dimension(:) :: fval
    real(fp),intent(in) :: zcnvrt
    integer, dimension(1),intent(in) :: istart
    integer, dimension(1) :: icount
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_nowrite,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_read_1d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    
    icount(1)=size(fval,dim=1)
    call check( nf90_get_var(icdf,i_dim,fval,start=istart,count=icount),cvar)
    fval=fval*zcnvrt
    
  end subroutine deptrk_read_1d
  
  subroutine deptrk_read_2d(cvar,zcnvrt,fval,istart,ierr)
    character*(*) :: cvar
    integer :: ierr
    real*8,intent(in) :: zcnvrt
    real*8,dimension(:,:) :: fval
    integer, dimension(2),intent(in) :: istart
    integer, dimension(2) :: icount
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_nowrite,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_read_2d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    icount(1)=size(fval,dim=1)
    icount(2)=size(fval,dim=2)
    call check( nf90_get_var(icdf,i_dim,fval,start=istart,count=icount),cvar)
    fval(:,:)=fval(:,:)*zcnvrt
    
  end subroutine deptrk_read_2d
  
  subroutine deptrk_read_int_1d(cvar,zcnvrt,fval,istart,ierr)
    character*(*) :: cvar
    integer :: ierr
    integer,dimension(:) :: fval
    real(fp),intent(in) :: zcnvrt
    integer, dimension(1),intent(in) :: istart
    integer, dimension(1) :: icount
    real(fp),dimension(:), allocatable :: tmp
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_nowrite,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_read_1d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    
    icount(1)=size(fval,dim=1)
    if(allocated(tmp)) deallocate(tmp)
    allocate(tmp(icount(1)))
    
    call check( nf90_get_var(icdf,i_dim,tmp,start=istart,count=icount),cvar)
    fval=tmp*zcnvrt +0.5_fp
    deallocate(tmp)
  end subroutine deptrk_read_int_1d
  
  subroutine deptrk_read_int_2d(cvar,zcnvrt,fval,istart,ierr)
    character*(*) :: cvar
    integer :: ierr
    integer,dimension(:,:) :: fval
    real(fp),intent(in) :: zcnvrt
    integer, dimension(2),intent(in) :: istart
    integer, dimension(2) :: icount
    real(fp),dimension(:,:), allocatable :: tmp
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_nowrite,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_read_1d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    
    icount(1)=size(fval,dim=1)
    icount(2)=size(fval,dim=2)
    if(allocated(tmp)) deallocate(tmp)
    allocate(tmp(icount(1),icount(2)))
    call check( nf90_get_var(icdf,i_dim,tmp,start=istart,count=icount),cvar)
    fval=tmp*zcnvrt +0.5_fp
    deallocate(tmp)
    
  end subroutine deptrk_read_int_2d

  subroutine deptrk_write_1d(cvar,fval,ierr)
    character*(*) :: cvar
    integer :: ierr
    real(fp),dimension(:) :: fval
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_write,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_write_1d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    call check( nf90_put_var(icdf,i_dim,fval),cvar)
    
  end subroutine deptrk_write_1d

  subroutine deptrk_write_2d(cvar,fval,ierr)
    character*(*) :: cvar
    integer :: ierr
    real(fp),dimension(:,:) :: fval
    integer :: i_dim !id
    ierr=0
    if(.not.lf_open) then
       fname = trim(workpath)//trim(runid)//'_dpt.cdf'
       ierr = nf90_open(trim(fname),nf90_write,icdf)
       if(ierr.ne.0) then
          write(nonlin,*) ' ?deptrk_read error: cannot open file: '//trim(fname)
          call bad_exit(ierr)
       endif
       lf_open=.true. !file opened
    endif
    call ulower(cvar)
    call check_inq(trim(cvar),i_dim,ierr)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_write_2d error: invalid var.: '//trim(cvar)
       call bad_exit(ierr)
    endif
    call check( nf90_put_var(icdf,i_dim,fval),cvar)
    
  end subroutine deptrk_write_2d
  
  subroutine deptrk_io_close(fname_closed)
   character*150,intent(out) :: fname_closed !netcdf file name for track data
   integer :: ierr
    ierr=0
    if(lf_open)   ierr = nf90_close( icdf)
    if(ierr.ne.0) then
       write(nonlin,*) ' ?deptrk_read_close: close failure: "'//trim(fname)//'"'
        call bad_exit(ierr)
     endif
     lf_open=.false.
     fname_closed = fname
     
   end subroutine deptrk_io_close

  subroutine check(status,varnam)
    integer, intent ( in) :: status 
    character*(*),intent(in) :: varnam ! dimension name input 
 
    if(status /= nf90_noerr) then 
       write(nonlin,*) ' ?deptrk_io error:'& 
      &// trim(nf90_strerror(status))//' for var.= '//trim(varnam) 
       call bad_exit(status) 
    end if 
  end subroutine check 

  subroutine check_inq(varnam,id,ierrcdf)
    integer,intent(out) :: id,ierrcdf
    character*(*),intent(in) :: varnam 
    ierrcdf = nf90_inq_varid(icdf,trim(varnam),id) 
    if(ierrcdf.ne.0) then 
       write(nonlin,*) ' ?deptrk_io: id not found for var.'//trim(varnam)
       ierrcdf=1 
    endif 
  end subroutine check_inq 
 
end module deptrk_io_track
