#include <misc.h>#include <params.h>module history!----------------------------------------------------------------------- ! ! Purpose: History module.  Contains data and functions for writing history files.!! Public functions/subroutines:!   addfld, add_default!   intht!   write_restart_history!   read_restart_history!   outfld!   wshist! ! Author: CCM Core Group! !-----------------------------------------------------------------------! $Id: history.F90,v 1.26.2.15 2002/05/02 21:11:27 rosinski Exp $!-----------------------------------------------------------------------   use precision   use ppgrid,    only: pcols   use constituents, only: pcnst, pnats, cnst_name, cnst_longname   use tracers,   only: dcconnam, sflxnam   use filenames, only: mss_wpass, mss_irt, interpret_filename_spec, get_archivedir#if ( defined STAGGERED )   use pmgrid,    only: masterproc, beglat, endlat, plat, plon, plev, plevp, dyngrid_set, splon, beglev, endlev, endlevp#else   use pmgrid,    only: masterproc, beglat, endlat, plat, plon, plev, plevp, dyngrid_set#endif   implicit nonePRIVATE   include 'netcdf.inc'   integer, parameter :: pflds = 1000           ! max number of fields    integer, parameter :: ptapes = 6             ! max number of tapes   integer, parameter :: max_chars = 128        ! max chars for char variables   real(r8), parameter :: fillvalue = 1.e36     ! fill value for reduced grid   type field_info      character*8 :: name                       ! field name      character*(max_chars) :: long_name        ! long name      character*(max_chars) :: units            ! units      integer :: coldimin                       ! column dimension of model array      integer :: numlev                         ! vertical dimension (.nc file and internal arr)      integer :: begver                         ! on-node vert start index      integer :: endver                         ! on-node vert end index      integer :: begdim3                        ! on-node chunk or lat start index      integer :: enddim3                        ! on-node chunk or lat end index      integer :: decomp_type                    ! type of decomposition (physics or dynamics)      integer, pointer :: colperdim3(:)         ! number of valid elements per chunk or lat   end type field_info!! master_entry: elements of an entry in the master field list!   type master_entry      type (field_info)     :: field            ! field information      character*1           :: avgflag(ptapes)  ! averaging flag      character*(max_chars) :: time_op(ptapes)  ! time operator (e.g. max, min, avg)      logical               :: actflag(ptapes)  ! active/inactive flag   end type master_entry   type (master_entry) :: masterlist(pflds)     ! master field list!! hbuffer_2d, hbuffer_3d: 2-D and 3-D history buffer pointers.!     Select either r4 or r8 kind buffer depending on hbuf_prec.!   type hbuffer_2d      real(r8), pointer :: buf8(:,:)            ! 2-D history buffer for r8      real(r4), pointer :: buf4(:,:)            ! 2-D history buffer for r4   end type hbuffer_2d   type hbuffer_3d      real(r8), pointer :: buf8(:,:,:)          ! 3-D history buffer for r8      real(r4), pointer :: buf4(:,:,:)          ! 3-D history buffer for r4   end type hbuffer_3d!! arrays served as targets for history pointers!   integer,  target :: nothing_int(1,1)         ! 2-D integer target   real(r8), target :: nothing_r8(1,1,1)        ! 3-D r8 target   real(r4), target :: nothing_r4(1,1,1)        ! 3-D r4 target!! hentry: elements of an entry in the list of active fields on a single history file!   type hentry      type (field_info)     :: field            ! field information      character*1           :: avgflag          ! averaging flag      character*(max_chars) :: time_op          ! time operator (e.g. max, min, avg)      integer :: hbuf_prec                      ! history buffer precision      integer :: hwrt_prec                      ! history output precision      type (hbuffer_3d)   :: hbuf               ! history buffer      integer, pointer :: nacs(:,:)             ! accumulation counter   end type hentry!! active_entry: vehicle for producing a ragged array!   type active_entry      type (hentry) :: hlist(pflds)             ! array of history tape entries   end type active_entry   type (active_entry) :: tape(ptapes)          ! history tapes!! dim_index_2d, dim_index_3d: 2-D & 3-D dimension index lower & upper bounds!   type dim_index_2d                   ! 2-D dimension index      integer :: beg1, end1            ! lower & upper bounds of 1st dimension      integer :: beg2, end2            ! lower & upper bounds of 2nd dimension   end type dim_index_2d   type dim_index_3d                   ! 3-D dimension index      integer :: beg1, end1            ! lower & upper bounds of 1st dimension      integer :: beg2, end2            ! lower & upper bounds of 2nd dimension      integer :: beg3, end3            ! lower & upper bounds of 3rd dimension   end type dim_index_3d   integer :: ndm(12)                           ! number of days in each month (jan-dec)   save ndm   data ndm/31,28,31,30,31,30,31,31,30,31,30,31/   integer :: nfmaster = 0             ! number of fields in master field list   integer :: nflds(ptapes)            ! number of fields per tape! per tape sampling frequency (0=monthly avg)   integer :: i                        ! index for nhtfrq initialization   integer :: nhtfrq(ptapes) = (/0, (-24, i=2,ptapes)/)  ! history write frequency (0 = monthly)   integer :: mfilt(ptapes) = 30       ! number of time samples per tape   integer :: nfils(ptapes)            ! Array of no. of files on current h-file   integer :: mtapes = 0               ! index of max history file requested    integer :: nexcl(ptapes)            ! Actual number of excluded fields   integer :: nincl(ptapes)            ! Actual number of included primary file fields   integer :: nhstpr(ptapes) = 8       ! history buffer precision (8 or 4 bytes)   integer :: ndens(ptapes) = 2        ! packing density (nf_float vs nf_double)   integer :: ncprec(ptapes) = -999    ! netcdf packing parameter based on ndens   real(r8) :: beg_time(ptapes)        ! time at beginning of an averaging interval!! Netcdf ids!   integer :: nfid(ptapes)             ! file id   integer :: varid(pflds,ptapes)      ! variable ids   integer :: mdtid(ptapes)            ! var id for timestep   integer :: ndbaseid(ptapes)         ! var id for base day   integer :: nsbaseid(ptapes)         ! var id for base seconds of base day   integer :: nbdateid(ptapes)         ! var id for base date   integer :: nbsecid(ptapes)          ! var id for base seconds of base date   integer :: ndcurid(ptapes)          ! var id for current day   integer :: nscurid(ptapes)          ! var id for current seconds of current day   integer :: dateid(ptapes)           ! var id for current date   integer :: datesecid(ptapes)        ! var id for curent seconds of current date   integer :: nstephid(ptapes)         ! var id for current timestep   integer :: timeid(ptapes)           ! var id for time   integer :: tbndid(ptapes)           ! var id for time_bnds   integer :: gwid(ptapes)             ! var id for gaussian weights   integer :: date_writtenid(ptapes)   ! var id for date time sample written   integer :: time_writtenid(ptapes)   ! var id for time time sample written   integer :: nlonid(ptapes)           ! var id for number of longitudes   integer :: wnummaxid(ptapes)        ! var id for cutoff fourier wavenumber (reduced grid)   integer :: nscurf(ptapes)           ! First "current" second of day for each h-file   integer :: ncsecf(ptapes)           ! First "current" second of date for each h-file   logical :: rgnht(ptapes) = .false.  ! flag array indicating regeneration volumes   logical :: hstwr(ptapes) = .false.  ! Flag for history writes   logical :: empty_htapes  = .false.  ! Namelist flag indicates no default history fields   logical :: htapes_defined = .false. ! flag indicates history contents have been defined   integer, parameter :: nlen = 256    ! Length of strings   character(len=nlen) :: hrestpath(ptapes) = (/(' ',i=1,ptapes)/) ! Full history restart pathnames   character(len=nlen) :: nfpath(ptapes) = (/(' ',i=1,ptapes)/) ! Array of first pathnames, for header   character(len=nlen) :: cpath(ptapes)                   ! Array of current pathnames   character(len=nlen) :: nhfil(ptapes)                   ! Array of current file names   character(len=1)  :: avgflag_pertape(ptapes) = (/(' ',i=1,ptapes)/) ! per tape averaging flag   character(len=8)  :: logname             ! user name   character(len=16) :: host                ! host name   character(len=80) :: ctitle              ! Case title   character(len=8)  :: inithist = 'YEARLY' ! If set to 'MONTHLY' or 'YEARLY' then write IC file    character(len=10) :: fincl(pflds,ptapes) ! List of fields to add to primary h-file   character(len=8)  :: fexcl(pflds,ptapes) ! List of fields to rm from primary h-file   character(len=10) :: fhstpr(pflds,ptapes) ! List of fields to change default hbuf size   character(len=10) :: fwrtpr(pflds,ptapes) ! List of fields to change default history output prec!! Equivalence to please namelist on a wide variety of platforms! NOTE: It is *ASSUMED* that ptapes is 6!   character*10 fincl1(pflds)   character*10 fincl2(pflds)   character*10 fincl3(pflds)   character*10 fincl4(pflds)   character*10 fincl5(pflds)   character*10 fincl6(pflds)   equivalence (fincl1,fincl(1,1))   equivalence (fincl2,fincl(1,2))   equivalence (fincl3,fincl(1,3))   equivalence (fincl4,fincl(1,4))   equivalence (fincl5,fincl(1,5))   equivalence (fincl6,fincl(1,6))   character*8 fexcl1(pflds)   character*8 fexcl2(pflds)   character*8 fexcl3(pflds)   character*8 fexcl4(pflds)   character*8 fexcl5(pflds)   character*8 fexcl6(pflds)   equivalence (fexcl1,fexcl(1,1))   equivalence (fexcl2,fexcl(1,2))   equivalence (fexcl3,fexcl(1,3))   equivalence (fexcl4,fexcl(1,4))   equivalence (fexcl5,fexcl(1,5))   equivalence (fexcl6,fexcl(1,6))   character*10 fhstpr1(pflds)   character*10 fhstpr2(pflds)   character*10 fhstpr3(pflds)   character*10 fhstpr4(pflds)   character*10 fhstpr5(pflds)   character*10 fhstpr6(pflds)   equivalence (fhstpr1,fhstpr(1,1))   equivalence (fhstpr2,fhstpr(1,2))   equivalence (fhstpr3,fhstpr(1,3))   equivalence (fhstpr4,fhstpr(1,4))   equivalence (fhstpr5,fhstpr(1,5))   equivalence (fhstpr6,fhstpr(1,6))   character*10 fwrtpr1(pflds)   character*10 fwrtpr2(pflds)   character*10 fwrtpr3(pflds)   character*10 fwrtpr4(pflds)   character*10 fwrtpr5(pflds)   character*10 fwrtpr6(pflds)   equivalence (fwrtpr1,fwrtpr(1,1))   equivalence (fwrtpr2,fwrtpr(1,2))   equivalence (fwrtpr3,fwrtpr(1,3))   equivalence (fwrtpr4,fwrtpr(1,4))   equivalence (fwrtpr5,fwrtpr(1,5))   equivalence (fwrtpr6,fwrtpr(1,6))!! Overloading assignment operator!   interface assignment (=)      module procedure hbuf_assigned_to_hbuf      module procedure hbuf_assigned_to_real8   end interface!! Generic procedures!   interface allocate_hbuf      module procedure allocate_hbuf2d      module procedure allocate_hbuf3d   end interface   interface deallocate_hbuf      module procedure deallocate_hbuf2d      module procedure deallocate_hbuf3d   end interface   interface nullify_hbuf      module procedure nullify_hbuf2d      module procedure nullify_hbuf3d   end interface!! Public entities!!! Filename specifiers for history, initial files and restart history files! (%c = caseid, $y = year, $m = month, $d = day, $s = seconds in day, %t = tape number)!   character(len=256) :: ifilename_spec = '%c.cam2.i.%y-%m-%d-%s.nc'  ! Initial files   character(len=256) :: rhfilename_spec = '%c.cam2.rh%t.%y-%m-%d-%s' ! history restart   character(len=256), public :: hfilename_spec(ptapes) = (/ (' ', i=1, ptapes) /) ! filename specifyer! Needed by anyone calling addfld   integer, parameter, public :: phys_decomp = 1     ! flag indicates physics decomposition   integer, parameter, public :: dyn_decomp  = 2     ! flag indicates dynamics decomposition! To allow parameterizations to initialize arrays to the fillvalue! THIS NEEDS TO BE FIXED.  No parameterization should be allowed access to fillvalue   public :: fillvalue! Needed by cam   public :: bldfld! Needed by initext   public :: nhtfrq, mfilt, inithist, ctitle! Needed by parse_namelist   public :: fincl, fincl1, fincl2, fincl3, fincl4, fincl5, fincl6   public :: fexcl, fexcl1, fexcl2, fexcl3, fexcl4, fexcl5, fexcl6   public :: fhstpr, fhstpr1, fhstpr2, fhstpr3, fhstpr4, fhstpr5, fhstpr6   public :: fwrtpr, fwrtpr1, fwrtpr2, fwrtpr3, fwrtpr4, fwrtpr5, fwrtpr6   public :: pflds, ptapes, empty_htapes, nhstpr, ndens   public :: avgflag_pertape! Needed by stepon   public :: hstwr   public :: nfils! Functions   public :: write_restart_history     ! Write restart history data   public :: read_restart_history      ! Read restart history data   public :: wshist                    ! Write files out   public :: write_inithist            ! Write the initial file   public :: outfld                    ! Output a field   public :: intht                     ! Initialization   public :: wrapup                    ! Archive history files at end of run   public :: addfld                    ! Add a field to history file   public :: add_default               ! Add the default fields   public :: get_hfilepath             ! Return history filename   public :: get_mtapes                ! Return the number of tapes being used   public :: get_hist_restart_filepath ! Return the full filepath to the history restart fileCONTAINS   subroutine intht ()!----------------------------------------------------------------------- ! ! Purpose: Initialize history file handler for initial or continuation run.!          For example, on an initial run, this routine initializes "mtapes"!          history files.  On a restart or regeneration  run, this routine !          only initializes history files declared beyond what existed on the !          previous run.  Files which already existed on the previous run have !          already been initialized (i.e. named and opened) in routine RESTRT.!