!
      module get_hist
!
! Read tgcm histories and return fields.
!
      use hist
      use proc,only: lenhvol,nlat,nlon
      use input,only: zkmbot_mgcm, tbot_mgcm, mgcm_fspath,
     | vtgcm_fspath,sendcdf,ncid_out 
      use netcdf_module,only: nc_open,nc_close,nc_rdhist
      implicit none
!
      real,allocatable :: vtgcm_n2(:,:,:)
      integer,parameter :: venus_imxp3=nlon+3
      integer :: lu_vtgcm=0,lu_mgcm=0
      contains
!-----------------------------------------------------------------------
      subroutine gethist(h,vols,nvols,mxdiskvols,ivol,luin,
     +  mtime,tmpdir,iprint)
!
! Search for history mtime(3) on volumes vols(nvols). 
! If found, return history type h.
!
! Arguments:
! vols(nvols) = history volume mss paths
! mtime(3) = model time to search for
! tmpdir = temp dir on the disk for links, etc.
! ivol = index to vols for 1st file to search (see below)
!
      include 'netcdf.inc'
      type(history),intent(inout) :: h
      integer,intent(in) :: 
     +  nvols,		! number of history volumes
     +  mxdiskvols,	! max number of hist vols allowed on the disk
     +  iprint		! print flag
      integer,intent(inout) ::
     +  mtime(3),	! model time (day,hr,min)
     +  luin 		! logical unit number to use 
      character(len=*),intent(in) :: vols(nvols),tmpdir
!
! On input, ivol is index to vols, i.e., start search at file
!   vols(ivol). If lu is already open, continue search at current
!   position of lu (assume file attached to lu is vols(ivols), or
!   this could be checked).
! If ivol <= 0 on input, force new open of vols(ivol) w/ lu
!   (close before opening if necessary).
! On output, ivol is index to vols where current history was found.
!   If history is not found, return ivol=0.
!
      integer,intent(inout) :: ivol
!
! Locals:
      character(len=lenhvol),save :: dskfile=' '
      logical isopen,isvtgcm
      integer :: iv,ier,ieof,ios,i,j,len_summary,nt,lu,iv1,noutput,nj
      integer :: istat,itime,iprintnewvol
      integer,save :: ncid(100)=0
      real dummy,fmin,fmax
      character(len=80) :: cmd
      character(len=mxlen_summary*8) :: charsum
!
! Externals:
      character(len=lenhvol),external :: mkflnm
      integer,external :: ixfindc
!
! Initialize history structure:
      call inithist(h)
!
! History volume loop:
!
!     write(6,"('Enter gethist: ivol=',i3,' vols(ivol)=',a,
!    |  ' luin=',i3,' ncid(luin)=',i3)")
!    |  ivol,trim(vols(ivol)),luin,ncid(luin)
!
      iv1 = ivol
      lu = luin
      if (iv1 < 0) then	! force open of vol(abs(ivol))
        lu = 0
        ncid(luin) = 0
        iv1 = -iv1
      endif
      if (ncid(luin) > 0) then
        lu = 0
      endif
!
      if (iprint > 0)
     +  write(6,"(/15('-'),' Begin search for history ',3i4,15('-'))")
     +    mtime
      vols_loop: do iv = iv1,nvols
        iprintnewvol = iprint
        if (lu==0.and.ncid(luin)==0) then	! open new volume
          iprintnewvol = 1
!
! Get history file from mss (1st check in cwd and tmpdir), to 
! local disk file dskfile. Save a link as tmpdir/lnkfile.
! (getms returns: ier == -1 if error in input, 
!                 ier ==  1 if error from msread, 
!                 ier ==  0 if all ok). 
          call scrub_hvols(vols,nvols,mxdiskvols,tmpdir)
          dskfile = ' '
          write(6,"('gethist call getfile: iv=',i4,' vols(iv)=',a)")
     |      iv,vols(iv)
          call getfile(vols(iv),dskfile)
