!=============================================================================== ! SVN $Id: seq_hist_mod.F90 20124 2010-01-01 22:57:57Z tcraig $ ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/cesm1_0_rel_tags/cesm1_0_rel01_drvseq3_1_32/driver/seq_hist_mod.F90 $ !=============================================================================== !BOP =========================================================================== ! ! !MODULE: seq_hist_mod -- cpl7 history writing routines ! ! !DESCRIPTION: ! ! Creates cpl7 history files, instantanious, time-avg, and auxilliary ! ! !REMARKS: ! ! aVect, domain, and fraction info accessed via seq_avdata_mod ! to avoid excessively long routine arg lists. ! ! !REVISION HISTORY: ! 2009-Sep-25 - B. Kauffman - move from cpl7 main program into hist module ! 2009-mmm-dd - T. Craig - initial versions ! ! !INTERFACE: ------------------------------------------------------------------ module seq_hist_mod 1,11 ! !USES: use shr_kind_mod, only: R8 => SHR_KIND_R8, IN => SHR_KIND_IN use shr_kind_mod, only: CL => SHR_KIND_CL, CS => SHR_KIND_CS use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use shr_cal_mod, only: shr_cal_date2ymd use mct_mod ! adds mct_ prefix to mct lib use ESMF_Mod use seq_avdata_mod ! drv aVects & associated domain, fraction, cdata use seq_comm_mct ! mpi comm data & routines, plus logunit and loglevel use seq_cdata_mod ! "cdata" type & methods (domain + decomp + infodata in one datatype) use seq_infodata_mod ! "infodata" gathers various control flags into one datatype use seq_timemgr_mod ! clock & alarm routines use seq_io_mod ! lower level io routines implicit none private ! !PUBLIC TYPES: ! no public types ! !PUBLIC MEMBER FUNCTIONS public :: seq_hist_write ! write instantaneous hist file public :: seq_hist_writeavg ! write time-avg hist file public :: seq_hist_writeaux ! write auxiliary hist files ! !PUBLIC DATA MEMBERS: ! no public data !EOP !---------------------------------------------------------------------------- ! local/module data !---------------------------------------------------------------------------- logical :: iamin_CPLID ! pe associated with CPLID integer(IN) :: mpicom_GLOID ! MPI global communicator integer(IN) :: mpicom_CPLID ! MPI cpl communicator integer(IN) :: nthreads_GLOID ! OMP global number of threads integer(IN) :: nthreads_CPLID ! OMP cpl number of threads logical :: drv_threading ! driver threading control logical :: atm_present ! .true. => atm is present logical :: lnd_present ! .true. => land is present logical :: ice_present ! .true. => ice is present logical :: ocn_present ! .true. => ocn is present logical :: rof_present ! .true. => land runoff is present logical :: glc_present ! .true. => glc is present logical :: sno_present ! .true. => land sno is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input logical :: ice_prognostic ! .true. => ice comp expects input logical :: ocn_prognostic ! .true. => ocn comp expects input logical :: ocnrof_prognostic ! .true. => ocn comp expects runoff input logical :: glc_prognostic ! .true. => glc comp expects input logical :: sno_prognostic ! .true. => sno comp expects input logical :: cdf64 ! true => use 64 bit addressing in netCDF files !--- domain equivalent 2d grid size --- integer(IN) :: atm_nx, atm_ny ! nx,ny of 2d grid, if known integer(IN) :: lnd_nx, lnd_ny ! nx,ny of 2d grid, if known integer(IN) :: ice_nx, ice_ny ! nx,ny of 2d grid, if known integer(IN) :: ocn_nx, ocn_ny ! nx,ny of 2d grid, if known integer(IN) :: rof_nx, rof_ny ! nx,ny of 2d grid, if known integer(IN) :: glc_nx, glc_ny ! nx,ny of 2d grid, if known integer(IN) :: sno_nx, sno_ny ! nx,ny of 2d grid, if known integer(IN) :: info_debug = 0 ! local info_debug level !=============================================================================== contains !=============================================================================== subroutine seq_hist_write(EClock_d) 2,51 implicit none type (ESMF_Clock),intent(in) :: EClock_d ! driver clock integer(IN) :: curr_ymd ! Current date YYYYMMDD integer(IN) :: curr_tod ! Current time-of-day (s) integer(IN) :: start_ymd ! Starting date YYYYMMDD integer(IN) :: start_tod ! Starting time-of-day (s) real(r8) :: curr_time ! Time interval since reference time integer(IN) :: yy,mm,dd ! year, month, day integer(IN) :: fk ! index character(CL) :: time_units ! units of time variable character(CL) :: calendar ! calendar type character(CL) :: case_name ! case name character(CL) :: hist_file ! Local path to history filename integer(IN) :: lsize ! local size of an aVect logical :: whead,wdata ! for writing restart/history cdf files !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- !---------------------------------------------------------------------------- ! get required infodata !---------------------------------------------------------------------------- iamin_CPLID = seq_comm_iamin(CPLID) call seq_comm_setptrs(GLOID,mpicom=mpicom_GLOID,nthreads=nthreads_GLOID) call seq_comm_setptrs(CPLID,mpicom=mpicom_CPLID,nthreads=nthreads_CPLID) call seq_infodata_getData(infodata,drv_threading=drv_threading) call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present, & rof_present=rof_present, & ice_present=ice_present, & ocn_present=ocn_present, & glc_present=glc_present, & sno_present=sno_present ) call seq_infodata_getData(infodata, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & sno_prognostic=sno_prognostic ) call seq_infodata_getData(infodata, & atm_nx=atm_nx, atm_ny=atm_ny, & lnd_nx=lnd_nx, lnd_ny=lnd_ny, & rof_nx=rof_nx, rof_ny=rof_ny, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & sno_nx=sno_nx, sno_ny=sno_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny ) call seq_infodata_getData(infodata, cpl_cdf64=cdf64 ) !--- Get current date from clock needed to label the history pointer file --- call seq_infodata_GetData( infodata, case_name=case_name) call seq_timemgr_EClockGetData( EClock_d, curr_ymd=curr_ymd, curr_tod=curr_tod, & start_ymd=start_ymd, start_tod=start_tod, curr_time=curr_time, & calendar=calendar) call shr_cal_date2ymd(curr_ymd,yy,mm,dd) write(hist_file,"(2a,i4.4,a,i2.2,a,i2.2,a,i5.5,a)") & trim(case_name), '.cpl.hi.', yy,'-',mm,'-',dd,'-',curr_tod,'.nc' time_units = 'days since ' & // seq_io_date2yyyymmdd(start_ymd) // ' ' // seq_io_sec2hms(start_tod) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call seq_io_wopen(hist_file,cdata_ax,clobber=.true.,cdf64=cdf64) ! loop twice, first time write header, second time write data for perf do fk = 1,2 if (fk == 1) then whead = .true. wdata = .false. elseif (fk == 2) then whead = .false. wdata = .true. call seq_io_enddef(hist_file) else call shr_sys_abort('seq_hist_write fk illegal') end if call seq_io_write(hist_file,& time_units=time_units,time_cal=calendar,time_val=curr_time,& whead=whead,wdata=wdata) if (atm_present) then call seq_io_write(hist_file,cdata_ax,dom_ax%data,'dom_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='doma') call seq_io_write(hist_file,cdata_ax,fractions_ax,'fractions_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='fraca') call seq_io_write(hist_file,cdata_ax,x2a_ax,'x2a_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='x2a') call seq_io_write(hist_file,cdata_ax,a2x_ax,'a2x_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='a2x') ! call seq_io_write(hist_file,cdata_ax,l2x_ax,'l2x_ax', & ! nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='l2x_ax') ! call seq_io_write(hist_file,cdata_ax,o2x_ax,'o2x_ax', & ! nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='o2x_ax') ! call seq_io_write(hist_file,cdata_ax,i2x_ax,'i2x_ax', & ! nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='i2x_ax') endif if (lnd_present) then call seq_io_write(hist_file,cdata_lx,dom_lx%data,'dom_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='doml') call seq_io_write(hist_file,cdata_lx,fractions_lx,'fractions_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='fracl') call seq_io_write(hist_file,cdata_lx,l2x_lx,'l2x_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='l2x') call seq_io_write(hist_file,cdata_lx,x2l_lx,'x2l_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='x2l') endif if (rof_present) then call seq_io_write(hist_file,cdata_rx,dom_rx%data,'dom_rx', & nx=rof_nx,ny=rof_ny,whead=whead,wdata=wdata,pre='domr') call seq_io_write(hist_file,cdata_rx,r2x_rx,'r2x_rx', & nx=rof_nx,ny=rof_ny,whead=whead,wdata=wdata,pre='r2x') endif if (rof_present .and. ocnrof_prognostic) then call seq_io_write(hist_file,cdata_rx,r2xacc_rx%data,'r2xacc_rx', & nx=rof_nx,ny=rof_ny,whead=whead,wdata=wdata,pre='r2xacc') call seq_io_write(hist_file,cdata_ox,r2x_ox,'r2x_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='r2xo') endif if (ocn_present) then call seq_io_write(hist_file,cdata_ox,dom_ox%data,'dom_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='domo') call seq_io_write(hist_file,cdata_ox,fractions_ox,'fractions_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='fraco') call seq_io_write(hist_file,cdata_ox,o2x_ox,'o2x_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='o2x') call seq_io_write(hist_file,cdata_ax,o2x_ax,'o2x_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='o2xa') ! call seq_io_write(hist_file,cdata_ox,x2o_ox,'x2o_ox', & ! nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='x2o') call seq_io_write(hist_file,cdata_ox,x2oacc_ox%data,'x2oacc_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='x2oacc') ! call seq_io_write(hist_file,cdata_ox,x2oacc_ox%steps_done,'x2oacc_ox_cnt', & ! whead=whead,wdata=wdata) call seq_io_write(hist_file,cdata_ox,x2oacc_ox_cnt,'x2oacc_ox_cnt', & whead=whead,wdata=wdata) call seq_io_write(hist_file,cdata_ox,xao_ox,'xao_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='xaoo') call seq_io_write(hist_file,cdata_ax,xao_ax,'xao_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='xaoa') endif if (ice_present) then call seq_io_write(hist_file,cdata_ix,dom_ix%data,'dom_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='domi') call seq_io_write(hist_file,cdata_ix,fractions_ix,'fractions_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='fraci') call seq_io_write(hist_file,cdata_ix,i2x_ix,'i2x_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='i2x') call seq_io_write(hist_file,cdata_ix,x2i_ix,'x2i_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='x2i') endif if (glc_present) then call seq_io_write(hist_file,cdata_gx,dom_gx%data,'dom_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='domg') call seq_io_write(hist_file,cdata_gx,fractions_gx,'fractions_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='fracg') call seq_io_write(hist_file,cdata_gx,g2x_gx,'g2x_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='g2x') call seq_io_write(hist_file,cdata_gx,x2g_gx,'x2g_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='x2g') endif if (sno_present) then call seq_io_write(hist_file,cdata_sx,dom_sx%data,'dom_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='doms') call seq_io_write(hist_file,cdata_sx,s2x_sx,'s2x_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='s2x') call seq_io_write(hist_file,cdata_sx,x2s_sx,'x2s_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='x2s') endif enddo call seq_io_close(hist_file,cdata_ax) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif end subroutine seq_hist_write !=============================================================================== subroutine seq_hist_writeavg(EClock_d,write_now) 1,44 implicit none type (ESMF_Clock),intent(in) :: EClock_d ! driver clock logical ,intent(in) :: write_now ! write or accumulate integer(IN) :: curr_ymd ! Current date YYYYMMDD integer(IN) :: curr_tod ! Current time-of-day (s) integer(IN) :: prev_ymd ! Previous date YYYYMMDD integer(IN) :: prev_tod ! Previous time-of-day (s) integer(IN) :: start_ymd ! Starting date YYYYMMDD integer(IN) :: start_tod ! Starting time-of-day (s) real(r8) :: curr_time ! Time interval since reference time real(r8) :: prev_time ! Time interval since reference time integer(IN) :: yy,mm,dd ! year, month, day integer(IN) :: fk ! index character(CL) :: time_units ! units of time variable character(CL) :: calendar ! calendar type integer(IN) :: lsize ! local size of an aVect character(CL) :: case_name ! case name character(CL) :: hist_file ! Local path to history filename logical :: whead,wdata ! flags write header vs. data type(mct_aVect),save :: a2x_ax_avg ! tavg aVect/bundle type(mct_aVect),save :: x2a_ax_avg type(mct_aVect),save :: l2x_lx_avg type(mct_aVect),save :: x2l_lx_avg type(mct_aVect),save :: r2x_rx_avg type(mct_aVect),save :: o2x_ox_avg type(mct_aVect),save :: x2o_ox_avg type(mct_aVect),save :: i2x_ix_avg type(mct_aVect),save :: x2i_ix_avg type(mct_aVect),save :: g2x_gx_avg type(mct_aVect),save :: x2g_gx_avg type(mct_aVect),save :: s2x_sx_avg type(mct_aVect),save :: x2s_sx_avg integer(IN) ,save :: cnt ! counts samples in tavg real(r8) ,save :: tbnds(2) ! CF1.0 time bounds logical ,save :: first_call = .true. ! flags 1st call of this routine !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- !---------------------------------------------------------------------------- ! get required infodata !---------------------------------------------------------------------------- iamin_CPLID = seq_comm_iamin(CPLID) call seq_comm_setptrs(GLOID,mpicom=mpicom_GLOID,nthreads=nthreads_GLOID) call seq_comm_setptrs(CPLID,mpicom=mpicom_CPLID,nthreads=nthreads_CPLID) call seq_infodata_getData(infodata,drv_threading=drv_threading) call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present, & rof_present=rof_present, & ice_present=ice_present, & ocn_present=ocn_present, & glc_present=glc_present, & sno_present=sno_present ) call seq_infodata_getData(infodata, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & sno_prognostic=sno_prognostic ) call seq_infodata_getData(infodata, & atm_nx=atm_nx, atm_ny=atm_ny, & lnd_nx=lnd_nx, lnd_ny=lnd_ny, & rof_nx=rof_nx, rof_ny=rof_ny, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & sno_nx=sno_nx, sno_ny=sno_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny ) call seq_infodata_getData(infodata, cpl_cdf64=cdf64 ) ! Get current date from clock needed to label the histavg pointer file call seq_timemgr_EClockGetData( EClock_d, curr_ymd=curr_ymd, curr_tod=curr_tod, & start_ymd=start_ymd, start_tod=start_tod, curr_time=curr_time, prev_time=prev_time, & calendar=calendar) if (first_call) then if (atm_present) then lsize = mct_aVect_lsize(a2x_ax) call mct_aVect_init(a2x_ax_avg,a2x_ax,lsize) call mct_aVect_zero(a2x_ax_avg) lsize = mct_aVect_lsize(x2a_ax) call mct_aVect_init(x2a_ax_avg,x2a_ax,lsize) call mct_aVect_zero(x2a_ax_avg) endif if (lnd_present) then lsize = mct_aVect_lsize(l2x_lx) call mct_aVect_init(l2x_lx_avg,l2x_lx,lsize) call mct_aVect_zero(l2x_lx_avg) lsize = mct_aVect_lsize(x2l_lx) call mct_aVect_init(x2l_lx_avg,x2l_lx,lsize) call mct_aVect_zero(x2l_lx_avg) endif if (rof_present .and. ocnrof_prognostic) then lsize = mct_aVect_lsize(r2x_rx) call mct_aVect_init(r2x_rx_avg,r2x_rx,lsize) call mct_aVect_zero(r2x_rx_avg) endif if (ocn_present) then lsize = mct_aVect_lsize(o2x_ox) call mct_aVect_init(o2x_ox_avg,o2x_ox,lsize) call mct_aVect_zero(o2x_ox_avg) lsize = mct_aVect_lsize(x2o_ox) call mct_aVect_init(x2o_ox_avg,x2o_ox,lsize) call mct_aVect_zero(x2o_ox_avg) endif if (ice_present) then lsize = mct_aVect_lsize(i2x_ix) call mct_aVect_init(i2x_ix_avg,i2x_ix,lsize) call mct_aVect_zero(i2x_ix_avg) lsize = mct_aVect_lsize(x2i_ix) call mct_aVect_init(x2i_ix_avg,x2i_ix,lsize) call mct_aVect_zero(x2i_ix_avg) endif if (glc_present) then lsize = mct_aVect_lsize(g2x_gx) call mct_aVect_init(g2x_gx_avg,g2x_gx,lsize) call mct_aVect_zero(g2x_gx_avg) lsize = mct_aVect_lsize(x2g_gx) call mct_aVect_init(x2g_gx_avg,x2g_gx,lsize) call mct_aVect_zero(x2g_gx_avg) endif if (sno_present) then lsize = mct_aVect_lsize(s2x_sx) call mct_aVect_init(s2x_sx_avg,s2x_sx,lsize) call mct_aVect_zero(s2x_sx_avg) lsize = mct_aVect_lsize(x2s_sx) call mct_aVect_init(x2s_sx_avg,x2s_sx,lsize) call mct_aVect_zero(x2s_sx_avg) endif cnt = 0 tbnds(1) = prev_time first_call = .false. endif if (.not.write_now) then cnt = cnt + 1 if (atm_present) then a2x_ax_avg%rAttr = a2x_ax_avg%rAttr + a2x_ax%rAttr x2a_ax_avg%rAttr = x2a_ax_avg%rAttr + x2a_ax%rAttr endif if (lnd_present) then l2x_lx_avg%rAttr = l2x_lx_avg%rAttr + l2x_lx%rAttr x2l_lx_avg%rAttr = x2l_lx_avg%rAttr + x2l_lx%rAttr endif if (rof_present .and. ocnrof_prognostic) then r2x_rx_avg%rAttr = r2x_rx_avg%rAttr + r2x_rx%rAttr endif if (ocn_present) then o2x_ox_avg%rAttr = o2x_ox_avg%rAttr + o2x_ox%rAttr x2o_ox_avg%rAttr = x2o_ox_avg%rAttr + x2o_ox%rAttr endif if (ice_present) then i2x_ix_avg%rAttr = i2x_ix_avg%rAttr + i2x_ix%rAttr x2i_ix_avg%rAttr = x2i_ix_avg%rAttr + x2i_ix%rAttr endif if (glc_present) then g2x_gx_avg%rAttr = g2x_gx_avg%rAttr + g2x_gx%rAttr x2g_gx_avg%rAttr = x2g_gx_avg%rAttr + x2g_gx%rAttr endif if (sno_present) then s2x_sx_avg%rAttr = s2x_sx_avg%rAttr + s2x_sx%rAttr x2s_sx_avg%rAttr = x2s_sx_avg%rAttr + x2s_sx%rAttr endif else cnt = cnt + 1 tbnds(2) = curr_time if (atm_present) then a2x_ax_avg%rAttr = (a2x_ax_avg%rAttr + a2x_ax%rAttr) / (cnt * 1.0_r8) x2a_ax_avg%rAttr = (x2a_ax_avg%rAttr + x2a_ax%rAttr) / (cnt * 1.0_r8) endif if (lnd_present) then l2x_lx_avg%rAttr = (l2x_lx_avg%rAttr + l2x_lx%rAttr) / (cnt * 1.0_r8) x2l_lx_avg%rAttr = (x2l_lx_avg%rAttr + x2l_lx%rAttr) / (cnt * 1.0_r8) endif if (rof_present .and. ocnrof_prognostic) then r2x_rx_avg%rAttr = (r2x_rx_avg%rAttr + r2x_rx%rAttr) / (cnt * 1.0_r8) endif if (ocn_present) then o2x_ox_avg%rAttr = (o2x_ox_avg%rAttr + o2x_ox%rAttr) / (cnt * 1.0_r8) x2o_ox_avg%rAttr = (x2o_ox_avg%rAttr + x2o_ox%rAttr) / (cnt * 1.0_r8) endif if (ice_present) then i2x_ix_avg%rAttr = (i2x_ix_avg%rAttr + i2x_ix%rAttr) / (cnt * 1.0_r8) x2i_ix_avg%rAttr = (x2i_ix_avg%rAttr + x2i_ix%rAttr) / (cnt * 1.0_r8) endif if (glc_present) then g2x_gx_avg%rAttr = (g2x_gx_avg%rAttr + g2x_gx%rAttr) / (cnt * 1.0_r8) x2g_gx_avg%rAttr = (x2g_gx_avg%rAttr + x2g_gx%rAttr) / (cnt * 1.0_r8) endif if (sno_present) then s2x_sx_avg%rAttr = (s2x_sx_avg%rAttr + s2x_sx%rAttr) / (cnt * 1.0_r8) x2s_sx_avg%rAttr = (x2s_sx_avg%rAttr + x2s_sx%rAttr) / (cnt * 1.0_r8) endif call seq_infodata_GetData( infodata, case_name=case_name) call seq_timemgr_EClockGetData( EClock_d, prev_ymd=prev_ymd, prev_tod=prev_tod) if (seq_timemgr_histavg_type == seq_timemgr_type_nyear) then call shr_cal_date2ymd(prev_ymd,yy,mm,dd) write(hist_file,"(2a,i4.4,a)") & trim(case_name), '.cpl.ha.', yy,'.nc' elseif (seq_timemgr_histavg_type == seq_timemgr_type_nmonth) then call shr_cal_date2ymd(prev_ymd,yy,mm,dd) write(hist_file,"(2a,i4.4,a,i2.2,a)") & trim(case_name), '.cpl.ha.', yy,'-',mm,'.nc' elseif (seq_timemgr_histavg_type == seq_timemgr_type_nday) then call shr_cal_date2ymd(prev_ymd,yy,mm,dd) write(hist_file,"(2a,i4.4,a,i2.2,a,i2.2,a)") & trim(case_name), '.cpl.ha.', yy,'-',mm,'-',dd,'.nc' else call shr_cal_date2ymd(curr_ymd,yy,mm,dd) write(hist_file,"(2a,i4.4,a,i2.2,a,i2.2,a,i5.5,a)") & trim(case_name), '.cpl.ha.', yy,'-',mm,'-',dd,'-',curr_tod,'.nc' endif time_units = 'days since ' & // seq_io_date2yyyymmdd(start_ymd) // ' ' // seq_io_sec2hms(start_tod) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) call seq_io_wopen(hist_file,cdata_ax,clobber=.true.,cdf64=cdf64) ! loop twice, first time write header, second time write data for perf do fk = 1,2 if (fk == 1) then whead = .true. wdata = .false. elseif (fk == 2) then whead = .false. wdata = .true. call seq_io_enddef(hist_file) else call shr_sys_abort('seq_hist_writeavg fk illegal') end if call seq_io_write(hist_file,& time_units=time_units,time_cal=calendar,time_val=curr_time,& whead=whead,wdata=wdata,tbnds=tbnds) if (atm_present) then call seq_io_write(hist_file,cdata_ax,dom_ax%data,'dom_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='doma') call seq_io_write(hist_file,cdata_ax,x2a_ax_avg,'x2a_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='x2aavg',tavg=.true.) call seq_io_write(hist_file,cdata_ax,a2x_ax_avg,'a2x_ax', & nx=atm_nx,ny=atm_ny,whead=whead,wdata=wdata,pre='a2xavg',tavg=.true.) endif if (lnd_present) then call seq_io_write(hist_file,cdata_lx,dom_lx%data,'dom_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='doml') call seq_io_write(hist_file,cdata_lx,l2x_lx_avg,'l2x_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='l2xavg',tavg=.true.) call seq_io_write(hist_file,cdata_lx,x2l_lx_avg,'x2l_lx', & nx=lnd_nx,ny=lnd_ny,whead=whead,wdata=wdata,pre='x2lavg',tavg=.true.) endif if (rof_present .and. ocnrof_prognostic) then call seq_io_write(hist_file,cdata_rx,dom_rx%data,'dom_rx', & nx=rof_nx,ny=rof_ny,whead=whead,wdata=wdata,pre='domr') call seq_io_write(hist_file,cdata_rx,r2x_rx_avg,'r2x_rx', & nx=rof_nx,ny=rof_ny,whead=whead,wdata=wdata,pre='r2xavg',tavg=.true.) endif if (ocn_present) then call seq_io_write(hist_file,cdata_ox,dom_ox%data,'dom_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='domo') call seq_io_write(hist_file,cdata_ox,o2x_ox_avg,'o2x_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='o2xavg',tavg=.true.) call seq_io_write(hist_file,cdata_ox,x2o_ox_avg,'x2o_ox', & nx=ocn_nx,ny=ocn_ny,whead=whead,wdata=wdata,pre='x2oavg',tavg=.true.) endif if (ice_present) then call seq_io_write(hist_file,cdata_ix,dom_ix%data,'dom_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='domi') call seq_io_write(hist_file,cdata_ix,i2x_ix_avg,'i2x_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='i2xavg',tavg=.true.) call seq_io_write(hist_file,cdata_ix,x2i_ix_avg,'x2i_ix', & nx=ice_nx,ny=ice_ny,whead=whead,wdata=wdata,pre='x2iavg',tavg=.true.) endif if (glc_present) then call seq_io_write(hist_file,cdata_gx,dom_gx%data,'dom_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='domg') call seq_io_write(hist_file,cdata_gx,g2x_gx_avg,'g2x_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='g2xavg',tavg=.true.) call seq_io_write(hist_file,cdata_gx,x2g_gx_avg,'x2g_gx', & nx=glc_nx,ny=glc_ny,whead=whead,wdata=wdata,pre='x2gavg',tavg=.true.) endif if (sno_present) then call seq_io_write(hist_file,cdata_sx,dom_sx%data,'dom_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='doms') call seq_io_write(hist_file,cdata_sx,s2x_sx_avg,'s2x_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='s2xavg',tavg=.true.) call seq_io_write(hist_file,cdata_sx,x2s_sx_avg,'x2s_sx', & nx=sno_nx,ny=sno_ny,whead=whead,wdata=wdata,pre='x2savg',tavg=.true.) endif enddo call seq_io_close(hist_file,cdata_ax) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) if (atm_present) then call mct_aVect_zero(a2x_ax_avg) call mct_aVect_zero(x2a_ax_avg) endif if (lnd_present) then call mct_aVect_zero(l2x_lx_avg) call mct_aVect_zero(x2l_lx_avg) endif if (rof_present .and. ocnrof_prognostic) then call mct_aVect_zero(r2x_rx_avg) endif if (ocn_present) then call mct_aVect_zero(o2x_ox_avg) call mct_aVect_zero(x2o_ox_avg) endif if (ice_present) then call mct_aVect_zero(i2x_ix_avg) call mct_aVect_zero(x2i_ix_avg) endif if (glc_present) then call mct_aVect_zero(g2x_gx_avg) call mct_aVect_zero(x2g_gx_avg) endif if (sno_present) then call mct_aVect_zero(s2x_sx_avg) call mct_aVect_zero(x2s_sx_avg) endif cnt = 0 tbnds(1) = curr_time endif endif end subroutine seq_hist_writeavg !=============================================================================== subroutine seq_hist_writeaux(EClock_d,aname,dname,cdata_av,av,nx,ny,nt,write_now,flds) 9,26 implicit none type(ESMF_Clock), intent(in) :: EClock_d ! driver clock character(*) , intent(in) :: aname ! avect name for hist file character(*) , intent(in) :: dname ! domain name for hist file type(seq_cdata) , intent(in) :: cdata_av ! cdata of avect type(mct_aVect) , intent(in) :: av ! avect integer(IN) , intent(in) :: nx ! 2d global size nx integer(IN) , intent(in) :: ny ! 2d global size ny integer(IN) , intent(in) :: nt ! number of time samples per file logical,optional, intent(in) :: write_now ! write a sample now, if not used, write every call character(*),intent(in),optional :: flds ! list of fields to write !--- local --- character(CL) :: case_name ! case name type(mct_gGrid),pointer :: dom integer(IN) :: curr_ymd ! Current date YYYYMMDD integer(IN) :: curr_tod ! Current time-of-day (s) integer(IN) :: start_ymd ! Starting date YYYYMMDD integer(IN) :: start_tod ! Starting time-of-day (s) real(r8) :: curr_time ! Time interval since reference time real(r8) :: prev_time ! Time interval since reference time integer(IN) :: yy,mm,dd ! year, month, day integer(IN) :: n,fk,fk1 ! index character(CL) :: time_units ! units of time variable character(CL) :: calendar ! calendar type integer(IN) :: samples_per_file integer(IN) :: lsize ! local size of an aVect logical :: first_call integer(IN) :: found = -10 logical :: useavg logical :: lwrite_now logical :: whead,wdata ! for writing restart/history cdf files real(r8) :: tbnds(2) integer(IN),parameter :: maxout = 20 integer(IN) ,save :: ntout = 0 character(CS) ,save :: tname(maxout) = 'x1y2z3' integer(IN) ,save :: ncnt(maxout) = -10 character(CL) ,save :: hist_file(maxout) ! local path to history filename type(mct_aVect) ,save :: avavg(maxout) ! av accumulator if needed integer(IN) ,save :: avcnt(maxout) = 0 ! accumulator counter logical ,save :: fwrite(maxout) = .true. ! first write real(r8) ,save :: tbnds1(maxout) ! first time_bnds real(r8) ,save :: tbnds2(maxout) ! second time_bnds type(mct_aVect) :: avflds ! non-avg av for a subset of fields real(r8),parameter :: c0 = 0.0_r8 ! zero !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- !---------------------------------------------------------------------------- ! get required infodata !---------------------------------------------------------------------------- iamin_CPLID = seq_comm_iamin(CPLID) call seq_comm_setptrs(GLOID,mpicom=mpicom_GLOID,nthreads=nthreads_GLOID) call seq_comm_setptrs(CPLID,mpicom=mpicom_CPLID,nthreads=nthreads_CPLID) call seq_infodata_getData(infodata,drv_threading=drv_threading) call seq_infodata_getData(infodata, & atm_present=atm_present, & lnd_present=lnd_present, & rof_present=rof_present, & ice_present=ice_present, & ocn_present=ocn_present, & glc_present=glc_present, & sno_present=sno_present ) call seq_infodata_getData(infodata, cpl_cdf64=cdf64 ) lwrite_now = .true. useavg = .false. if (present(write_now)) then useavg = .true. lwrite_now = write_now endif call seq_timemgr_EClockGetData( EClock_d, curr_ymd=curr_ymd, curr_tod=curr_tod, & start_ymd=start_ymd, start_tod=start_tod, curr_time=curr_time, prev_time=prev_time, & calendar=calendar) first_call = .true. do n = 1,ntout if (trim(tname(n)) == trim(aname)) then first_call = .false. found = n endif enddo if (first_call) then ntout = ntout + 1 if (ntout > maxout) then write(logunit,*) 'write_history_spewAV maxout exceeded',ntout,maxout call shr_sys_abort() endif tname(ntout) = trim(aname) ncnt(ntout) = -10 if (iamin_CPLID .and. useavg) then lsize = mct_aVect_lsize(av) call mct_aVect_init(avavg(ntout),av,lsize) call mct_aVect_zero(avavg(ntout)) avcnt(ntout) = 0 endif tbnds1(ntout) = prev_time found = ntout endif ! if (.not. iamin_CPLID) return if (iamin_CPLID) then !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> samples_per_file = nt if (useavg) then if (lwrite_now) then avcnt(found) = avcnt(found) + 1 avavg(found)%rAttr = (avavg(found)%rAttr + av%rAttr) / (avcnt(found) * 1.0_r8) else avcnt(found) = avcnt(found) + 1 avavg(found)%rAttr = avavg(found)%rAttr + av%rAttr endif endif if (lwrite_now) then ncnt(found) = ncnt(found) + 1 if (ncnt(found) < 1 .or. ncnt(found) > samples_per_file) ncnt(found) = 1 time_units = 'days since ' & // seq_io_date2yyyymmdd(start_ymd) // ' ' // seq_io_sec2hms(start_tod) tbnds2(found) = curr_time if (ncnt(found) == 1) then fk1 = 1 call seq_infodata_GetData( infodata, case_name=case_name) call shr_cal_date2ymd(curr_ymd,yy,mm,dd) write(hist_file(found),"(a,i4.4,a,i2.2,a,i2.2,a)") & trim(case_name)//'.cpl.h'//trim(aname)//'.', yy,'-',mm,'-',dd,'.nc' else fk1 = 2 endif call seq_cdata_setptrs(cdata_av, dom=dom) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) if (fk1 == 1) then call seq_io_wopen(hist_file(found),cdata_av,clobber=.true.,cdf64=cdf64) else call seq_io_wopen(hist_file(found),cdata_av,clobber=.false.,cdf64=cdf64) endif ! loop twice, first time write header, second time write data for perf tbnds(1) = tbnds1(found) tbnds(2) = tbnds2(found) do fk = fk1,2 if (fk == 1) then whead = .true. wdata = .false. elseif (fk == 2) then whead = .false. wdata = .true. else call shr_sys_abort('seq_hist_writeaux fk illegal') end if if (present(flds)) then if (fk == fk1) then lsize = mct_aVect_lsize(av) call mct_aVect_init(avflds, rList=flds, lsize=lsize) call mct_aVect_zero(avflds) end if end if call seq_io_write(hist_file(found),& time_units=time_units,time_cal=calendar,time_val=curr_time,& nt=ncnt(found),whead=whead,wdata=wdata,tbnds=tbnds) if (fwrite(found)) then call seq_io_write(hist_file(found),cdata_av,dom%data,trim(dname), & nx=nx,ny=ny,whead=whead,wdata=wdata,fillval=c0,pre=trim(dname)) endif if (useavg) then if (present(flds)) then call mct_aVect_copy(aVin=avavg(found), aVout=avflds) call seq_io_write(hist_file(found), cdata_av, avflds, trim(aname), & nx=nx, ny=ny, nt=ncnt(found), whead=whead, wdata=wdata, & pre=trim(aname),tavg=.true.,use_float=.true.) else call seq_io_write(hist_file(found), cdata_av, avavg(found), trim(aname), & nx=nx, ny=ny, nt=ncnt(found), whead=whead, wdata=wdata, & pre=trim(aname),tavg=.true., use_float=.true.) end if else if (present(flds)) then call mct_aVect_copy(aVin=av, aVout=avflds) call seq_io_write(hist_file(found), cdata_av, avflds, trim(aname), & nx=nx,ny=ny,nt=ncnt(found),whead=whead,wdata=wdata,pre=trim(aname),& use_float=.true.) else call seq_io_write(hist_file(found), cdata_av, av, trim(aname), & nx=nx,ny=ny,nt=ncnt(found),whead=whead,wdata=wdata,pre=trim(aname),& use_float=.true.) endif if (present(flds)) then if (fk == 2) then call mct_aVect_clean(avflds) end if end if if (fk == 1) call seq_io_enddef(hist_file(found)) if (fk == 2) then fwrite(found) = .false. if (useavg) then call mct_aVect_zero(avavg(found)) avcnt(found) = 0 endif tbnds1(found) = curr_time endif enddo call seq_io_close(hist_file(found),cdata_av) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif ! lwrite_now endif ! iamin_CPLID <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< end subroutine seq_hist_writeaux !=============================================================================== end module seq_hist_mod