#include "dims.h"
!
      subroutine outhist(istep,modeltime)
!
! Determine if its time to write a history, and if so call
! output_hist and/or output_sechist to write primary and/or
! secondary histories as required. This routine is called at 
! every time step from advance (or from tstwrhist).
!
! This routine is called only from master task or thread
! (i.e., may not be thread safe because of call to wrhist,
!  which updates iseries_prim and iseries_sech global module
!  data) 
!
      use hist_module,only: iseries_prim,iseries_sech
      implicit none
!
! Args:
      integer,intent(in) :: istep,modeltime(4)
!
! Local:
      logical :: time2write,
     |  wrprim,  save_prim, newseries_prim,
     |  wrsech,  save_sech, newseries_sech
!
! External:
      logical,external :: wrhist
!
! Determine if it is time to write a history:
! (istep and modeltime are input, remaining 6 args are output)
! Function wrhist updates iseries_prim and iseries_sech.
! This is safe if this routine is called only from master
! thread or task.
!
      time2write = wrhist(istep,modeltime,
     |  wrprim, save_prim, newseries_prim, iseries_prim,
     |  wrsech, save_sech, newseries_sech, iseries_sech)
!
! Write primary history:
      if (wrprim) then
!       write(6,"('outhist: istep=',i4,' mtime=',4i3,
!    |  ' wrprim=',l1,' save_prim=',l1,' newseries_prim=',l1)")
!    |  istep,modeltime,wrprim,save_prim,newseries_prim
        call output_hist(save_prim,newseries_prim)
      endif
!
! Write secondary history:
      if (wrsech) then
!       write(6,"('outhist: istep=',i4,' mtime=',4i3,
!    |  ' wrsech=',l1,' save_sech=',l1,' newseries_sech=',l1)")
!    |  istep,modeltime,wrsech,save_sech,newseries_sech
        call output_sechist(save_sech,newseries_sech)
      endif
      end subroutine outhist
!-----------------------------------------------------------------------
      subroutine output_hist(svfile,newseries)
!
! Write a primary history to current output disk file. 
! If svfile==T, save the file *after* writing the history.
! If newseries==T, open new file *before* writing the history
!   (and save existing file before opening the new one)
!
      use input_module,only:  ! input_mod.f
     |  output,      ! output file paths provided by input
     |  tempdir,     ! temporary scratch directory for saving
     |  dispose,     ! 0/1 for do/donot save file to ncar mss
     |  mxhist_prim  ! max number of histories on a primary file
      use hist_module,only:   ! hist_mod.f
     |  iprint,      ! print flag (read only)
     |  ioutfile,    ! index to current output file (read/write)
     |  ncid,        ! netcdf file pointer (read/write)
     |  nhist,       ! number of histories on current file (read/write)
     |  modeltime,   ! current model time (read only)
     |  nhist_total, ! total primary histories to be written (read only)
     |  nsource,     ! 0/1 number of source files provided (read only)
     |  iseries_prim ! current primary time series (read only)
      use netcdf_module,only: ! nchist_mod.F
     |  nc_open,     ! subroutine to open a netcdf file
     |  nc_define,   ! subroutine to define vars in a new netcdf file
     |  nc_wrhist    ! subroutine to write history to an open netcdf file
      implicit none
!
! Args:
      logical,intent(in) :: 
     |  newseries, ! if true, open new file before writing history
     |  svfile     ! if true, save current output file after writing history
!
! Local:
      character(len=80) :: diskfile 
      integer :: iprinthist
      integer,save :: ihist_total=0
      logical :: fullfile
!
! Init:
      diskfile = ' '
      if (iprint > 0) write(6,"(/,72('-'),/,'Primary History Output:',
     |  ' model time (day,hour,min) = ',3i4)") modeltime
      if (ihist_total == 0) then
        iprinthist = 1
      else
        iprinthist = iprint
      endif
      if (ihist_total==0) then       ! first history of a run
        ioutfile = 0                 ! first history goes on new file
        if (nsource==0) ioutfile = 1 ! first history on first output file
      endif
      fullfile = .false.
      if (nhist==mxhist_prim) fullfile = .true.