!
! Open netcdf history file:
!
          call nc_open(ncid(luin),dskfile,'OLD','READ')
          if (ncid(luin) > 0) then
            write(6,"('gethist: netcdf open succeeded -- will ',
     |        'read netcdf history file ',a)") trim(dskfile)
          endif ! ncid(luin) <= 0
        endif	! lu == 0
        h%histfile = vols(iv)
        if (ncid(luin) > 0) then
!
! 1/4/08: Use vols(iv) for both vols and dskfile in call to nc_rdhist 
!         to cover diffs case:
          call nc_rdhist(ncid(luin),vols(iv),vols(iv),mtime,itime,
     |      h,ier,iprintnewvol)
          if (ier <= 0) then
            ivol = iv
            lu = 0
          else
            call nc_close(ncid(luin))
            ncid(luin) = 0
            cycle vols_loop
          endif
!
! If this is an mtgcm history (netcdf), read mgcm zkmbot and tbot LBC from
! external file. This overwrites zkmbot read from netcdf history above
! (nc_rdhist), but tbot is not on the history (tbot is not used by the
! model), so just read both here.
!
          if (h%ismtgcm) then
            call getmgcm
            if (lu_mgcm==0) then
              write(6,"('>>> gethist: error return from getmgcm.')")
              stop 'getmgcm'
            endif
          endif
          return ! return if successful read of netcdf file
        endif ! ncid(luin) > 0
!
! End history volumes loop:
      enddo vols_loop
!
! History not found:
      write(6,"(/'>>> gethist: history ',i3,':',i2,':',i2,
     +  ' not found (',i4,' volumes were searched).'/)") mtime,nvols
      ivol = 0
      if (iprint > 0)
     +  write(6,"(/15('-'),' End search for history ',3i4,
     +    15('-'))") mtime
!
! Close netcdf output file, if one exists: 
      if (len_trim(sendcdf) > 0) then
        if (ncid_out > 0) then
          istat = nf_close(ncid_out)
          write(6,"('gethist: Closed netcdf file attached to ncid_out=',
     |      i4,' istat=',i4)") ncid_out,istat
        endif
      endif
      return
      end subroutine gethist
!-------------------------------------------------------------------
      subroutine mk3partmss(msspath,outname)
      character(len=*),intent(in) :: msspath
      character(len=8),intent(out) :: outname(3)
!
! Given full msspath, define "old style" 3-part file name
!
      integer :: i,ii,i3
      ii = 0
      i3 = 1
      outname = ' '
      charloop: do i=1,len_trim(msspath)
        if (msspath(i:i) /= '/') then
          ii = ii+1
          if (ii <= 8) outname(i3)(ii:ii) = msspath(i:i)
        else
!         write(6,"('i=',i2,' ii=',i2,' i3=',i2)") i,ii,i3
          if (ii < 8) outname(i3)(ii+1:8) = ' '
          ii = 0
          if (i /= 1) i3 = i3+1
          if (i3 > 3) exit charloop
        endif 
      enddo charloop
!     write(6,"('exit mk3partmss: msspath=',/a)") trim(msspath)
!     write(6,"('  outname = ',3(1x,a8))") outname
      end subroutine mk3partmss
!-------------------------------------------------------------------
      subroutine prhdr(noutput)
!
! Print summary of header to stdout (tgcmhdr typedef is in hist.f)
!
      integer,intent(in) :: noutput
      integer :: i,ii,n
      write(6,"(/20('-'),' TGCM HEADER SUMMARY ',20('-'))")
      write(6,"(' iter=',i10,/' nday,nhr,nmin=',i3,',',i2,',',i2)")
     +  hdr%iter,hdr%nday,hdr%nhr,hdr%nmin
!
      write(6,"(' label(1-8) = ')",advance='NO')
      do i=1,8
        write(6,"(a)",advance='NO') hdr%label(i)
      enddo
      write(6,"(' ')")
      write(6,"(' date=',2i4)") hdr%hdrdate
      write(6,"(' output = ')")
      n = 0
      do i=1,noutput
        if (len_trim(hdr%output(1,i)) > 0 .or.
     +      len_trim(hdr%output(2,i)) > 0 .or.
     +      len_trim(hdr%output(3,i)) > 0) then
          n = n+1
          write(6,"('''')",advance='NO')
          do ii=1,3
            if (len_trim(hdr%output(ii,i)) > 0) then
              if (ii < 3) then
                write(6,"(a,'/')",advance='NO') 
     +            hdr%output(ii,i)(1:len_trim(hdr%output(ii,i)))
              else
                write(6,"(a)",advance='NO') 
     +            hdr%output(ii,i)(1:len_trim(hdr%output(ii,i)))
              endif
            endif
          enddo
          write(6,"(''',')",advance='NO')
          if (mod(n,3) == 0) write(6,"(' ')")
        endif
      enddo
      write(6,"(' ')")
      write(6,"(' start = ',i3,',',i2,',',i2)") hdr%start
      write(6,"(' stp = ',i3,',',i2,',',i2,',  ',i3,',',i2,',',i2)") 
     +  hdr%stp
      write(6,"(' hist =',i3,',',i2,',',i2,',  ',i3,',',i2,',',i2)") 
     +  hdr%hdrhist
      write(6,"(' sav = ',i3,',',i2,',',i2)") hdr%sav
      write(6,"(' step = ',i4)") hdr%step
      write(6,"(' mag = ',4f8.2)") hdr%mag
      write(6,"(' difhor = ',i3)") hdr%difhor
      write(6,"(' iuivi = ',i3)") hdr%iuivi
      write(6,"(' sdtide = ',/(5e12.4))") hdr%sdtide
      write(6,"(' ipower,aurora,dispos = ',3i3)")
     +  hdr%ipower,hdr%aurora,hdr%dispos
      write(6,"(' dtide = ',2e12.4)") hdr%dtide
      write(6,"(' data = ',a8,' ',a8,' ',a8)") hdr%data
      write(6,"(' source = ',a8,' ',a8,' ',a8)") hdr%source
      write(6,"(' sourct = ',3i5)") hdr%sourct
      write(6,"(' rdate = ',a8)") hdr%rdate
      write(6,"(' naur = ',i4)") hdr%naur
      write(6,"(' hp = ',f8.2)") hdr%hp
      write(6,"(' cp = ',f8.2)") hdr%cp
      write(6,"(' byimf = ',f8.2)") hdr%byimf
      if (hdr%naur == 3) then
        write(6,"(' colfac = ',f8.2)") hdr%colfac
        write(6,"(' f107d = ',f8.2)") hdr%f107d
        write(6,"(' f107a = ',f8.2)") hdr%f107a
      endif
      write(6,"(18('-'),' END TGCM HEADER SUMMARY: ',18('-')/)")
      return
      end subroutine prhdr
!----------------------------------------------------------------
      subroutine getmgcm
!
! Read NASA AMES MGCM lower boundaries for mars tgcm.
! Open and read from file mgcm_fspath, connect to unit lu_mgcm.
! If error occurs, set lu_mgcm=0.
!
! Locals:
      integer :: j,iostat
!
! Externals:
      integer,external :: nextlu