!
! Open new file if starting a new time series, or file was filled
! at last write:
      if (newseries.or.fullfile) then
        ioutfile = ioutfile+1
        nhist = 0             ! number of histories on current file
        if (newseries) write(6,"(/,'Starting primary history',
     |    ' time series ',i2,' at model time ',4i4)") iseries_prim,
     |    modeltime
        call mkdiskflnm(output(ioutfile),diskfile)
        call nc_open(ncid,diskfile,'REPLACE','WRITE')
      endif ! newseries
!
! Define current history structure:
      nhist = nhist+1 ! increment number of histories on current file
      call define_hist('primary')
      if (newseries.or.fullfile) 
     |  call nc_define(ncid)  ! define new file
!
! Write the history:
      call nc_wrhist(ncid,iprinthist)  ! write the history
      ihist_total = ihist_total+1
!
! Report to stdout:
      call mkdiskflnm(output(ioutfile),diskfile)
      write(6,"('Wrote primary   history ',i3,',',i2,',',i2,
     |  ' to ',a,' (',i3,' of ',i3,')')") modeltime(1:3),
     |  trim(diskfile),ihist_total,nhist_total
!
! Save file if necessary:
      if (svfile.or.nhist==mxhist_prim) 
     |  call savefile(ncid,diskfile,output(ioutfile),tempdir,
     |    dispose,.true.,iprint)
      end subroutine output_hist
!-----------------------------------------------------------------------
      subroutine output_sechist(svfile,newseries)
!
! Write a secondary history to current output disk file. 
! If svfile==T, save the file *after* writing the history.
! If newseries==T, open new file *before* writing the history
!   (and save existing file before opening the new one)
!
      use input_module,only:  ! input_mod.f
     |  secout,      ! output file paths provided by input
     |  tempdir,     ! temporary scratch directory for saving
     |  dispose,     ! 0/1 for do/donot save file to ncar mss
     |  mxhist_sech  ! max number of histories on a primary file
      use hist_module,only:   ! hist_mod.f
     |  iprint,      ! print flag (read only)
     |  isecout,     ! index to current output file (read/write)
     |  ncidsech,    ! netcdf file pointer (read/write)
     |  nsech,       ! number of histories on current file (read/write)
     |  modeltime,   ! current model time (read only)
     |  nsech_total, ! total sech histories to be written (read only)
     |  iseries_sech ! current secondary time series (read only)
      use netcdf_module,only: ! nchist_mod.F
     |  nc_open,     ! subroutine to open a netcdf file
     |  nc_define,   ! subroutine to define vars in a new netcdf file
     |  nc_wrhist    ! subroutine to write history to an open netcdf file
      implicit none
!
! Args:
      logical,intent(in) :: 
     |  newseries, ! if true, open new file before writing history
     |  svfile     ! if true, save current output file after writing history
!
! Local:
      character(len=80) :: diskfile 
      integer :: iprinthist
      integer,save :: ihist_total=0
      logical :: fullfile
!
! Init:
      diskfile = ' '
      if (iprint > 0) write(6,"(/,72('-'),/,'Secondary History Output:',
     |  ' model time (day,hour,min) = ',3i4)") modeltime
      if (ihist_total == 0) then
        iprinthist = 1
      else
        iprinthist = iprint
      endif
      if (ihist_total==0) isecout = 0 ! first history of a run
      fullfile = .false.
      if (nsech==mxhist_sech) fullfile = .true.
!
! Open new file if starting a new time series, or file was filled
! at last write:
      if (newseries.or.fullfile) then
        isecout = isecout+1
        nsech = 0             ! number of histories on current file
        if (newseries) write(6,"(/,'Starting secondary history',
     |    ' time series ',i2,' at model time ',4i4)") iseries_sech,
     |    modeltime
        call mkdiskflnm(secout(isecout),diskfile)
        call nc_open(ncidsech,diskfile,'REPLACE','WRITE')
      endif ! newseries
!
! Define current history structure:
      nsech = nsech+1 ! increment number of histories on current file
      call define_hist('secondary')
      if (newseries.or.fullfile) 
     |  call nc_define(ncidsech)  ! define new file
!
! Write the history:
      call nc_wrhist(ncidsech,iprinthist)  ! write the history
      ihist_total = ihist_total+1
!
! Report to stdout:
      call mkdiskflnm(secout(isecout),diskfile)
      write(6,"('Wrote secondary history ',i3,',',i2,',',i2,
     |  ' to ',a,' (',i3,' of ',i3,')')") modeltime(1:3),
     |  trim(diskfile),ihist_total,nsech_total