!
! If mgcm_fspath is empty, assume coupled mtgcm/mgcm run
! (i.e., bottom boundaries are NOT read from disk file because
!  they were received directly from mgcm in mcplr coupler.
! In coupled run, set zkmbot_mgcm and tbot_mgcm to zero (history
!  values will be used).
!
      if (len_trim(mgcm_fspath)==0) then
!       write(6,"('>>> getmgcm: file path mgcm_fspath is empty.')")
!       lu_mgcm = 0
        write(6,"(/,'getmgcm: file path mgcm_fspath is empty.')")
        write(6,"('  Assuming coupled mtgcm/mgcm run.')")
        write(6,"('  Will use bottom boundary T and Z from the',
     |    ' history.')")
        zkmbot_mgcm(:) = 0. 
        tbot_mgcm(:) = 0.
        lu_mgcm = -1 ! caller assumes error only if lu_mgcm==0
        return
      endif
!
! If lu_mgcm == 0, define lu_mgcm and open the file.
! If lu_mgcm > 0, then assume file has been opened, and read next
!   latitude set. If next set does not exist, EOF will be read. This
!   is considered non-fatal (i.e., will use previously read boundaries).
! If non-eof (fatal) error occurs, set lu_mgcm zero to flag tgcmtype 
!   to stop.
!
! If lu_mgcm > 0, then assume file was opened by previous iteration:
      if (lu_mgcm > 0) then		! unit already connected
        read(lu_mgcm,"(1x,2f10.2)",iostat=iostat)
     +    (zkmbot_mgcm(j),tbot_mgcm(j),j=1,nlat)
        if (iostat < 0) then		! EOF or EOR (non-fatal)
!         write(6,"('NOTE getmgcm: EOF encountered reading ',
!    +      'mgcm lower boundaries from file ',a,' unit=',i2,
!    +      ' (file was already open)')") trim(mgcm_fspath),lu_mgcm
        elseif (iostat > 0) then	! other error in read
          write(6,"('>>> getmgcm: error reading ',
     +      'mgcm lower boundaries from file ',a,' unit=',i2,
     +      ' (file was already open)')")
     +      trim(mgcm_fspath),lu_mgcm
          close(lu_mgcm)
          lu_mgcm = 0
        else				! iostat==0 -> successful read
          write(6,"('getmgcm: successful read of mgcm lower ',
     +      'boundaries (file was already open).')")
          return
        endif
!
! If lu_mgcm == 0, then open file and make 1st read:
      else
        lu_mgcm = nextlu()
        if (lu_mgcm == 0) then
          write(6,"('>>> getmgcm: error return from nextlu.')")
          return 
        endif
        open(unit=lu_mgcm,file=trim(mgcm_fspath),form='FORMATTED',
     |    iostat=iostat)
        if (iostat /= 0) then	! error (iostat never < 0)
          write(6,"('>>> getmgcm: error opening file ',a)")
     +      trim(mgcm_fspath)
          lu_mgcm = 0
          return
        else
          write(6,"('getmgcm: opened file ',a,' unit=',i2)")
     +      trim(mgcm_fspath),lu_mgcm
        endif
        read(lu_mgcm,"(1x,2f10.2)",iostat=iostat)
     +    (zkmbot_mgcm(j),tbot_mgcm(j),j=1,nlat)
        if (iostat < 0) then		! EOF or EOR (non-fatal)
          write(6,"('NOTE getmgcm: EOF encountered reading ',
     +      'mgcm lower boundaries from file ',a,' unit=',i2,
     +      ' (first read from file)')") trim(mgcm_fspath),lu_mgcm
        elseif (iostat > 0) then	! other error in read
          write(6,"('>>> getmgcm: error reading ',
     +      'mgcm lower boundaries from file ',a,' unit=',i2,
     +      ' (first read from file)')")
     +      trim(mgcm_fspath),lu_mgcm
          close(lu_mgcm)
          lu_mgcm = 0
        else				! iostat==0 -> successful read
          write(6,"('getmgcm: successful read of mgcm lower ',
     +      'boundaries (first read from file).')")
          write(6,"('zkmbot_mgcm=',/,(6e12.4))") zkmbot_mgcm
          write(6,"('tbot_mgcm=',/,(6e12.4))") tbot_mgcm
          return
        endif
      endif
      end subroutine getmgcm
!----------------------------------------------------------------
      subroutine getvtgcm(imx,kmx,jmxh)
!
! Read N2 from external file for vtgcm.
!
! Args:
      integer,intent(in) :: imx,kmx,jmxh
!
! Locals:
      integer :: i,k,j,iostat
      logical :: exists
!
! Externals:
      integer,external :: nextlu
!
! This is a one-time read per run. If lu_vtgcm is > 0, assume
! file has already been read and return:
      if (lu_vtgcm > 0) return
!
! Check file path var:
      if (len_trim(vtgcm_fspath)==0) then
        write(6,"('>>> getvtgcm: file path vtgcm_fspath',
     +    ' is empty.')")
        lu_vtgcm = 0
        return
      endif
!
! If lu_vtgcm == 0, then open file and make 1st read:
      inquire(file=trim(vtgcm_fspath),exist=exists)
      if (.not.exists) then
        write(6,"('>>> getvtgcm: cannot find file ',a)") 
     +    trim(vtgcm_fspath)
        lu_vtgcm = 0
        return
      endif
      lu_vtgcm = nextlu()
      if (lu_vtgcm == 0) then
        write(6,"('>>> getvtgcm: error return from nextlu.')")
        return 
      endif
      open(unit=lu_vtgcm,file=trim(vtgcm_fspath),iostat=iostat)
      if (iostat /= 0) then	! error (iostat never < 0)
        write(6,"('>>> getvtgcm: error opening file ',a)")
     +  trim(vtgcm_fspath)
        lu_vtgcm = 0
        return
      else
        write(6,"('getvtgcm: opened file ',a,' unit=',i2)")
     +    trim(vtgcm_fspath),lu_vtgcm
      endif
!
! Read n2:
      do i=1,imx
        do k=1,kmx
          read(lu_vtgcm,"(1x,9e11.3)",iostat=iostat,err=900)
     +      (vtgcm_n2(i,k,j),j=1,jmxh/2)  
          read(lu_vtgcm,"(1x,9e11.3)",iostat=iostat,err=901) 
     +      (vtgcm_n2(i,k,j),j=jmxh/2+1,jmxh)
        enddo
      enddo
      write(6,"('getvtgcm: successful read of n2 from file ',
     +  a)") trim(vtgcm_fspath)
      close(lu_vtgcm)
!
! Mirror across equator:
! 10/25/06 btf: this routine is called for "old" vtgcm histories
!   only, so need to mirror n2 that was read from external file:
!
      do j=1,jmxh
        vtgcm_n2(:,:,j+jmxh) = vtgcm_n2(:,:,j)
      enddo
      do j=1,jmxh
        vtgcm_n2(:,:,jmxh-j+1) = vtgcm_n2(:,:,j+jmxh)
      enddo
      return
!
! i/o error traps:
 900  continue
      if (iostat < 0) then
        write(6,"('>>> getvtgcm: EOF encountered reading ',
     +    'vtgcm_n2: i=',i2,' k=',i2,' (1st half of jmxh) ',
     +    'iostat=',i5,' lu_vtgcm=',i2)") i,k,iostat,lu_vtgcm
      else
        write(6,"('>>> getvtgcm: error reading vtgcm_n2: i=',i2,
     +    ' k=',i2,' (1st half of jmxh) iostat=',i5,' lu_vtgcm=',i2)") 
     +    i,k,iostat,lu_vtgcm
      endif
      lu_vtgcm = 0
      return
 901  continue
      if (iostat < 0) then
        write(6,"('>>> getvtgcm: EOF encountered reading ',
     +    'vtgcm_n2: i=',i2,' k=',i2,' (2nd half of jmxh) ',
     +    'iostat=',i5,' lu_vtgcm=',i2)") i,k,iostat,lu_vtgcm
      else
        write(6,"('>>> getvtgcm: error reading vtgcm_n2: i=',i2,
     +    ' k=',i2,' (2nd half of jmxh) iostat=',i5,' lu_vtgcm=',i2)") 
     +    i,k,iostat,lu_vtgcm
      endif
      lu_vtgcm = 0
      return
      end subroutine getvtgcm
      end module get_hist