!
! Save file if necessary:
      if (svfile.or.nsech==mxhist_sech) 
     |  call savefile(ncidsech,diskfile,secout(isecout),tempdir,
     |    dispose,.true.,iprint)
      end subroutine output_sechist
!-----------------------------------------------------------------------
      subroutine savefile(ncid,diskfile,outpath,tempdir,idispose,
     |  reopen,iprint)
      use input_module,only: msreten
      use netcdf_module,only: nc_open,nc_close,nc_fileinfo
!
! Save file diskfile to tempdir and/or mss.
!
      implicit none
!
! Args:
      integer,intent(in) :: idispose,iprint
      logical,intent(in) :: reopen
      integer,intent(inout) :: ncid
      character(len=*),intent(in) :: diskfile,outpath,tempdir
!
! Local:
      integer :: istat,ier,msasync
      character(len=80) :: fileinfo
!
! External:
      integer,external :: ilink,iunlink
!
! Make fileinfo string for mss comment field and add as a
! global file attribute:
!
!     write(6,"('savefile calling nc_fileinfo for diskfile=',a)")
!    |  trim(diskfile)
      call nc_fileinfo(ncid,fileinfo)
!     write(6,"('History file info: ',a)") trim(fileinfo)
!
! Close file:
      call nc_close(ncid)
!
! Dispose to mss only if dispose flag is set, otherwise 
! save link on tempdir.
!     subroutine putms(mspath,dskfile,tmpdir,lnkfile,wrpass,msscomment,
!                      msasync)
!
      if (idispose==1) then
        msasync = 1 ! suspicious crash (nf_create) on Cray when msasync==1
!       msasync = 0 
        call putms(outpath,diskfile,tempdir,' ','NCARTGCM',fileinfo,
     |    msreten,msasync)
!       write(6,"('Saved file ',a,' to mss path ',a,
!    |    ' (retention period of ',i6,' days)')")
!    |    trim(diskfile),trim(outpath),msreten
      else
!
! Do not link to tempdir if tempdir is also cwd:
        if (trim(tempdir) /= '.') then
          istat = iunlink(trim(tempdir)//'/'//trim(diskfile),iprint)
!
! Let ilink report to stdout regardless of iprint:
          istat = ilink(diskfile,trim(tempdir)//'/'//trim(diskfile),1)
          if (istat /= 0) 
     |      write(6,"('>>> savefile: error ',i3,' from ilink.')") istat
          if (iprint > 0)
     |      write(6,"('(File was NOT disposed to mss)')")
        else
          write(6,"('NOT linking file ',a,' to tempdir ',
     |      'because tempdir==cwd')") trim(diskfile)
        endif
      endif
!
! Reopen file for appending:
      if (reopen) call nc_open(ncid,diskfile,'OLD','APPEND')
      end subroutine savefile
!-----------------------------------------------------------------------
      subroutine define_hist(type)
!
! Define history structure h from commons in hist.h, prior to 
!   writing history file.
! On input, type is either "prim" or "sech" for primary or
!   secondary histories.
!
      use hist_module,only: h,hist_initype,nhist,nsech,modeltime,
     |  isecout,ioutfile,nsource,iseries_prim,iseries_sech
      use input_module,only: output,secout,date,step,power,ctpoten,
     |  byimf,f107,f107a,mag,tide,tide2,colfac,source,hist,sechist,
     |  ncep
      use init_module,only: rundate,runtime,logname,host,system,
     |  iyear,iday,istep,igetgpi,start_year,start_day,start_mtime
      use fields_module,only: nfprog,fprog,fsech,fsechmag
      use cons_module,only: p0
      implicit none
#include "params.h"
#include "ovalr.h"
!
! Args:
      character(len=*),intent(in) :: type ! primary or secondary
!
! Local:
      integer :: i,ier,imo,ida
      character(len=8) :: writedate,writetime
      character(len=80) :: char80
!
! External:
      integer,external :: mtime_to_mins,mtime_to_nstep
      real,external :: mtime_to_datestr
!
! Init (note hist_initype deallocates h%fnames):
      call hist_initype(h,istep)
!
! Start date and time (global hist file attributes):
! Start_year,day,mtime are in init_module. If an initial run, they
!   were set from input parameters by sub init, otherwise (continuation
!   run) they were read from the startup history (nc_rdhist).
!
      h%start_year  = start_year
      h%start_day   = start_day
      h%start_mtime = start_mtime
!
! Define primary or secondary history structure (hist_mod.f):
      select case(type)
        case ('primary')
          h%ihist = nhist
          h%delhmins = mtime_to_mins(hist(:,iseries_prim))
          h%mss_path = output(ioutfile)
          if (nsource > 0) then ! initial run
            h%mss_source = source
          else ! continuation run
            h%mss_source = output(1)
          endif
          h%nflds = nfprog ! is parameter for now
          if (associated(h%fnames)) deallocate(h%fnames)
          if (h%nflds > 0) then
!           write(6,"('define_hist allocating prim h%fnames with ',
!    |        'h%nflds=',i3)") h%nflds
            allocate(h%fnames(h%nflds),stat=ier)
            if (ier /= 0) then
              write(6,"('>>> define_hist: error allocating h%fnames',
     |          ' for primary history: h%nflds=',i3)") h%nflds
            else
              do i=1,h%nflds
                h%fnames(i) = fprog(i)%name
              enddo
            endif
          endif
          h%nfgeo = h%nflds
          h%nfmag = 0       ! no magnetic fields on primary history
        case ('secondary')
          h%ihist = nsech
          h%delhmins = mtime_to_mins(sechist(:,iseries_sech))
          h%mss_path = secout(isecout)
          h%nfgeo = count(len_trim(fsech%name) > 0)    ! # geographic fields
          h%nfmag = count(len_trim(fsechmag%name) > 0) ! # magnetic fields
          h%nflds = h%nfgeo+h%nfmag
          if (h%nflds > 0 .and. .not.associated(h%fnames)) then
!           write(6,"('define_hist allocating sech h%fnames with ',
!    |        'h%nflds=',i3)") h%nflds
            allocate(h%fnames(h%nflds),stat=ier)
            if (ier /= 0) then
              write(6,"('>>> define_hist: error allocating h%fnames',
     |          ' for secondary history: h%nflds=',i3)") h%nflds
            else
              if (h%nfgeo > 0) then
                do i=1,h%nfgeo
                  h%fnames(i) = fsech(i)%name
                enddo
              endif
              if (h%nfmag > 0) then
                do i=1,h%nfmag
                  h%fnames(h%nfgeo+i) = fsechmag(i)%name
                enddo
              endif
            endif
          endif
        case default
          write(6,"('>>> define_hist: unknown type = ',a)") type
      end select
!
      h%year    = iyear
      h%calday  = iday
!
! Rundate and runtime were set by init and are saved in init module.
! H%createdate will be defined by nc_wrhist.
! Writedate is defined here.
! 
      h%rundate = rundate//' '//runtime
      call datetime(writedate,writetime)
      h%writedate = writedate//' '//writetime
      h%logname = logname
      h%host    = host
      h%system  = system
      h%model_name    = tgcm_name
      h%model_version = tgcm_version
      h%type  = type
      h%modeltime = modeltime
!     h%time  = mtime_to_mins(modeltime(1:3))
      h%time = mtime_to_datestr(h%year,h%modeltime,imo,ida,char80)
      h%iter  = mtime_to_nstep(modeltime(1:3),step)
      h%ut    = float(modeltime(2))+float(modeltime(3))/60.+
     |          float(modeltime(4))/3600.
      h%mag(:,:)  = mag(:,:)
      h%dtide(:)  = tide2(:)
      h%sdtide(:) = tide(:)
!
! If istep==0, then h%f107, etc were defined from source history,
! otherwise (istep > 0), at least one step has been taken and 
! f107, etc were defined either by user or by getgpi.
!
      if (istep > 0) then
        h%f107d     = f107
        h%f107a     = f107a
        h%hpower    = power
        h%ctpoten   = ctpoten
      endif
      h%byimf     = byimf
      h%colfac    = colfac
      h%alfa30    = alfa30
      h%e30       = e30
      h%alfad2    = alfad2
      h%ed2       = ed2
      h%p0        = p0 ! cons_mod
      h%step      = step
      h%ncep      = ncep
      h%gpi       = igetgpi
      h%missing_value = spval
!
      h%nlat = zjmx
      h%nlon = zimx
      h%nlev = zkmx+1
      h%zptop = zst
      h%zpbot = zsb
      end subroutine define_hist