diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index ffcf85411a..bc11add267 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -43,7 +43,7 @@ def _case_two_setup(self): append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "MFILT = 1,7,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "nhtfrq = 1,1,1,1,1,1") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "fincl2='T','Q','TDIFF','QDIFF','LANDFRAC'") - append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "iopfile = '../"+case_name+".cam.h1."+RUN_STARTDATE+"-00000.nc'") + append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "iopfile = '../"+case_name+".cam.h1i."+RUN_STARTDATE+"-00000.nc'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "inithist = 'YEARLY'") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_cambfb_mode = .true.") append_to_user_nl_files(caseroot = self._get_caseroot(), component = "cam", contents = "scm_use_obs_uv = .true.") @@ -65,7 +65,7 @@ def _component_compare_test(self, suffix1, suffix2, success_change=False, ignore_fieldlist_diffs=False): with self._test_status: - stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1*8400.nc ') + stat,netcdf_filename,err=run_cmd('ls ./run/case2run/*h1i*8400.nc ') stat,DIFFs,err=run_cmd('ncdump -ff -p 9,17 -v QDIFF,TDIFF '+netcdf_filename+' | egrep //\.\*DIFF | sed s/^\ \*// | sed s/^0,/0.0,/ | sed s/^0\;/0.0\;/ | sed s/\[,\;\].\*// | uniq') array_of_DIFFs=DIFFs.split("\n") answer=max([abs(float(x)) for x in array_of_DIFFs]) diff --git a/doc/ChangeLog b/doc/ChangeLog index dcfaa48b18..8395fd0031 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,280 @@ =============================================================== +Tag name: cam6_3_140 +Originator(s): peverwhee +Date: 6 December 2023 +One-line Summary: Separate history tapes into hXi and hXa +Github PR URL: https://github.com/ESCOMP/CAM/pull/903 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + - Change "time" value for averaged quantities to midpoint of averaging period (#159) + - Modify naming and attributes of time variables on history files to be + consistent with other CESM components (#554) + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar brian-eaton nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M cime_config/SystemTests/sct.py + - change references to history file to include "i" flag + +M src/control/cam_history.F90 + - change 'time_bnds' to 'time_bounds' + - split history stream into two files: instantaneous and accumulated + - accumulated file has all non-instantaneous fields and 'time', 'date', + 'datesec' fields are the midpoint time + - accumulated file is only generated when one or more accumulated fields + - filename includes 'a' flag + is included in the fincl list + - instantaneous file has all instantaneous fields (including scalars that + are always written) and 'time', 'date', and 'datesec' fields are the end + time + - instantaneous file is always generated (with, at minimum, those + scalars like solar forcing data, current timestep, etc + - filename includes 'i' flag + - change 'cell_methods' to always include 'time: x' attribute to specify flag + - "time: point" for instantaneous fields + +M src/control/cam_history_support.F90 + - add functionality for multiple files per history stream + +M src/control/filenames.F90 + - update interpret_filename_spec to include 'a' or 'i' flag in filename + +M src/control/sat_hist.F90 + - update to comply with new Files array (multiple files per stream) + +M src/utils/cam_grid_support.F90 + - updates to get around logic that prevented fields to be written twice (need + to be written once per file instead of once overall) + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +cheyenne/intel/aux_cam: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq9s (Overall: FAIL) details: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.cheyenne_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + - pre-existing failures + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.cheyenne_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.cheyenne_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.cheyenne_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.cheyenne_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.cheyenne_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.cheyenne_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.cheyenne_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.cheyenne_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.cheyenne_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.cheyenne_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.cheyenne_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.cheyenne_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.cheyenne_intel.cam-cam4_port5d (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.cheyenne_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.cheyenne_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.cheyenne_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.cheyenne_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.cheyenne_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.cheyenne_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.cheyenne_intel.cam-cam6_port_f09 (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.cheyenne_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.cheyenne_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.cheyenne_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.cheyenne_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.cheyenne_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.cheyenne_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +derecho/intel/aux_cam: + ERP_Ln9_Vnuopc.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 (Overall: PEND) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) details: + - pre-existing failures + ERC_D_Ln9_P144x1_Vnuopc.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ld3_Vnuopc.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d (Overall: DIFF) details: + ERP_Lh12_Vnuopc.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + ERP_Ln9_P24x3_Vnuopc.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2000dev.derecho_intel.cam-outfrq9s_mg3 (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30_ne30_mg17.FCnudged.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ld3_Vnuopc.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam_dev (Overall: DIFF) details: + ERS_Ln9_P288x1_Vnuopc.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) details: + ERS_Ln9_P36x1_Vnuopc.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase (Overall: DIFF) details: + SMS_D_Ld5_Vnuopc.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.FX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.T42_T42.FSCAM.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.f19_f19.F2000dev.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld1_Vnuopc.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d (Overall: DIFF) details: + SMS_Ld5_Vnuopc.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 (Overall: DIFF) details: + SMS_Lh12_Vnuopc.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h (Overall: DIFF) details: + SMS_Lm13_Vnuopc.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19.F2000climo.derecho_intel.cam-silhs (Overall: DIFF) details: + SMS_Ln9_Vnuopc.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +izumi/nag/aux_cam: + DAE_Vnuopc.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) details: + - preexisting failure + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am (Overall: DIFF)details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_convmic (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf (Overall: DIFF) details: + ERS_Ln27_Vnuopc.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + ERS_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 (Overall: DIFF) details: + SMS_D_Ld2_Vnuopc.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln6_Vnuopc.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem (Overall: DIFF) details: + SMS_D_Ln7_Vnuopc.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm (Overall: DIFF) details: + SMS_D_Ln9_P1x1_Vnuopc.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba (Overall: DIFF) details: + SMS_P48x1_D_Ln3_Vnuopc.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase (Overall: DIFF) details: + SUB_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s (Overall: DIFF) details: + TMC_D_Vnuopc.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac (Overall: DIFF) details: + TMC_D_Vnuopc.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +izumi/gnu/aux_cam: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.ne5pg4_ne5pg4_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + ERC_D_Ln9_Vnuopc.T5_T5_mg37.QPC3.izumi_gnu.cam-outfrq3s_usecase (Overall: DIFF) details: + ERI_D_Ln18_Vnuopc.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + ERP_Ln9_Vnuopc.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + PEM_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 (Overall: DIFF) details: + PLB_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep (Overall: DIFF) details: + SCT_D_Ln7_Vnuopc.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 (Overall: DIFF) details: + SMS_D_Ln3_Vnuopc.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc (Overall: DIFF) details: + SMS_D_Ln9.f10_f10_mg37.2000_CAM%DEV%GHGMAM4_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV_SESP.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee (Overall: DIFF) details: + SMS_D_Ln9_Vnuopc.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac (Overall: DIFF) details: + SMS_P48x1_D_Ln9_Vnuopc.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s (Overall: DIFF) details: + - Confirmed no fields lost; no field data changed except date, datesec, and + time (now reflect midpoints in 'a' files); field 'time_bnds' changed to 'time_bounds' + +Summarize any changes to answers: No answer changes except midpoint time, +date, datesec for accumulated files + +=============================================================== + Tag name: cam6_3_139 Originator(s): fvitt, tilmes Date: 1 Dec 2023 diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 2bc71d4bd7..83821f6849 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -38,7 +38,8 @@ module cam_history pio_int, pio_real, pio_double, pio_char, & pio_offset_kind, pio_unlimited, pio_global, & pio_inq_dimlen, pio_def_var, pio_enddef, & - pio_put_att, pio_put_var, pio_get_att + pio_put_att, pio_put_var, pio_get_att, & + pio_file_is_open use perf_mod, only: t_startf, t_stopf @@ -58,6 +59,7 @@ module cam_history use solar_wind_data, only: solar_wind_on, byimf=>solar_wind_byimf, bzimf=>solar_wind_bzimf use solar_wind_data, only: swvel=>solar_wind_swvel, swden=>solar_wind_swden use epotential_params, only: epot_active, epot_crit_colats + use cam_grid_support, only: maxsplitfiles implicit none private @@ -126,7 +128,7 @@ module cam_history ! The size of these parameters should match the assignments in restart_vars_setnames and restart_dims_setnames below ! integer, parameter :: restartvarcnt = 45 - integer, parameter :: restartdimcnt = 10 + integer, parameter :: restartdimcnt = 11 type(rvar_id) :: restartvars(restartvarcnt) type(rdim_id) :: restartdims(restartdimcnt) integer, parameter :: ptapes_dim_ind = 1 @@ -139,6 +141,15 @@ module cam_history integer, parameter :: maxvarmdims_dim_ind = 8 integer, parameter :: registeredmdims_dim_ind = 9 integer, parameter :: max_hcoordname_len_dim_ind = 10 + integer, parameter :: max_num_split_files = 11 + + ! Indices for split history files; must be 1 and 2 + integer, parameter :: instantaneous_file_index = 1 + integer, parameter :: accumulated_file_index = 2 + ! Indices for non-split history files; must be 1 or 2 + integer, parameter :: sat_file_index = 1 + integer, parameter :: restart_file_index = 1 + integer, parameter :: init_file_index = 1 integer :: nfmaster = 0 ! number of fields in master field list integer :: nflds(ptapes) ! number of fields per tape @@ -163,8 +174,8 @@ module cam_history character(len=*), parameter :: history_namelist = 'cam_history_nl' character(len=max_string_len) :: hrestpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Full history restart pathnames character(len=max_string_len) :: nfpath(ptapes) = (/(' ',idx=1,ptapes)/) ! Array of first pathnames, for header - character(len=max_string_len) :: cpath(ptapes) ! Array of current pathnames - character(len=max_string_len) :: nhfil(ptapes) ! Array of current file names + character(len=max_string_len) :: cpath(ptapes,maxsplitfiles) ! Array of current pathnames + character(len=max_string_len) :: nhfil(ptapes,maxsplitfiles) ! Array of current file names character(len=1) :: avgflag_pertape(ptapes) = (/(' ',idx=1,ptapes)/) ! per tape averaging flag character(len=16) :: logname ! user name character(len=16) :: host ! host name @@ -296,6 +307,8 @@ module cam_history ! character(len=max_string_len) :: rhfilename_spec = '%c.cam.rh%t.%y-%m-%d-%s.nc' ! history restart character(len=max_string_len) :: hfilename_spec(ptapes) = (/ (' ', idx=1, ptapes) /) ! filename specifyer + ! Flag for if there are accumulated fields specified for a given tape + logical :: hfile_accum(ptapes) = .false. interface addfld @@ -369,7 +382,7 @@ subroutine intht (model_doi_url_in) ! ! Local workspace ! - integer :: t, f ! tape, field indices + integer :: t, fld ! tape, field indices integer :: begdim1 ! on-node dim1 start index integer :: enddim1 ! on-node dim1 end index integer :: begdim2 ! on-node dim2 start index @@ -401,18 +414,18 @@ subroutine intht (model_doi_url_in) write(iulog,*)' ******* MASTER FIELD LIST *******' end if listentry=>masterlinkedlist - f=0 + fld=0 do while(associated(listentry)) - f=f+1 + fld=fld+1 if(masterproc) then fldname = listentry%field%name - write(iulog,9000) f, fldname, listentry%field%units, listentry%field%numlev, & + write(iulog,9000) fld, fldname, listentry%field%units, listentry%field%numlev, & listentry%avgflag(1), trim(listentry%field%long_name) 9000 format(i5, 1x, a32, 1x, a16, 1x, i4, 1x, a1, 2x, a) end if listentry=>listentry%next_entry end do - nfmaster = f + nfmaster = fld if(masterproc) write(iulog,*)'intht:nfmaster=',nfmaster ! @@ -469,24 +482,31 @@ subroutine intht (model_doi_url_in) ! Initialize history variables ! do t=1,ptapes - do f=1,nflds(t) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%hbuf = 0._r8 - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - tape(t)%hlist(f)%sbuf = 0._r8 + do fld=1,nflds(t) + if (nhtfrq(t) == 1) then + ! Override any non-I flags if nhtfrq equals 1 + tape(t)%hlist(fld)%avgflag = 'I' + end if + if (tape(t)%hlist(fld)%avgflag .ne. 'I') then + hfile_accum(t) = .true. + end if + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + allocate(tape(t)%hlist(fld)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(fld)%hbuf = 0._r8 + if (tape(t)%hlist(fld)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(fld)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + tape(t)%hlist(fld)%sbuf = 0._r8 endif - if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up areawt weight buffer - fdecomp = tape(t)%hlist(f)%field%decomp_type + if (tape(t)%hlist(fld)%avgflag .eq. 'N') then ! set up areawt weight buffer + fdecomp = tape(t)%hlist(fld)%field%decomp_type if (any(allgrids_wt(:)%decomp_type == fdecomp)) then wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) - tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them ! first check for an available spot in the array @@ -501,7 +521,7 @@ subroutine intht (model_doi_url_in) allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)=0._r8 count=0 do c=begdim3,enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) + dimind = tape(t)%hlist(fld)%field%get_dims(c) ib=dimind%beg1 ie=dimind%end1 do i=ib,ie @@ -509,18 +529,18 @@ subroutine intht (model_doi_url_in) allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(count) end do end do - tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf endif endif - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + if(tape(t)%hlist(fld)%field%flag_xyfill .or. (avgflag_pertape(t) .eq. 'L')) then + allocate (tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) else - allocate (tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + allocate (tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) end if - tape(t)%hlist(f)%nacs(:,:) = 0 - tape(t)%hlist(f)%beg_nstep = 0 - tape(t)%hlist(f)%field%meridional_complement = -1 - tape(t)%hlist(f)%field%zonal_complement = -1 + tape(t)%hlist(fld)%nacs(:,:) = 0 + tape(t)%hlist(fld)%beg_nstep = 0 + tape(t)%hlist(fld)%field%meridional_complement = -1 + tape(t)%hlist(fld)%field%zonal_complement = -1 end do end do ! Setup vector pairs for unstructured grid interpolation @@ -553,6 +573,7 @@ subroutine history_readnl(nlfile) integer :: dtime ! Step time in seconds integer :: unitn, ierr, f, t character(len=8) :: ctemp ! Temporary character string + integer :: filename_len character(len=fieldname_lenp2) :: fincl1(pflds) character(len=fieldname_lenp2) :: fincl2(pflds) @@ -768,6 +789,13 @@ subroutine history_readnl(nlfile) nhtfrq(t) = nint((-nhtfrq(t) * 3600._r8) / dtime) end if end do + ! If nhtfrq == 1, then the output is instantaneous. Enforce this by setting + ! the per-file averaging flag. + do t = 1, ptapes + if (nhtfrq(t) == 1) then + avgflag_pertape(t) = 'I' + end if + end do ! ! Initialize the filename specifier if not already set ! This is the format for the history filenames: @@ -778,10 +806,15 @@ subroutine history_readnl(nlfile) if ( len_trim(hfilename_spec(t)) == 0 )then if ( nhtfrq(t) == 0 )then ! Monthly files - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m.nc' + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t%f.%y-%m.nc' else - hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t.%y-%m-%d-%s.nc' + hfilename_spec(t) = '%c.cam' // trim(inst_suffix) // '.h%t%f.%y-%m-%d-%s.nc' end if + else + ! Append file type - instantaneous or accumulated - to filename + ! specifier provided (in front of the .nc extension). + filename_len = len_trim(hfilename_spec(t)) + hfilename_spec(t) = hfilename_spec(t)(:filename_len-3) // '%f.nc' end if ! ! Only one time sample allowed per monthly average file @@ -935,7 +968,7 @@ subroutine setup_interpolation_and_define_vector_complements() use interp_mod, only: setup_history_interpolation ! Local variables - integer :: hf, f, ff + integer :: hf, fld, ffld logical :: interp_ok character(len=max_fieldname_len) :: mname character(len=max_fieldname_len) :: zname @@ -947,31 +980,31 @@ subroutine setup_interpolation_and_define_vector_complements() interpolate_output, interpolate_info) do hf = 1, ptapes - 2 if((.not. is_satfile(hf)) .and. (.not. is_initfile(hf))) then - do f = 1, nflds(hf) - if (field_part_of_vector(trim(tape(hf)%hlist(f)%field%name), & + do fld = 1, nflds(hf) + if (field_part_of_vector(trim(tape(hf)%hlist(fld)%field%name), & mname, zname)) then if (len_trim(mname) > 0) then ! This field is a zonal part of a set, find the meridional partner - do ff = 1, nflds(hf) - if (trim(mname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%meridional_complement = ff - tape(hf)%hlist(ff)%field%zonal_complement = f + do ffld = 1, nflds(hf) + if (trim(mname) == trim(tape(hf)%hlist(ffld)%field%name)) then + tape(hf)%hlist(fld)%field%meridional_complement = ffld + tape(hf)%hlist(ffld)%field%zonal_complement = fld exit end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(f)%field%name)) + if (ffld == nflds(hf)) then + call endrun(trim(subname)//': No meridional match for '//trim(tape(hf)%hlist(fld)%field%name)) end if end do else if (len_trim(zname) > 0) then ! This field is a meridional part of a set, find the zonal partner - do ff = 1, nflds(hf) - if (trim(zname) == trim(tape(hf)%hlist(ff)%field%name)) then - tape(hf)%hlist(f)%field%zonal_complement = ff - tape(hf)%hlist(ff)%field%meridional_complement = f + do ffld = 1, nflds(hf) + if (trim(zname) == trim(tape(hf)%hlist(ffld)%field%name)) then + tape(hf)%hlist(fld)%field%zonal_complement = ffld + tape(hf)%hlist(ffld)%field%meridional_complement = fld exit end if - if (ff == nflds(hf)) then - call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(f)%field%name)) + if (ffld == nflds(hf)) then + call endrun(trim(subname)//': No zonal match for '//trim(tape(hf)%hlist(fld)%field%name)) end if end do else @@ -990,33 +1023,33 @@ subroutine define_composed_field_ids(t) integer, intent(in) :: t ! Current tape ! Local variables - integer :: f, ff + integer :: fld, ffld character(len=max_fieldname_len) :: field1 character(len=max_fieldname_len) :: field2 character(len=*), parameter :: subname='define_composed_field_ids' logical :: is_composed - do f = 1, nflds(t) - call composed_field_info(tape(t)%hlist(f)%field%name,is_composed,fname1=field1,fname2=field2) + do fld = 1, nflds(t) + call composed_field_info(tape(t)%hlist(fld)%field%name,is_composed,fname1=field1,fname2=field2) if (is_composed) then if (len_trim(field1) > 0 .and. len_trim(field2) > 0) then ! set field1/field2 names for htape from the masterfield list - tape(t)%hlist(f)%op_field1=trim(field1) - tape(t)%hlist(f)%op_field2=trim(field2) + tape(t)%hlist(fld)%op_field1=trim(field1) + tape(t)%hlist(fld)%op_field2=trim(field2) ! find ids for field1/2 - do ff = 1, nflds(t) - if (trim(field1) == trim(tape(t)%hlist(ff)%field%name)) then - tape(t)%hlist(f)%field%op_field1_id = ff + do ffld = 1, nflds(t) + if (trim(field1) == trim(tape(t)%hlist(ffld)%field%name)) then + tape(t)%hlist(fld)%field%op_field1_id = ffld end if - if (trim(field2) == trim(tape(t)%hlist(ff)%field%name)) then - tape(t)%hlist(f)%field%op_field2_id = ff + if (trim(field2) == trim(tape(t)%hlist(ffld)%field%name)) then + tape(t)%hlist(fld)%field%op_field2_id = ffld end if end do - if (tape(t)%hlist(f)%field%op_field1_id == -1) then - call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(f)%field%name)) + if (tape(t)%hlist(fld)%field%op_field1_id == -1) then + call endrun(trim(subname)//': No op_field1 match for '//trim(tape(t)%hlist(fld)%field%name)) end if - if (tape(t)%hlist(f)%field%op_field2_id == -1) then - call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(f)%field%name)) + if (tape(t)%hlist(fld)%field%op_field2_id == -1) then + call endrun(trim(subname)//': No op_field2 match for '//trim(tape(t)%hlist(fld)%field%name)) end if else call endrun(trim(subname)//': Component fields not found for composed field') @@ -1070,16 +1103,18 @@ subroutine restart_vars_setnames() rvindex = rvindex + 1 restartvars(rvindex)%name = 'cpath' restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%ndims = 3 restartvars(rvindex)%dims(1) = max_string_len_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%dims(3) = max_num_split_files rvindex = rvindex + 1 restartvars(rvindex)%name = 'nhfil' restartvars(rvindex)%type = pio_char - restartvars(rvindex)%ndims = 2 + restartvars(rvindex)%ndims = 3 restartvars(rvindex)%dims(1) = max_string_len_dim_ind restartvars(rvindex)%dims(2) = ptapes_dim_ind + restartvars(rvindex)%dims(3) = max_num_split_files rvindex = rvindex + 1 restartvars(rvindex)%name = 'ndens' @@ -1402,6 +1437,9 @@ subroutine restart_dims_setnames() restartdims(max_hcoordname_len_dim_ind)%name = 'max_hcoordname_len' restartdims(max_hcoordname_len_dim_ind)%len = max_hcoordname_len + restartdims(max_num_split_files)%name = 'max_num_split_files' + restartdims(max_num_split_files)%len = maxsplitfiles + end subroutine restart_dims_setnames @@ -1501,7 +1539,7 @@ subroutine write_restart_history ( File, & ! ! Local workspace ! - integer :: ierr, t, f + integer :: ierr, t, fld integer :: rgnht_int(ptapes), start(2), startc(3) type(var_desc_t), pointer :: vdesc @@ -1610,10 +1648,10 @@ subroutine write_restart_history ( File, & ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) vdesc => restartvar_getdesc('cpath') - ierr= pio_put_var(File, vdesc, cpath(1:ptapes)) + ierr= pio_put_var(File, vdesc, cpath(1:ptapes,:)) vdesc => restartvar_getdesc('nhfil') - ierr= pio_put_var(File, vdesc, nhfil(1:ptapes)) + ierr= pio_put_var(File, vdesc, nhfil(1:ptapes,:)) vdesc => restartvar_getdesc('ndens') ierr= pio_put_var(File, vdesc, ndens(1:ptapes)) @@ -1675,40 +1713,40 @@ subroutine write_restart_history ( File, & do t = 1,ptapes start(2)=t startc(3)=t - do f=1,nflds(t) - start(1)=f - startc(2)=f - ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(f)%field%name) - ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(f)%field%decomp_type) - ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(f)%field%numlev) - - ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(f)%hwrt_prec) - call tape(t)%hlist(f)%get_global(integral) + do fld=1,nflds(t) + start(1)=fld + startc(2)=fld + ierr = pio_put_var(File, field_name_desc,startc,tape(t)%hlist(fld)%field%name) + ierr = pio_put_var(File, decomp_type_desc,start,tape(t)%hlist(fld)%field%decomp_type) + ierr = pio_put_var(File, numlev_desc,start,tape(t)%hlist(fld)%field%numlev) + + ierr = pio_put_var(File, hwrt_prec_desc,start,tape(t)%hlist(fld)%hwrt_prec) + call tape(t)%hlist(fld)%get_global(integral) ierr = pio_put_var(File, hbuf_integral_desc,start,integral) - ierr = pio_put_var(File, beg_nstep_desc,start,tape(t)%hlist(f)%beg_nstep) - ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(f)%field%sampling_seq) - ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(f)%field%cell_methods) - ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(f)%field%long_name) - ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(f)%field%units) - ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(f)%avgflag) - - ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(f)%field%fillvalue) - ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(f)%field%zonal_complement) - ierr = pio_put_var(File, field_op_desc,startc, tape(t)%hlist(f)%field%field_op) - ierr = pio_put_var(File, op_field1_id_desc,start, tape(t)%hlist(f)%field%op_field1_id) - ierr = pio_put_var(File, op_field2_id_desc,start, tape(t)%hlist(f)%field%op_field2_id) - ierr = pio_put_var(File, op_field1_desc,startc, tape(t)%hlist(f)%op_field1) - ierr = pio_put_var(File, op_field2_desc,startc, tape(t)%hlist(f)%op_field2) - if(associated(tape(t)%hlist(f)%field%mdims)) then - allmdims(1:size(tape(t)%hlist(f)%field%mdims),f,t) = tape(t)%hlist(f)%field%mdims + ierr = pio_put_var(File, beg_nstep_desc,start,tape(t)%hlist(fld)%beg_nstep) + ierr = pio_put_var(File, sseq_desc,startc,tape(t)%hlist(fld)%field%sampling_seq) + ierr = pio_put_var(File, cm_desc,startc,tape(t)%hlist(fld)%field%cell_methods) + ierr = pio_put_var(File, longname_desc,startc,tape(t)%hlist(fld)%field%long_name) + ierr = pio_put_var(File, units_desc,startc,tape(t)%hlist(fld)%field%units) + ierr = pio_put_var(File, avgflag_desc,start, tape(t)%hlist(fld)%avgflag) + + ierr = pio_put_var(File, fillval_desc,start, tape(t)%hlist(fld)%field%fillvalue) + ierr = pio_put_var(File, meridional_complement_desc,start, tape(t)%hlist(fld)%field%meridional_complement) + ierr = pio_put_var(File, zonal_complement_desc,start, tape(t)%hlist(fld)%field%zonal_complement) + ierr = pio_put_var(File, field_op_desc,startc, tape(t)%hlist(fld)%field%field_op) + ierr = pio_put_var(File, op_field1_id_desc,start, tape(t)%hlist(fld)%field%op_field1_id) + ierr = pio_put_var(File, op_field2_id_desc,start, tape(t)%hlist(fld)%field%op_field2_id) + ierr = pio_put_var(File, op_field1_desc,startc, tape(t)%hlist(fld)%op_field1) + ierr = pio_put_var(File, op_field2_desc,startc, tape(t)%hlist(fld)%op_field2) + if(associated(tape(t)%hlist(fld)%field%mdims)) then + allmdims(1:size(tape(t)%hlist(fld)%field%mdims),fld,t) = tape(t)%hlist(fld)%field%mdims else end if - if(tape(t)%hlist(f)%field%flag_xyfill) then - xyfill(f,t) = 1 + if(tape(t)%hlist(fld)%field%flag_xyfill) then + xyfill(fld,t) = 1 end if - if(tape(t)%hlist(f)%field%is_subcol) then - is_subcol(f,t) = 1 + if(tape(t)%hlist(fld)%field%is_subcol) then + is_subcol(fld,t) = 1 end if end do if (interpolate_output(t)) then @@ -1742,15 +1780,13 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, interpolate_nlon_desc, interp_output) ! Registered history coordinates start(1) = 1 - do f = 1, registeredmdims - start(2) = f - ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(f)) + do fld = 1, registeredmdims + start(2) = fld + ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(fld)) end do deallocate(xyfill, allmdims, is_subcol, interp_output, restarthistory_tape) - return - end subroutine write_restart_history @@ -1780,7 +1816,7 @@ subroutine read_restart_history (File) ! ! Local workspace ! - integer t, f, ff ! tape, field indices + integer t, f, fld, ffld ! tape, file, field indices integer begdim2 ! on-node vert start index integer enddim2 ! on-node vert end index integer begdim1 ! on-node dim1 start index @@ -1893,9 +1929,9 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'nfpath', vdesc) ierr = pio_get_var(File, vdesc, nfpath(1:mtapes)) ierr = pio_inq_varid(File, 'cpath', vdesc) - ierr = pio_get_var(File, vdesc, cpath(1:mtapes)) + ierr = pio_get_var(File, vdesc, cpath(1:mtapes,:)) ierr = pio_inq_varid(File, 'nhfil', vdesc) - ierr = pio_get_var(File, vdesc, nhfil(1:mtapes)) + ierr = pio_get_var(File, vdesc, nhfil(1:mtapes,:)) ierr = pio_inq_varid(File, 'hrestpath', vdesc) ierr = pio_get_var(File, vdesc, hrestpath(1:mtapes)) @@ -2042,67 +2078,68 @@ subroutine read_restart_history (File) call strip_null(nfpath(t)) - call strip_null(cpath(t)) + call strip_null(cpath(t,1)) + call strip_null(cpath(t,2)) call strip_null(hrestpath(t)) allocate(tape(t)%hlist(nflds(t))) - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%field%mdims)) then - deallocate(tape(t)%hlist(f)%field%mdims) + do fld=1,nflds(t) + if (associated(tape(t)%hlist(fld)%field%mdims)) then + deallocate(tape(t)%hlist(fld)%field%mdims) end if - nullify(tape(t)%hlist(f)%field%mdims) - ierr = pio_get_var(File,fillval_desc, (/f,t/), tape(t)%hlist(f)%field%fillvalue) - ierr = pio_get_var(File,meridional_complement_desc, (/f,t/), tape(t)%hlist(f)%field%meridional_complement) - ierr = pio_get_var(File,zonal_complement_desc, (/f,t/), tape(t)%hlist(f)%field%zonal_complement) - tape(t)%hlist(f)%field%field_op(1:field_op_len) = ' ' - ierr = pio_get_var(File,field_op_desc, (/1,f,t/), tape(t)%hlist(f)%field%field_op) - call strip_null(tape(t)%hlist(f)%field%field_op) - ierr = pio_get_var(File,op_field1_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field1_id) - ierr = pio_get_var(File,op_field2_id_desc, (/f,t/), tape(t)%hlist(f)%field%op_field2_id) - ierr = pio_get_var(File,avgflag_desc, (/f,t/), tape(t)%hlist(f)%avgflag) - ierr = pio_get_var(File,longname_desc, (/1,f,t/), tape(t)%hlist(f)%field%long_name) - ierr = pio_get_var(File,units_desc, (/1,f,t/), tape(t)%hlist(f)%field%units) - tape(t)%hlist(f)%field%sampling_seq(1:max_chars) = ' ' - ierr = pio_get_var(File,sseq_desc, (/1,f,t/), tape(t)%hlist(f)%field%sampling_seq) - call strip_null(tape(t)%hlist(f)%field%sampling_seq) - tape(t)%hlist(f)%field%cell_methods(1:max_chars) = ' ' - ierr = pio_get_var(File,cm_desc, (/1,f,t/), tape(t)%hlist(f)%field%cell_methods) - call strip_null(tape(t)%hlist(f)%field%cell_methods) - if(xyfill(f,t) ==1) then - tape(t)%hlist(f)%field%flag_xyfill=.true. + nullify(tape(t)%hlist(fld)%field%mdims) + ierr = pio_get_var(File,fillval_desc, (/fld,t/), tape(t)%hlist(fld)%field%fillvalue) + ierr = pio_get_var(File,meridional_complement_desc, (/fld,t/), tape(t)%hlist(fld)%field%meridional_complement) + ierr = pio_get_var(File,zonal_complement_desc, (/fld,t/), tape(t)%hlist(fld)%field%zonal_complement) + tape(t)%hlist(fld)%field%field_op(1:field_op_len) = ' ' + ierr = pio_get_var(File,field_op_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%field_op) + call strip_null(tape(t)%hlist(fld)%field%field_op) + ierr = pio_get_var(File,op_field1_id_desc, (/fld,t/), tape(t)%hlist(fld)%field%op_field1_id) + ierr = pio_get_var(File,op_field2_id_desc, (/fld,t/), tape(t)%hlist(fld)%field%op_field2_id) + ierr = pio_get_var(File,avgflag_desc, (/fld,t/), tape(t)%hlist(fld)%avgflag) + ierr = pio_get_var(File,longname_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%long_name) + ierr = pio_get_var(File,units_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%units) + tape(t)%hlist(fld)%field%sampling_seq(1:max_chars) = ' ' + ierr = pio_get_var(File,sseq_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%sampling_seq) + call strip_null(tape(t)%hlist(fld)%field%sampling_seq) + tape(t)%hlist(fld)%field%cell_methods(1:max_chars) = ' ' + ierr = pio_get_var(File,cm_desc, (/1,fld,t/), tape(t)%hlist(fld)%field%cell_methods) + call strip_null(tape(t)%hlist(fld)%field%cell_methods) + if(xyfill(fld,t) ==1) then + tape(t)%hlist(fld)%field%flag_xyfill=.true. else - tape(t)%hlist(f)%field%flag_xyfill=.false. + tape(t)%hlist(fld)%field%flag_xyfill=.false. end if - if(is_subcol(f,t) ==1) then - tape(t)%hlist(f)%field%is_subcol=.true. + if(is_subcol(fld,t) ==1) then + tape(t)%hlist(fld)%field%is_subcol=.true. else - tape(t)%hlist(f)%field%is_subcol=.false. + tape(t)%hlist(fld)%field%is_subcol=.false. end if - call strip_null(tmpname(f,t)) - call strip_null(tmpf1name(f,t)) - call strip_null(tmpf2name(f,t)) - tape(t)%hlist(f)%field%name = tmpname(f,t) - tape(t)%hlist(f)%op_field1 = tmpf1name(f,t) - tape(t)%hlist(f)%op_field2 = tmpf2name(f,t) - tape(t)%hlist(f)%field%decomp_type = decomp(f,t) - tape(t)%hlist(f)%field%numlev = tmpnumlev(f,t) - tape(t)%hlist(f)%hwrt_prec = tmpprec(f,t) - tape(t)%hlist(f)%beg_nstep = tmpbeg_nstep(f,t) - call tape(t)%hlist(f)%put_global(tmpintegral(f,t)) + call strip_null(tmpname(fld,t)) + call strip_null(tmpf1name(fld,t)) + call strip_null(tmpf2name(fld,t)) + tape(t)%hlist(fld)%field%name = tmpname(fld,t) + tape(t)%hlist(fld)%op_field1 = tmpf1name(fld,t) + tape(t)%hlist(fld)%op_field2 = tmpf2name(fld,t) + tape(t)%hlist(fld)%field%decomp_type = decomp(fld,t) + tape(t)%hlist(fld)%field%numlev = tmpnumlev(fld,t) + tape(t)%hlist(fld)%hwrt_prec = tmpprec(fld,t) + tape(t)%hlist(fld)%beg_nstep = tmpbeg_nstep(fld,t) + call tape(t)%hlist(fld)%put_global(tmpintegral(fld,t)) ! If the field is an advected constituent set the mixing_ratio attribute - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) call cnst_get_ind(fname_tmp, idx, abort=.false.) mixing_ratio = '' if (idx > 0) then mixing_ratio = cnst_get_type_byind(idx) end if - tape(t)%hlist(f)%field%mixing_ratio = mixing_ratio + tape(t)%hlist(fld)%field%mixing_ratio = mixing_ratio - mdimcnt = count(allmdims(:,f,t) > 0) + mdimcnt = count(allmdims(:,fld,t) > 0) if(mdimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(mdimcnt)) + allocate(tape(t)%hlist(fld)%field%mdims(mdimcnt)) do i = 1, mdimcnt - tape(t)%hlist(f)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,f,t))) + tape(t)%hlist(fld)%field%mdims(i) = get_hist_coord_index(mdimnames(allmdims(i,fld,t))) end do end if end do @@ -2117,57 +2154,60 @@ subroutine read_restart_history (File) allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 do t = 1, ptapes - do f = 1, nflds(t) - call set_field_dimensions(tape(t)%hlist(f)%field) - - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 - - allocate(tape(t)%hlist(f)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) - if (tape(t)%hlist(f)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev - allocate(tape(t)%hlist(f)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + do fld = 1, nflds(t) + if (tape(t)%hlist(fld)%avgflag .ne. 'I') then + hfile_accum(t) = .true. + end if + call set_field_dimensions(tape(t)%hlist(fld)%field) + + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 + + allocate(tape(t)%hlist(fld)%hbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) + if (tape(t)%hlist(fld)%avgflag .eq. 'S') then ! allocate the variance buffer for standard dev + allocate(tape(t)%hlist(fld)%sbuf(begdim1:enddim1,begdim2:enddim2,begdim3:enddim3)) endif - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) + if (associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) end if - nullify(tape(t)%hlist(f)%varid) - if (associated(tape(t)%hlist(f)%nacs)) then - deallocate(tape(t)%hlist(f)%nacs) + nullify(tape(t)%hlist(fld)%varid) + if (associated(tape(t)%hlist(fld)%nacs)) then + deallocate(tape(t)%hlist(fld)%nacs) end if - nullify(tape(t)%hlist(f)%nacs) - if(tape(t)%hlist(f)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then - allocate (tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) + nullify(tape(t)%hlist(fld)%nacs) + if(tape(t)%hlist(fld)%field%flag_xyfill .or. (avgflag_pertape(t)=='L')) then + allocate (tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) + allocate(tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) end if ! initialize all buffers to zero - this will be overwritten later by the ! data in the history restart file if it exists. - call h_zero(f,t) + call h_zero(fld,t) ! Make sure this field's decomp is listed on the tape - fdecomp = tape(t)%hlist(f)%field%decomp_type - do ff = 1, size(gridsontape, 1) - if (fdecomp == gridsontape(ff, t)) then + fdecomp = tape(t)%hlist(fld)%field%decomp_type + do ffld = 1, size(gridsontape, 1) + if (fdecomp == gridsontape(ffld, t)) then exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = fdecomp + else if (gridsontape(ffld, t) < 0) then + gridsontape(ffld, t) = fdecomp exit end if end do ! !rebuild area wt array and set field wbuf pointer ! - if (tape(t)%hlist(f)%avgflag .eq. 'N') then ! set up area weight buffer - nullify(tape(t)%hlist(f)%wbuf) + if (tape(t)%hlist(fld)%avgflag .eq. 'N') then ! set up area weight buffer + nullify(tape(t)%hlist(fld)%wbuf) - if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(f)%field%decomp_type)) then + if (any(allgrids_wt(:)%decomp_type == tape(t)%hlist(fld)%field%decomp_type)) then wtidx=MAXLOC(allgrids_wt(:)%decomp_type, MASK = allgrids_wt(:)%decomp_type .EQ. fdecomp) - tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf else ! area weights not found for this grid, then create them ! first check for an available spot in the array @@ -2181,7 +2221,7 @@ subroutine read_restart_history (File) allocate(allgrids_wt(wtidx(1))%wbuf(begdim1:enddim1,begdim3:enddim3)) cnt=0 do c=begdim3,enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) + dimind = tape(t)%hlist(fld)%field%get_dims(c) ib=dimind%beg1 ie=dimind%end1 do i=ib,ie @@ -2189,7 +2229,7 @@ subroutine read_restart_history (File) allgrids_wt(wtidx(1))%wbuf(i,c)=areawt(cnt) end do end do - tape(t)%hlist(f)%wbuf => allgrids_wt(wtidx(1))%wbuf + tape(t)%hlist(fld)%wbuf => allgrids_wt(wtidx(1))%wbuf endif endif end do @@ -2215,21 +2255,21 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, 0) + call cam_pio_openfile(tape(t)%Files(restart_file_index), locfn, 0) ! ! Read history restart file ! - do f = 1, nflds(t) + do fld = 1, nflds(t) - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) if(masterproc) write(iulog, *) 'Reading history variable ',fname_tmp - ierr = pio_inq_varid(tape(t)%File, fname_tmp, vdesc) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), fname_tmp, vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, ndims, dimids, dimlens) - call cam_pio_var_info(tape(t)%File, vdesc, ndims, dimids, dimlens) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then + if(.not. associated(tape(t)%hlist(fld)%field%mdims)) then dimcnt = 0 do i=1,ndims - ierr = pio_inq_dimname(tape(t)%File, dimids(i), dname_tmp) + ierr = pio_inq_dimname(tape(t)%Files(restart_file_index), dimids(i), dname_tmp) dimid = get_hist_coord_index(dname_tmp) if(dimid >= 1) then dimcnt = dimcnt + 1 @@ -2238,20 +2278,20 @@ subroutine read_restart_history (File) end if end do if(dimcnt > 0) then - allocate(tape(t)%hlist(f)%field%mdims(dimcnt)) - tape(t)%hlist(f)%field%mdims(:) = tmpdims(1:dimcnt) + allocate(tape(t)%hlist(fld)%field%mdims(dimcnt)) + tape(t)%hlist(fld)%field%mdims(:) = tmpdims(1:dimcnt) if(dimcnt > maxvarmdims) maxvarmdims=dimcnt end if end if - call set_field_dimensions(tape(t)%hlist(f)%field) - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 + call set_field_dimensions(tape(t)%hlist(fld)%field) + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 fdims(1) = enddim1 - begdim1 + 1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 fdims(2) = enddim2 - begdim2 + 1 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 fdims(3) = enddim3 - begdim3 + 1 if (fdims(2) > 1) then nfdims = 3 @@ -2259,69 +2299,69 @@ subroutine read_restart_history (File) nfdims = 2 fdims(2) = fdims(3) end if - fdecomp = tape(t)%hlist(f)%field%decomp_type + fdecomp = tape(t)%hlist(fld)%field%decomp_type if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf, vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%hbuf, vdesc) else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%hbuf(:,1,:), vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%hbuf(:,1,:), vdesc) end if - if ( associated(tape(t)%hlist(f)%sbuf) ) then + if ( associated(tape(t)%hlist(fld)%sbuf) ) then ! read in variance for standard deviation - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_var', vdesc) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_var', vdesc) if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf, vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%sbuf, vdesc) else - call cam_grid_read_dist_array(tape(t)%File, fdecomp, & - fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(f)%sbuf(:,1,:), vdesc) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%sbuf(:,1,:), vdesc) end if endif - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, nacsdimcnt, dimids, dimlens) if(nacsdimcnt > 0) then if (nfdims > 2) then ! nacs only has 2 dims (no levels) fdims(2) = fdims(3) end if - allocate(tape(t)%hlist(f)%nacs(begdim1:enddim1,begdim3:enddim3)) - nacs => tape(t)%hlist(f)%nacs(:,:) - call cam_grid_read_dist_array(tape(t)%File, fdecomp, fdims(1:2), & + allocate(tape(t)%hlist(fld)%nacs(begdim1:enddim1,begdim3:enddim3)) + nacs => tape(t)%hlist(fld)%nacs(:,:) + call cam_grid_read_dist_array(tape(t)%Files(restart_file_index), fdecomp, fdims(1:2), & dimlens(1:nacsdimcnt), nacs, vdesc) else - allocate(tape(t)%hlist(f)%nacs(1,begdim3:enddim3)) - ierr = pio_get_var(tape(t)%File, vdesc, nacsval) - tape(t)%hlist(f)%nacs(1,:)= nacsval + allocate(tape(t)%hlist(fld)%nacs(1,begdim3:enddim3)) + ierr = pio_get_var(tape(t)%Files(restart_file_index), vdesc, nacsval) + tape(t)%hlist(fld)%nacs(1,:)= nacsval end if - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%File, vdesc, nacsdimcnt, dimids, dimlens) + ierr = pio_inq_varid(tape(t)%Files(restart_file_index), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(restart_file_index), vdesc, nacsdimcnt, dimids, dimlens) end do ! ! Done reading this history restart file ! - call cam_pio_closefile(tape(t)%File) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) end if ! rgnht(t) ! (re)create the master list of grid IDs - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 + ffld = 0 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + ffld = ffld + 1 end if end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 + allocate(tape(t)%grid_ids(ffld)) + ffld = 1 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + tape(t)%grid_ids(ffld) = gridsontape(fld, t) + ffld = ffld + 1 end if end do call patch_init(t) @@ -2333,7 +2373,6 @@ subroutine read_restart_history (File) ! ! NOTE: No need to perform this operation for IC history files or empty files ! - do t=1,mtapes if (is_initfile(file_index=t)) then ! Initialize filename specifier for IC file @@ -2343,13 +2382,19 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then - call getfil (cpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, PIO_WRITE) + ! Always create the instantaneous file + call getfil (cpath(t,instantaneous_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) + if (hfile_accum(t)) then + ! Conditionally create the accumulated file + call getfil (cpath(t,accumulated_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) + end if call h_inquire (t) if(is_satfile(t)) then ! Initialize the sat following history subsystem call sat_hist_init() - call sat_hist_define(tape(t)%File) + call sat_hist_define(tape(t)%Files(sat_file_index)) end if end if ! @@ -2357,13 +2402,21 @@ subroutine read_restart_history (File) ! if (nfils(t) >= mfilt(t)) then if (masterproc) then - write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t), mfilt(t) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,f), mfilt(t) + end if + end do end if - do f=1,nflds(t) - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) + end do + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_closefile(tape(t)%Files(f)) + end if end do - call cam_pio_closefile(tape(t)%File) nfils(t) = 0 end if end if @@ -2381,7 +2434,7 @@ end subroutine read_restart_history !####################################################################### - character(len=max_string_len) function get_hfilepath( tape ) + character(len=max_string_len) function get_hfilepath( tape, accumulated_flag ) ! !----------------------------------------------------------------------- ! @@ -2392,8 +2445,14 @@ character(len=max_string_len) function get_hfilepath( tape ) !----------------------------------------------------------------------- ! integer, intent(in) :: tape ! Tape number + logical, intent(in) :: accumulated_flag ! True if calling routine wants the accumulated + ! file path, False for instantaneous - get_hfilepath = cpath( tape ) + if (accumulated_flag) then + get_hfilepath = cpath( tape, accumulated_file_index ) + else + get_hfilepath = cpath( tape, instantaneous_file_index ) + end if end function get_hfilepath !####################################################################### @@ -2464,7 +2523,7 @@ subroutine AvgflagToString(avgflag, time_op) case ('N') time_op(:) = 'mean_over_nsteps' case ('I') - time_op(:) = ' ' + time_op(:) = 'point' case ('X') time_op(:) = 'maximum' case ('M') @@ -2497,8 +2556,8 @@ subroutine fldlst () ! !---------------------------Local variables----------------------------- ! - integer t, f ! tape, field indices - integer ff ! index into include, exclude and fprec list + integer t, fld ! tape, field indices + integer ffld ! index into include, exclude and fprec list integer :: i character(len=fieldname_len) :: name ! field name portion of fincl (i.e. no avgflag separator) character(len=max_fieldname_len) :: mastername ! name from masterlist field @@ -2539,24 +2598,24 @@ subroutine fldlst () errors_found = 0 do t=1,ptapes - f = 1 + fld = 1 n_vec_comp = 0 vec_comp_names = ' ' vec_comp_avgflag = ' ' -fincls: do while (f < pflds .and. fincl(f,t) /= ' ') - name = getname (fincl(f,t)) +fincls: do while (fld < pflds .and. fincl(fld,t) /= ' ') + name = getname (fincl(fld,t)) if (.not. dycore_is('FV')) then ! filter out fields only provided by FV dycore do i = 1, n_fv_only if (name == fv_only_flds(i)) then write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), & - ' in fincl(', f,', ',t, ') only available with FV dycore' + ' in fincl(', fld,', ',t, ') only available with FV dycore' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) end if - f = f + 1 + fld = fld + 1 cycle fincls end if end do @@ -2566,7 +2625,7 @@ subroutine fldlst () listentry => get_entry_by_name(masterlinkedlist, name) if (associated(listentry)) mastername = listentry%field%name if (name /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', f,', ',t, ') not found' + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(name), ' in fincl(', fld,', ',t, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) @@ -2576,7 +2635,7 @@ subroutine fldlst () if (len_trim(mastername)>0 .and. interpolate_output(t)) then if (n_vec_comp >= nvecmax) call endrun('FLDLST: need to increase nvecmax') ! If this is a vector component then save the name of the complement - avgflag = getflag(fincl(f,t)) + avgflag = getflag(fincl(fld,t)) if (len_trim(listentry%meridional_field) > 0) then n_vec_comp = n_vec_comp + 1 vec_comp_names(n_vec_comp) = listentry%meridional_field @@ -2588,7 +2647,7 @@ subroutine fldlst () end if end if end if - f = f + 1 + fld = fld + 1 end do fincls ! Interpolation of vector components requires that both be present. If the fincl @@ -2596,12 +2655,12 @@ subroutine fldlst () ! array vec_comp_names. Next insure (for interpolated output only) that all complements ! are also present in the fincl array. - ! The first empty slot in the current fincl array is index f from loop above. - add_fincl_idx = f - if (f > 1 .and. interpolate_output(t)) then + ! The first empty slot in the current fincl array is index fld from loop above. + add_fincl_idx = fld + if (fld > 1 .and. interpolate_output(t)) then do i = 1, n_vec_comp - call list_index(fincl(:,t), vec_comp_names(i), ff) - if (ff == 0) then + call list_index(fincl(:,t), vec_comp_names(i), ffld) + if (ffld == 0) then ! Add vector component to fincl. Don't need to check whether its in the master ! list since this was done at the time of registering the vector components. @@ -2620,39 +2679,39 @@ subroutine fldlst () end do end if - f = 1 - do while (f < pflds .and. fexcl(f,t) /= ' ') + fld = 1 + do while (fld < pflds .and. fexcl(fld,t) /= ' ') mastername='' - listentry => get_entry_by_name(masterlinkedlist, fexcl(f,t)) + listentry => get_entry_by_name(masterlinkedlist, fexcl(fld,t)) if(associated(listentry)) mastername = listentry%field%name - if (fexcl(f,t) /= mastername) then - write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(f,t)), ' in fexcl(', f,', ',t, ') not found' + if (fexcl(fld,t) /= mastername) then + write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(fld,t)), ' in fexcl(', fld,', ',t, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) end if errors_found = errors_found + 1 end if - f = f + 1 + fld = fld + 1 end do - f = 1 - do while (f < pflds .and. fwrtpr(f,t) /= ' ') - name = getname (fwrtpr(f,t)) + fld = 1 + do while (fld < pflds .and. fwrtpr(fld,t) /= ' ') + name = getname (fwrtpr(fld,t)) mastername='' listentry => get_entry_by_name(masterlinkedlist, name) if(associated(listentry)) mastername = listentry%field%name if (name /= mastername) then - write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', f, ') not found' + write(errormsg,'(3a,i0,a)')'FLDLST: ', trim(name), ' in fwrtpr(', fld, ') not found' if (masterproc) then write(iulog,*) trim(errormsg) call shr_sys_flush(iulog) end if errors_found = errors_found + 1 end if - do ff=1,f-1 ! If duplicate entry is found, stop - if (trim(name) == trim(getname(fwrtpr(ff,t)))) then + do ffld=1,fld-1 ! If duplicate entry is found, stop + if (trim(name) == trim(getname(fwrtpr(ffld,t)))) then write(errormsg,'(3a)')'FLDLST: Duplicate field ', trim(name), ' in fwrtpr' if (masterproc) then write(iulog,*) trim(errormsg) @@ -2661,7 +2720,7 @@ subroutine fldlst () errors_found = errors_found + 1 end if end do - f = f + 1 + fld = fld + 1 end do end do @@ -2699,14 +2758,14 @@ subroutine fldlst () listentry => masterlinkedlist do while(associated(listentry)) mastername = listentry%field%name - call list_index (fincl(1,t), mastername, ff) + call list_index (fincl(1,t), mastername, ffld) fieldontape = .false. - if (ff > 0) then + if (ffld > 0) then fieldontape = .true. else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then + call list_index (fexcl(1,t), mastername, ffld) + if (ffld == 0 .and. listentry%actflag(t)) then fieldontape = .true. end if end if @@ -2714,11 +2773,11 @@ subroutine fldlst () ! The field is active so increment the number fo fields and add ! its decomp type to the list of decomp types on this tape nflds(t) = nflds(t) + 1 - do ff = 1, size(gridsontape, 1) - if (listentry%field%decomp_type == gridsontape(ff, t)) then + do ffld = 1, size(gridsontape, 1) + if (listentry%field%decomp_type == gridsontape(ffld, t)) then exit - else if (gridsontape(ff, t) < 0) then - gridsontape(ff, t) = listentry%field%decomp_type + else if (gridsontape(ffld, t) < 0) then + gridsontape(ffld, t) = listentry%field%decomp_type exit end if end do @@ -2747,27 +2806,27 @@ subroutine fldlst () ! Allocate the correct number of hentry slots allocate(tape(t)%hlist(nflds(t))) ! Count up the number of grids output on this tape - ff = 0 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - ff = ff + 1 + ffld = 0 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + ffld = ffld + 1 end if end do - allocate(tape(t)%grid_ids(ff)) - ff = 1 - do f = 1, size(gridsontape, 1) - if (gridsontape(f, t) > 0) then - tape(t)%grid_ids(ff) = gridsontape(f, t) - ff = ff + 1 + allocate(tape(t)%grid_ids(ffld)) + ffld = 1 + do fld = 1, size(gridsontape, 1) + if (gridsontape(fld, t) > 0) then + tape(t)%grid_ids(ffld) = gridsontape(fld, t) + ffld = ffld + 1 end if end do end if - do ff=1,nflds(t) - nullify(tape(t)%hlist(ff)%hbuf) - nullify(tape(t)%hlist(ff)%sbuf) - nullify(tape(t)%hlist(ff)%wbuf) - nullify(tape(t)%hlist(ff)%nacs) - nullify(tape(t)%hlist(ff)%varid) + do ffld=1,nflds(t) + nullify(tape(t)%hlist(ffld)%hbuf) + nullify(tape(t)%hlist(ffld)%sbuf) + nullify(tape(t)%hlist(ffld)%wbuf) + nullify(tape(t)%hlist(ffld)%nacs) + nullify(tape(t)%hlist(ffld)%varid) end do @@ -2776,21 +2835,21 @@ subroutine fldlst () do while(associated(listentry)) mastername = listentry%field%name - call list_index (fwrtpr(1,t), mastername, ff) - if (ff > 0) then - prec_wrt = getflag(fwrtpr(ff,t)) + call list_index (fwrtpr(1,t), mastername, ffld) + if (ffld > 0) then + prec_wrt = getflag(fwrtpr(ffld,t)) else prec_wrt = ' ' end if - call list_index (fincl(1,t), mastername, ff) + call list_index (fincl(1,t), mastername, ffld) - if (ff > 0) then - avgflag = getflag (fincl(ff,t)) + if (ffld > 0) then + avgflag = getflag (fincl(ffld,t)) call inifld (t, listentry, avgflag, prec_wrt) else if ((.not. empty_htapes) .or. (is_initfile(file_index=t))) then - call list_index (fexcl(1,t), mastername, ff) - if (ff == 0 .and. listentry%actflag(t)) then + call list_index (fexcl(1,t), mastername, ffld) + if (ffld == 0 .and. listentry%actflag(t)) then call inifld (t, listentry, ' ', prec_wrt) else listentry%actflag(t) = .false. @@ -2816,30 +2875,30 @@ subroutine fldlst () ! entries for efficiency in OUTFLD. Simple bubble sort. ! !!XXgoldyXX: v In the future, we will sort according to decomp to speed I/O - do f=nflds(t)-1,1,-1 - do ff=1,f + do fld=nflds(t)-1,1,-1 + do ffld=1,fld - if (tape(t)%hlist(ff)%field%numlev > tape(t)%hlist(ff+1)%field%numlev) then - tmp = tape(t)%hlist(ff) - tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) - tape(t)%hlist(ff+1) = tmp + if (tape(t)%hlist(ffld)%field%numlev > tape(t)%hlist(ffld+1)%field%numlev) then + tmp = tape(t)%hlist(ffld) + tape(t)%hlist(ffld ) = tape(t)%hlist(ffld+1) + tape(t)%hlist(ffld+1) = tmp end if end do - do ff=1,f + do ffld=1,fld - if ((tape(t)%hlist(ff)%field%numlev == tape(t)%hlist(ff+1)%field%numlev) .and. & - (tape(t)%hlist(ff)%field%name > tape(t)%hlist(ff+1)%field%name)) then + if ((tape(t)%hlist(ffld)%field%numlev == tape(t)%hlist(ffld+1)%field%numlev) .and. & + (tape(t)%hlist(ffld)%field%name > tape(t)%hlist(ffld+1)%field%name)) then - tmp = tape(t)%hlist(ff) - tape(t)%hlist(ff ) = tape(t)%hlist(ff+1) - tape(t)%hlist(ff+1) = tmp + tmp = tape(t)%hlist(ffld) + tape(t)%hlist(ffld ) = tape(t)%hlist(ffld+1) + tape(t)%hlist(ffld+1) = tmp - else if (tape(t)%hlist(ff )%field%name == tape(t)%hlist(ff+1)%field%name) then + else if (tape(t)%hlist(ffld)%field%name == tape(t)%hlist(ffld+1)%field%name) then write(errormsg,'(2a,2(a,i3))') 'FLDLST: Duplicate field: ', & - trim(tape(t)%hlist(ff)%field%name),', tape = ', t, ', ff = ', ff + trim(tape(t)%hlist(ffld)%field%name),', tape = ', t, ', ffld = ', ffld call endrun(errormsg) end if @@ -2883,7 +2942,7 @@ end subroutine fldlst subroutine print_active_fldlst() - integer :: f, ff, i, t + integer :: fld, ffld, i, t integer :: num_patches character(len=6) :: prec_str @@ -2899,7 +2958,7 @@ subroutine print_active_fldlst() if (nflds(t) > 0) then write(iulog,*) ' ' - write(iulog,*)'FLDLST: History file ', t, ' contains ', nflds(t), ' fields' + write(iulog,*)'FLDLST: History stream ', t, ' contains ', nflds(t), ' fields' if (is_initfile(file_index=t)) then write(iulog,*) ' Write frequency: ',inithist,' (INITIAL CONDITIONS)' @@ -2934,23 +2993,23 @@ subroutine print_active_fldlst() end if - do f = 1, nflds(t) + do fld = 1, nflds(t) if (associated(hfile(t)%patches)) then num_patches = size(hfile(t)%patches) - fldname = strip_suffix(hfile(t)%hlist(f)%field%name) + fldname = strip_suffix(hfile(t)%hlist(fld)%field%name) do i = 1, num_patches - ff = (f-1)*num_patches + i + ffld = (fld-1)*num_patches + i fname_tmp = trim(fldname) call hfile(t)%patches(i)%field_name(fname_tmp) - write(iulog,9000) ff, fname_tmp, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) + write(iulog,9000) ffld, fname_tmp, hfile(t)%hlist(fld)%field%units, & + hfile(t)%hlist(fld)%field%numlev, hfile(t)%hlist(fld)%avgflag, & + trim(hfile(t)%hlist(fld)%field%long_name) end do else - fldname = hfile(t)%hlist(f)%field%name - write(iulog,9000) f, fldname, hfile(t)%hlist(f)%field%units, & - hfile(t)%hlist(f)%field%numlev, hfile(t)%hlist(f)%avgflag, & - trim(hfile(t)%hlist(f)%field%long_name) + fldname = hfile(t)%hlist(fld)%field%name + write(iulog,9000) fld, fldname, hfile(t)%hlist(fld)%field%units, & + hfile(t)%hlist(fld)%field%numlev, hfile(t)%hlist(fld)%avgflag, & + trim(hfile(t)%hlist(fld)%field%long_name) end if end do @@ -3547,7 +3606,7 @@ end subroutine subcol_field_avg_handler ! ! Local variables ! - integer :: t, f ! tape, field indices + integer :: t, fld ! tape, field indices character*1 :: avgflag ! averaging flag @@ -3584,30 +3643,30 @@ end subroutine subcol_field_avg_handler ! write(iulog,*)'fname_loc=',fname_loc do t = 1, ptapes if ( .not. masterlist(ff)%thisentry%actflag(t)) cycle - f = masterlist(ff)%thisentry%htapeindx(t) + fld = masterlist(ff)%thisentry%htapeindx(t) ! ! Update history buffer ! - flag_xyfill = otape(t)%hlist(f)%field%flag_xyfill - fillvalue = otape(t)%hlist(f)%field%fillvalue - avgflag = otape(t)%hlist(f)%avgflag - nacs => otape(t)%hlist(f)%nacs(:,c) - hbuf => otape(t)%hlist(f)%hbuf(:,:,c) - if (associated(tape(t)%hlist(f)%wbuf)) then - wbuf => otape(t)%hlist(f)%wbuf(:,c) + flag_xyfill = otape(t)%hlist(fld)%field%flag_xyfill + fillvalue = otape(t)%hlist(fld)%field%fillvalue + avgflag = otape(t)%hlist(fld)%avgflag + nacs => otape(t)%hlist(fld)%nacs(:,c) + hbuf => otape(t)%hlist(fld)%hbuf(:,:,c) + if (associated(tape(t)%hlist(fld)%wbuf)) then + wbuf => otape(t)%hlist(fld)%wbuf(:,c) endif - if (associated(tape(t)%hlist(f)%sbuf)) then - sbuf => otape(t)%hlist(f)%sbuf(:,:,c) + if (associated(tape(t)%hlist(fld)%sbuf)) then + sbuf => otape(t)%hlist(fld)%sbuf(:,:,c) endif - dimind = otape(t)%hlist(f)%field%get_dims(c) + dimind = otape(t)%hlist(fld)%field%get_dims(c) ! See notes above about validity of avg_subcol_field - if (otape(t)%hlist(f)%field%is_subcol) then + if (otape(t)%hlist(fld)%field%is_subcol) then if (present(avg_subcol_field)) then call endrun('OUTFLD: Cannot average '//trim(fname)//', subcolumn output was requested in addfld') end if avg_subcols = .false. - else if (otape(t)%hlist(f)%field%decomp_type == phys_decomp) then + else if (otape(t)%hlist(fld)%field%decomp_type == phys_decomp) then if (present(avg_subcol_field)) then avg_subcols = avg_subcol_field else @@ -3621,15 +3680,15 @@ end subroutine subcol_field_avg_handler end if end if - begdim2 = otape(t)%hlist(f)%field%begdim2 - enddim2 = otape(t)%hlist(f)%field%enddim2 + begdim2 = otape(t)%hlist(fld)%field%begdim2 + enddim2 = otape(t)%hlist(fld)%field%enddim2 if (avg_subcols) then allocate(afield(pcols, begdim2:enddim2)) call subcol_field_avg_handler(idim, field, c, afield) ! Hack! Avoid duplicating select statement below call outfld(fname, afield, pcols, c) deallocate(afield) - else if (otape(t)%hlist(f)%field%is_subcol) then + else if (otape(t)%hlist(fld)%field%is_subcol) then ! We have to assume that using mdimnames (e.g., psubcols) is ! incompatible with the begdimx, enddimx usage (checked in addfld) ! Since psubcols is included in levels, take that out @@ -3684,7 +3743,7 @@ end subroutine subcol_field_avg_handler case ('L') call hbuf_accum_addlcltime(hbuf, ufield, nacs, dimind, pcols, & flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & + otape(t)%hlist(fld)%field%decomp_type, & lcltod_start(t), lcltod_stop(t)) case ('S') ! Standard deviation @@ -3726,7 +3785,7 @@ end subroutine subcol_field_avg_handler case ('L') call hbuf_accum_addlcltime(hbuf, field, nacs, dimind, idim, & flag_xyfill, fillvalue, c, & - otape(t)%hlist(f)%field%decomp_type, & + otape(t)%hlist(fld)%field%decomp_type, & lcltod_start(t), lcltod_stop(t)) case ('S') ! Standard deviation @@ -3921,7 +3980,7 @@ subroutine h_inquire (t) ! ! Local workspace ! - integer :: f ! field index + integer :: f, fld ! file, field index integer :: ierr integer :: i integer :: num_patches @@ -3934,103 +3993,118 @@ subroutine h_inquire (t) ! tape => history_tape - - ! ! Create variables for model timing and header information ! - if(.not. is_satfile(t)) then - ierr=pio_inq_varid (tape(t)%File,'ndcur ', tape(t)%ndcurid) - ierr=pio_inq_varid (tape(t)%File,'nscur ', tape(t)%nscurid) - ierr=pio_inq_varid (tape(t)%File,'nsteph ', tape(t)%nstephid) - - ierr=pio_inq_varid (tape(t)%File,'time_bnds', tape(t)%tbndid) - ierr=pio_inq_varid (tape(t)%File,'date_written',tape(t)%date_writtenid) - ierr=pio_inq_varid (tape(t)%File,'time_written',tape(t)%time_writtenid) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + if(.not. is_satfile(t)) then + if (f == instantaneous_file_index) then + ierr=pio_inq_varid (tape(t)%Files(f),'ndcur ', tape(t)%ndcurid) + ierr=pio_inq_varid (tape(t)%Files(f),'nscur ', tape(t)%nscurid) + ierr=pio_inq_varid (tape(t)%Files(f),'nsteph ', tape(t)%nstephid) + end if + ierr=pio_inq_varid (tape(t)%Files(f),'time_bounds', tape(t)%tbndid) + ierr=pio_inq_varid (tape(t)%Files(f),'date_written', tape(t)%date_writtenid) + ierr=pio_inq_varid (tape(t)%Files(f),'time_written', tape(t)%time_writtenid) #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_inq_varid (tape(t)%File,'tsec ',tape(t)%tsecid) - ierr=pio_inq_varid (tape(t)%File,'bdate ',tape(t)%bdateid) + ierr=pio_inq_varid (tape(t)%Files(f),'tsec ',tape(t)%tsecid) + ierr=pio_inq_varid (tape(t)%Files(f),'bdate ',tape(t)%bdateid) #endif - if (.not. is_initfile(file_index=t) ) then - ! Don't write the GHG/Solar forcing data to the IC file. It is never - ! read from that file so it's confusing to have it there. - ierr=pio_inq_varid (tape(t)%File,'co2vmr ', tape(t)%co2vmrid) - ierr=pio_inq_varid (tape(t)%File,'ch4vmr ', tape(t)%ch4vmrid) - ierr=pio_inq_varid (tape(t)%File,'n2ovmr ', tape(t)%n2ovmrid) - ierr=pio_inq_varid (tape(t)%File,'f11vmr ', tape(t)%f11vmrid) - ierr=pio_inq_varid (tape(t)%File,'f12vmr ', tape(t)%f12vmrid) - ierr=pio_inq_varid (tape(t)%File,'sol_tsi ', tape(t)%sol_tsiid) - if (solar_parms_on) then - ierr=pio_inq_varid (tape(t)%File,'f107 ', tape(t)%f107id) - ierr=pio_inq_varid (tape(t)%File,'f107a ', tape(t)%f107aid) - ierr=pio_inq_varid (tape(t)%File,'f107p ', tape(t)%f107pid) - ierr=pio_inq_varid (tape(t)%File,'kp ', tape(t)%kpid) - ierr=pio_inq_varid (tape(t)%File,'ap ', tape(t)%apid) - endif - if (solar_wind_on) then - ierr=pio_inq_varid (tape(t)%File,'byimf', tape(t)%byimfid) - ierr=pio_inq_varid (tape(t)%File,'bzimf', tape(t)%bzimfid) - ierr=pio_inq_varid (tape(t)%File,'swvel', tape(t)%swvelid) - ierr=pio_inq_varid (tape(t)%File,'swden', tape(t)%swdenid) - endif - if (epot_active) then - ierr=pio_inq_varid (tape(t)%File,'colat_crit1', tape(t)%colat_crit1_id) - ierr=pio_inq_varid (tape(t)%File,'colat_crit2', tape(t)%colat_crit2_id) - endif - end if - end if - ierr=pio_inq_varid (tape(t)%File,'date ', tape(t)%dateid) - ierr=pio_inq_varid (tape(t)%File,'datesec ', tape(t)%datesecid) - ierr=pio_inq_varid (tape(t)%File,'time ', tape(t)%timeid) - + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. It is never + ! read from that file so it's confusing to have it there. + ! Only write the GHG/Solar forcing data to the instantaneous file + ierr=pio_inq_varid (tape(t)%Files(f),'co2vmr ', tape(t)%co2vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'ch4vmr ', tape(t)%ch4vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'n2ovmr ', tape(t)%n2ovmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'f11vmr ', tape(t)%f11vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'f12vmr ', tape(t)%f12vmrid) + ierr=pio_inq_varid (tape(t)%Files(f),'sol_tsi ', tape(t)%sol_tsiid) + if (solar_parms_on) then + ierr=pio_inq_varid (tape(t)%Files(f),'f107 ', tape(t)%f107id) + ierr=pio_inq_varid (tape(t)%Files(f),'f107a ', tape(t)%f107aid) + ierr=pio_inq_varid (tape(t)%Files(f),'f107p ', tape(t)%f107pid) + ierr=pio_inq_varid (tape(t)%Files(f),'kp ', tape(t)%kpid) + ierr=pio_inq_varid (tape(t)%Files(f),'ap ', tape(t)%apid) + endif + if (solar_wind_on) then + ierr=pio_inq_varid (tape(t)%Files(f),'byimf', tape(t)%byimfid) + ierr=pio_inq_varid (tape(t)%Files(f),'bzimf', tape(t)%bzimfid) + ierr=pio_inq_varid (tape(t)%Files(f),'swvel', tape(t)%swvelid) + ierr=pio_inq_varid (tape(t)%Files(f),'swden', tape(t)%swdenid) + endif + if (epot_active) then + ierr=pio_inq_varid (tape(t)%Files(f),'colat_crit1', tape(t)%colat_crit1_id) + ierr=pio_inq_varid (tape(t)%Files(f),'colat_crit2', tape(t)%colat_crit2_id) + endif + end if + end if + ierr=pio_inq_varid (tape(t)%Files(f),'date ', tape(t)%dateid) + ierr=pio_inq_varid (tape(t)%Files(f),'datesec ', tape(t)%datesecid) + ierr=pio_inq_varid (tape(t)%Files(f),'time ', tape(t)%timeid) + + ! + ! Obtain variable name from ID which was read from restart file + ! + do fld=1,nflds(t) + if (f == accumulated_file_index) then + ! this is the accumulated file - skip instantaneous fields + if (tape(t)%hlist(fld)%avgflag == 'I') then + cycle + end if + else + ! this is the instantaneous file - skip accumulated fields + if (tape(t)%hlist(fld)%avgflag /= 'I') then + cycle + end if + end if - ! - ! Obtain variable name from ID which was read from restart file - ! - do f=1,nflds(t) - if(.not. associated(tape(t)%hlist(f)%varid)) then - if (associated(tape(t)%patches)) then - allocate(tape(t)%hlist(f)%varid(size(tape(t)%patches))) - else - allocate(tape(t)%hlist(f)%varid(1)) - end if - end if - ! - ! If this field will be put out as columns then get column names for field - ! - if (associated(tape(t)%patches)) then - num_patches = size(tape(t)%patches) - fldname = strip_suffix(tape(t)%hlist(f)%field%name) - do i = 1, num_patches - fname_tmp = trim(fldname) - call tape(t)%patches(i)%field_name(fname_tmp) - ierr = pio_inq_varid(tape(t)%File, trim(fname_tmp), tape(t)%hlist(f)%varid(i)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) - ierr = pio_get_att(tape(t)%File, tape(t)%hlist(f)%varid(i), 'basename', basename) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) - if (trim(fldname) /= trim(basename)) then - call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') - end if - end do - else - fldname = tape(t)%hlist(f)%field%name - ierr = pio_inq_varid(tape(t)%File, trim(fldname), tape(t)%hlist(f)%varid(1)) - call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) - end if - if(tape(t)%hlist(f)%field%numlev>1) then - ierr = pio_inq_attlen(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', mdimsize) - if(.not. associated(tape(t)%hlist(f)%field%mdims)) then - allocate(tape(t)%hlist(f)%field%mdims(mdimsize)) - end if - ierr=pio_get_att(tape(t)%File,tape(t)%hlist(f)%varid(1),'mdims', & - tape(t)%hlist(f)%field%mdims(1:mdimsize)) - if(mdimsize > int(maxvarmdims, kind=pio_offset_kind)) then - maxvarmdims = int(mdimsize) - end if - end if + if(.not. associated(tape(t)%hlist(fld)%varid)) then + if (associated(tape(t)%patches)) then + allocate(tape(t)%hlist(fld)%varid(size(tape(t)%patches))) + else + allocate(tape(t)%hlist(fld)%varid(1)) + end if + end if + ! + ! If this field will be put out as columns then get column names for field + ! + if (associated(tape(t)%patches)) then + num_patches = size(tape(t)%patches) + fldname = strip_suffix(tape(t)%hlist(fld)%field%name) + do i = 1, num_patches + fname_tmp = trim(fldname) + call tape(t)%patches(i)%field_name(fname_tmp) + ierr = pio_inq_varid(tape(t)%Files(f), trim(fname_tmp), tape(t)%hlist(fld)%varid(i)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fname_tmp)) + ierr = pio_get_att(tape(t)%Files(f), tape(t)%hlist(fld)%varid(i), 'basename', basename) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting basename for '//trim(fname_tmp)) + if (trim(fldname) /= trim(basename)) then + call endrun('H_INQUIRE: basename ('//trim(basename)//') does not match fldname ('//trim(fldname)//')') + end if + end do + else + fldname = tape(t)%hlist(fld)%field%name + ierr = pio_inq_varid(tape(t)%Files(f), trim(fldname), tape(t)%hlist(fld)%varid(1)) + call cam_pio_handle_error(ierr, 'H_INQUIRE: Error getting ID for '//trim(fldname)) + end if + if(tape(t)%hlist(fld)%field%numlev>1) then + ierr = pio_inq_attlen(tape(t)%Files(f),tape(t)%hlist(fld)%varid(1),'mdims', mdimsize) + if(.not. associated(tape(t)%hlist(fld)%field%mdims)) then + allocate(tape(t)%hlist(fld)%field%mdims(mdimsize)) + end if + ierr=pio_get_att(tape(t)%Files(f),tape(t)%hlist(fld)%varid(1),'mdims', & + tape(t)%hlist(fld)%field%mdims(1:mdimsize)) + if(mdimsize > int(maxvarmdims, kind=pio_offset_kind)) then + maxvarmdims = int(mdimsize) + end if + end if + end do end do - if(masterproc) then write(iulog,*)'H_INQUIRE: Successfully opened netcdf file ' end if @@ -4149,7 +4223,7 @@ subroutine h_define (t, restart) ! Method: Issue the required netcdf wrapper calls to define the history file contents ! !----------------------------------------------------------------------- - use phys_control, only: phys_getopts + use phys_control, only: phys_getopts use cam_grid_support, only: cam_grid_header_info_t use cam_grid_support, only: cam_grid_write_attr, cam_grid_write_var use time_manager, only: get_step_size, get_ref_date, timemgr_get_calendar_cf @@ -4168,9 +4242,9 @@ subroutine h_define (t, restart) ! ! Local workspace ! - integer :: i, j ! longitude, latitude indices + integer :: i, j, f ! longitude, latitude, file indices integer :: grd ! indices for looping through grids - integer :: f ! field index + integer :: fld ! field index integer :: ncreal ! real data type for output integer :: dtime ! timestep size integer :: sec_nhtfrq ! nhtfrq converted to seconds @@ -4225,6 +4299,7 @@ subroutine h_define (t, restart) character(len=32) :: cam_take_snapshot_before character(len=32) :: cam_take_snapshot_after + call phys_getopts(cam_take_snapshot_before_out= cam_take_snapshot_before, & cam_take_snapshot_after_out = cam_take_snapshot_after, & cam_snapshot_before_num_out = cam_snapshot_before_num, & @@ -4235,34 +4310,50 @@ subroutine h_define (t, restart) if(masterproc) write(iulog,*)'Opening netcdf history restart file ', trim(hrestpath(t)) else tape => history_tape - if(masterproc) write(iulog,*)'Opening netcdf history file ', trim(nhfil(t)) + if(masterproc) then + if (hfile_accum(t)) then + ! We have an accumulated file in addition to the instantaneous + write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,accumulated_file_index)), & + ' ', trim(nhfil(t,instantaneous_file_index)) + else + ! We just have the instantaneous file + write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,instantaneous_file_index)) + end if + end if end if amode = PIO_CLOBBER if(restart) then - call cam_pio_createfile (tape(t)%File, hrestpath(t), amode) + call cam_pio_createfile (tape(t)%Files(restart_file_index), hrestpath(t), amode) + else if (is_initfile(file_index=t) .or. is_satfile(t)) then + call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else - call cam_pio_createfile (tape(t)%File, nhfil(t), amode) + ! figure out how many history files to generate for this tape + ! Always create the instantaneous file + call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) + if (hfile_accum(t)) then + ! Conditionally create the accumulated file + call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) + end if end if if(is_satfile(t)) then interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? patch_output = .false. - call cam_pio_def_dim(tape(t)%File, 'ncol', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim) + call cam_pio_def_dim(tape(t)%Files(sat_file_index), 'ncol', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(sat_file_index), 'nbnd', 2, bnddim) allocate(latvar(1), lonvar(1)) allocate(latvar(1)%vd, lonvar(1)%vd) - call cam_pio_def_var(tape(t)%File, 'lat', pio_double, (/timdim/), & + call cam_pio_def_var(tape(t)%Files(sat_file_index), 'lat', pio_double, (/timdim/), & latvar(1)%vd) - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'long_name', 'latitude') - ierr=pio_put_att (tape(t)%File, latvar(1)%vd, 'units', 'degrees_north') + ierr=pio_put_att (tape(t)%Files(sat_file_index), latvar(1)%vd, 'long_name', 'latitude') + ierr=pio_put_att (tape(t)%Files(sat_file_index), latvar(1)%vd, 'units', 'degrees_north') - call cam_pio_def_var(tape(t)%File, 'lon', pio_double, (/timdim/), & + call cam_pio_def_var(tape(t)%Files(sat_file_index), 'lon', pio_double, (/timdim/), & lonvar(1)%vd) - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'long_name','longitude') - ierr=pio_put_att (tape(t)%File, lonvar(1)%vd,'units','degrees_east') - + ierr=pio_put_att (tape(t)%Files(sat_file_index), lonvar(1)%vd,'long_name','longitude') + ierr=pio_put_att (tape(t)%Files(sat_file_index), lonvar(1)%vd,'units','degrees_east') else ! ! Setup netcdf file - create the dimensions of lat,lon,time,level @@ -4275,7 +4366,11 @@ subroutine h_define (t, restart) ! Interpolation is special in that we ignore the native grids if(interpolate) then allocate(header_info(1)) - call cam_grid_write_attr(tape(t)%File, interpolate_info(t)%grid_id, header_info(1)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), file_index=f) + end if + end do else if (patch_output) then ! We are doing patch (column) output if (allocated(header_info)) then @@ -4283,91 +4378,42 @@ subroutine h_define (t, restart) call endrun('H_DEFINE: header_info should not be allocated for patch output') end if do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_attrs(tape(t)%File) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call tape(t)%patches(i)%write_attrs(tape(t)%Files(f)) + end if + end do end do else allocate(header_info(size(tape(t)%grid_ids))) do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_attr(tape(t)%File, tape(t)%grid_ids(i), header_info(i)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), file_index=f) + end if + end do end do end if ! interpolate - ! Define the unlimited time dim - call cam_pio_def_dim(tape(t)%File, 'time', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%File, 'nbnd', 2, bnddim, existOK=.true.) - call cam_pio_def_dim(tape(t)%File, 'chars', 8, chardim) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_def_dim(tape(t)%Files(f), 'time', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(f), 'nbnd', 2, bnddim, existOK=.true.) + call cam_pio_def_dim(tape(t)%Files(f), 'chars', 8, chardim) + end if + end do end if ! is satfile - ! Store snapshot location - if (t == cam_snapshot_before_num) then - ierr=pio_put_att(tape(t)%File, PIO_GLOBAL, 'cam_snapshot_before', & - trim(cam_take_snapshot_before)) - end if - if (t == cam_snapshot_after_num) then - ierr=pio_put_att(tape(t)%File, PIO_GLOBAL, 'cam_snapshot_after', & - trim(cam_take_snapshot_after)) - end if - - ! Populate the history coordinate (well, mdims anyway) attributes - ! This routine also allocates the mdimids array - call write_hist_coord_attrs(tape(t)%File, bnddim, mdimids, restart) - call get_ref_date(yr, mon, day, nbsec) nbdate = yr*10000 + mon*100 + day - ierr=pio_def_var (tape(t)%File,'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'long_name', 'time') - str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'units', trim(str)) - calendar = timemgr_get_calendar_cf() - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'calendar', trim(calendar)) - - - ierr=pio_def_var (tape(t)%File,'date ',pio_int,(/timdim/),tape(t)%dateid) - str = 'current date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%dateid, 'long_name', trim(str)) - - - ierr=pio_def_var (tape(t)%File,'datesec ',pio_int,(/timdim/), tape(t)%datesecid) - str = 'current seconds of current date' - ierr=pio_put_att (tape(t)%File, tape(t)%datesecid, 'long_name', trim(str)) - - ! - ! Character header information - ! - str = 'CF-1.0' - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'Conventions', trim(str)) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'source', 'CAM') -#if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') -#endif - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'case',caseid) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'logname',logname) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'host', host) - -! Put these back in when they are filled properly -! ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'title',ctitle) -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'Version', & -! '$Name$') -! ierr= pio_put_att (tape(t)%File, PIO_GLOBAL, 'revision_Id', & -! '$Id$') - - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'initial_file', ncdata) - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'topography_file', bnd_topo) - if (len_trim(model_doi_url) > 0) then - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'model_doi_url', model_doi_url) - end if - ! Determine what time period frequency is being output for each file ! Note that nhtfrq is now in timesteps - sec_nhtfrq = nhtfrq(t) - ! If nhtfrq is in hours, convert to seconds if (nhtfrq(t) < 0) then sec_nhtfrq = abs(nhtfrq(t))*3600 end if - dtime = get_step_size() if (sec_nhtfrq == 0) then !month time_per_freq = 'month_1' @@ -4381,412 +4427,495 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! Store snapshot location + if (t == cam_snapshot_before_num) then + ierr=pio_put_att(tape(t)%Files(f), PIO_GLOBAL, 'cam_snapshot_before', & + trim(cam_take_snapshot_before)) + end if + if (t == cam_snapshot_after_num) then + ierr=pio_put_att(tape(t)%Files(f), PIO_GLOBAL, 'cam_snapshot_after', & + trim(cam_take_snapshot_after)) + end if - ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - - if(.not. is_satfile(t)) then + ! Populate the history coordinate (well, mdims anyway) attributes + ! This routine also allocates the mdimids array + call write_hist_coord_attrs(tape(t)%Files(f), bnddim, mdimids, restart) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'bounds', 'time_bnds') + ierr=pio_def_var (tape(t)%Files(f),'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_def_var (tape(t)%File,'time_bnds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) - ierr=pio_put_att (tape(t)%File, tape(t)%tbndid, 'long_name', 'time interval endpoints') - ! - ! Character - ! - dimenchar(1) = chardim - dimenchar(2) = timdim - ierr=pio_def_var (tape(t)%File,'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) - ierr=pio_def_var (tape(t)%File,'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) - ! - ! Integer Header - ! + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'long_name', 'time') + str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'units', trim(str)) - ierr=pio_def_var (tape(t)%File,'ndbase',PIO_INT,tape(t)%ndbaseid) - str = 'base day' - ierr=pio_put_att (tape(t)%File, tape(t)%ndbaseid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'calendar', trim(calendar)) - ierr=pio_def_var (tape(t)%File,'nsbase',PIO_INT,tape(t)%nsbaseid) - str = 'seconds of base day' - ierr=pio_put_att (tape(t)%File, tape(t)%nsbaseid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'date ',pio_int,(/timdim/),tape(t)%dateid) + str = 'current date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%dateid, 'long_name', trim(str)) - ierr=pio_def_var (tape(t)%File,'nbdate',PIO_INT,tape(t)%nbdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%nbdateid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'datesec ',pio_int,(/timdim/), tape(t)%datesecid) + str = 'current seconds of current date' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%datesecid, 'long_name', trim(str)) + ! + ! Character header information + ! + str = 'CF-1.0' + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'Conventions', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'source', 'CAM') #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'bdate',PIO_INT,tape(t)%bdateid) - str = 'base date (YYYYMMDD)' - ierr=pio_put_att (tape(t)%File, tape(t)%bdateid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'CAM_GENERATED_FORCING','create SCAM IOP dataset') #endif - ierr=pio_def_var (tape(t)%File,'nbsec',PIO_INT,tape(t)%nbsecid) - str = 'seconds of base date' - ierr=pio_put_att (tape(t)%File, tape(t)%nbsecid, 'long_name', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'case',caseid) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'logname',logname) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'host', host) + + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'initial_file', ncdata) + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'topography_file', bnd_topo) + if (len_trim(model_doi_url) > 0) then + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'model_doi_url', model_doi_url) + end if - ierr=pio_def_var (tape(t)%File,'mdt',PIO_INT,tape(t)%mdtid) - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'long_name', 'timestep') - ierr=pio_put_att (tape(t)%File, tape(t)%mdtid, 'units', 's') + ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - ! - ! Create variables for model timing and header information - ! + if(.not. is_satfile(t)) then - ierr=pio_def_var (tape(t)%File,'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) - str = 'current day (from base day)' - ierr=pio_put_att (tape(t)%File, tape(t)%ndcurid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'nscur ',pio_int,(/timdim/),tape(t)%nscurid) - str = 'current seconds of current day' - ierr=pio_put_att (tape(t)%File, tape(t)%nscurid, 'long_name', trim(str)) - - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_def_var (tape(t)%File,'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) - str = 'co2 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%co2vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) - str = 'ch4 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%ch4vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) - str = 'n2o volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%n2ovmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) - str = 'f11 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f11vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) - str = 'f12 volume mixing ratio' - ierr=pio_put_att (tape(t)%File, tape(t)%f12vmrid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) - str = 'total solar irradiance' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'long_name', trim(str)) - str = 'W/m2' - ierr=pio_put_att (tape(t)%File, tape(t)%sol_tsiid, 'units', trim(str)) - - if (solar_parms_on) then - ! solar / geomagetic activity indices... - ierr=pio_def_var (tape(t)%File,'f107',pio_double,(/timdim/),tape(t)%f107id) - str = '10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'long_name', trim(str)) - str = '10^-22 W m^-2 Hz^-1' - ierr=pio_put_att (tape(t)%File, tape(t)%f107id, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107a',pio_double,(/timdim/),tape(t)%f107aid) - str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107aid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'f107p',pio_double,(/timdim/),tape(t)%f107pid) - str = 'Pervious day 10.7 cm solar radio flux (F10.7)' - ierr=pio_put_att (tape(t)%File, tape(t)%f107pid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'kp',pio_double,(/timdim/),tape(t)%kpid) - str = 'Daily planetary K geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%kpid, 'long_name', trim(str)) - - ierr=pio_def_var (tape(t)%File,'ap',pio_double,(/timdim/),tape(t)%apid) - str = 'Daily planetary A geomagnetic index' - ierr=pio_put_att (tape(t)%File, tape(t)%apid, 'long_name', trim(str)) - endif - if (solar_wind_on) then - - ierr=pio_def_var (tape(t)%File,'byimf',pio_double,(/timdim/),tape(t)%byimfid) - str = 'Y component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%byimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'bzimf',pio_double,(/timdim/),tape(t)%bzimfid) - str = 'Z component of the interplanetary magnetic field' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'long_name', trim(str)) - str = 'nT' - ierr=pio_put_att (tape(t)%File, tape(t)%bzimfid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swvel',pio_double,(/timdim/),tape(t)%swvelid) - str = 'Solar wind speed' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'long_name', trim(str)) - str = 'km/sec' - ierr=pio_put_att (tape(t)%File, tape(t)%swvelid, 'units', trim(str)) - - ierr=pio_def_var (tape(t)%File,'swden',pio_double,(/timdim/),tape(t)%swdenid) - str = 'Solar wind ion number density' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'long_name', trim(str)) - str = 'cm-3' - ierr=pio_put_att (tape(t)%File, tape(t)%swdenid, 'units', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'bounds', 'time_bounds') - endif - if (epot_active) then - ierr=pio_def_var (tape(t)%File,'colat_crit1',pio_double,(/timdim/),tape(t)%colat_crit1_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'long_name', & - 'First co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit1_id, 'units', 'degrees') - - ierr=pio_def_var (tape(t)%File,'colat_crit2',pio_double,(/timdim/),tape(t)%colat_crit2_id) - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'long_name',& - 'Second co-latitude of electro-potential critical angle') - ierr=pio_put_att (tape(t)%File, tape(t)%colat_crit2_id, 'units', 'degrees') - endif - end if + ierr=pio_def_var (tape(t)%Files(f),'time_bounds',pio_double,(/bnddim,timdim/),tape(t)%tbndid) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'long_name', 'time interval endpoints') + str = 'days since ' // date2yyyymmdd(nbdate) // ' ' // sec2hms(nbsec) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'units', trim(str)) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tbndid, 'calendar', trim(calendar)) + ! + ! Character + ! + dimenchar(1) = chardim + dimenchar(2) = timdim + ierr=pio_def_var (tape(t)%Files(f),'date_written',PIO_CHAR,dimenchar, tape(t)%date_writtenid) + ierr=pio_def_var (tape(t)%Files(f),'time_written',PIO_CHAR,dimenchar, tape(t)%time_writtenid) + ! + ! Integer Header + ! + + ierr=pio_def_var (tape(t)%Files(f),'ndbase',PIO_INT,tape(t)%ndbaseid) + str = 'base day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ndbaseid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'nsbase',PIO_INT,tape(t)%nsbaseid) + str = 'seconds of base day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nsbaseid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'nbdate',PIO_INT,tape(t)%nbdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nbdateid, 'long_name', trim(str)) #if ( defined BFB_CAM_SCAM_IOP ) - ierr=pio_def_var (tape(t)%File,'tsec ',pio_int,(/timdim/), tape(t)%tsecid) - str = 'current seconds of current date needed for scam' - ierr=pio_put_att (tape(t)%File, tape(t)%tsecid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'bdate',PIO_INT,tape(t)%bdateid) + str = 'base date (YYYYMMDD)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bdateid, 'long_name', trim(str)) #endif - ierr=pio_def_var (tape(t)%File,'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) - str = 'current timestep' - ierr=pio_put_att (tape(t)%File, tape(t)%nstephid, 'long_name', trim(str)) - end if ! .not. is_satfile - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! - ! Create variables and attributes for field list - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ierr=pio_def_var (tape(t)%Files(f),'nbsec',PIO_INT,tape(t)%nbsecid) + str = 'seconds of base date' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nbsecid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'mdt',PIO_INT,tape(t)%mdtid) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%mdtid, 'long_name', 'timestep') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%mdtid, 'units', 's') + + ! + ! Create variables for model timing and header information + ! + if (f == instantaneous_file_index) then + ierr=pio_def_var (tape(t)%Files(f),'ndcur ',pio_int,(/timdim/),tape(t)%ndcurid) + str = 'current day (from base day)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ndcurid, 'long_name', trim(str)) + ierr=pio_def_var (tape(t)%Files(f),'nscur ',pio_int,(/timdim/),tape(t)%nscurid) + str = 'current seconds of current day' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nscurid, 'long_name', trim(str)) + end if - do f = 1, nflds(t) - !! Collect some field properties - call AvgflagToString(tape(t)%hlist(f)%avgflag, tape(t)%hlist(f)%time_op) - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ncreal = pio_double - else - ncreal = pio_real - end if + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. + ! Only write the GHG/Solar forcing data to the instantaneous file + ierr=pio_def_var (tape(t)%Files(f),'co2vmr ',pio_double,(/timdim/),tape(t)%co2vmrid) + str = 'co2 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%co2vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'ch4vmr ',pio_double,(/timdim/),tape(t)%ch4vmrid) + str = 'ch4 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%ch4vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'n2ovmr ',pio_double,(/timdim/),tape(t)%n2ovmrid) + str = 'n2o volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%n2ovmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f11vmr ',pio_double,(/timdim/),tape(t)%f11vmrid) + str = 'f11 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f11vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f12vmr ',pio_double,(/timdim/),tape(t)%f12vmrid) + str = 'f12 volume mixing ratio' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f12vmrid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'sol_tsi ',pio_double,(/timdim/),tape(t)%sol_tsiid) + str = 'total solar irradiance' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%sol_tsiid, 'long_name', trim(str)) + str = 'W/m2' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%sol_tsiid, 'units', trim(str)) + + if (solar_parms_on) then + ! solar / geomagnetic activity indices... + ierr=pio_def_var (tape(t)%Files(f),'f107',pio_double,(/timdim/),tape(t)%f107id) + str = '10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107id, 'long_name', trim(str)) + str = '10^-22 W m^-2 Hz^-1' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107id, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f107a',pio_double,(/timdim/),tape(t)%f107aid) + str = '81-day centered mean of 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107aid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'f107p',pio_double,(/timdim/),tape(t)%f107pid) + str = 'Pervious day 10.7 cm solar radio flux (F10.7)' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%f107pid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'kp',pio_double,(/timdim/),tape(t)%kpid) + str = 'Daily planetary K geomagnetic index' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%kpid, 'long_name', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'ap',pio_double,(/timdim/),tape(t)%apid) + str = 'Daily planetary A geomagnetic index' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%apid, 'long_name', trim(str)) + endif + if (solar_wind_on) then + + ierr=pio_def_var (tape(t)%Files(f),'byimf',pio_double,(/timdim/),tape(t)%byimfid) + str = 'Y component of the interplanetary magnetic field' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%byimfid, 'long_name', trim(str)) + str = 'nT' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%byimfid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'bzimf',pio_double,(/timdim/),tape(t)%bzimfid) + str = 'Z component of the interplanetary magnetic field' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bzimfid, 'long_name', trim(str)) + str = 'nT' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%bzimfid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'swvel',pio_double,(/timdim/),tape(t)%swvelid) + str = 'Solar wind speed' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swvelid, 'long_name', trim(str)) + str = 'km/sec' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swvelid, 'units', trim(str)) + + ierr=pio_def_var (tape(t)%Files(f),'swden',pio_double,(/timdim/),tape(t)%swdenid) + str = 'Solar wind ion number density' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swdenid, 'long_name', trim(str)) + str = 'cm-3' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%swdenid, 'units', trim(str)) - if(associated(tape(t)%hlist(f)%field%mdims)) then - mdims => tape(t)%hlist(f)%field%mdims - mdimsize = size(mdims) - else if(tape(t)%hlist(f)%field%numlev > 1) then - call endrun('mdims not defined for variable '//trim(tape(t)%hlist(f)%field%name)) - else - mdimsize=0 - end if + endif + if (epot_active) then + ierr=pio_def_var (tape(t)%Files(f),'colat_crit1',pio_double,(/timdim/),tape(t)%colat_crit1_id) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit1_id, 'long_name', & + 'First co-latitude of electro-potential critical angle') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit1_id, 'units', 'degrees') + + ierr=pio_def_var (tape(t)%Files(f),'colat_crit2',pio_double,(/timdim/),tape(t)%colat_crit2_id) + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit2_id, 'long_name',& + 'Second co-latitude of electro-potential critical angle') + ierr=pio_put_att (tape(t)%Files(f), tape(t)%colat_crit2_id, 'units', 'degrees') + endif + end if - ! num_patches will loop through the number of patches (or just one - ! for the whole grid) for this field for this tape - if (patch_output) then - num_patches = size(tape(t)%patches) - else - num_patches = 1 - end if - if(.not.associated(tape(t)%hlist(f)%varid)) then - allocate(tape(t)%hlist(f)%varid(num_patches)) - end if - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - - if(is_satfile(t)) then - num_hdims=0 - nfils(t)=1 - call sat_hist_define(tape(t)%File) - else if (interpolate) then - ! Interpolate can't use normal grid code since we are forcing fields - ! to use interpolate decomp - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - num_hdims = 2 - do i = 1, num_hdims - dimindex(i) = header_info(1)%get_hdimid(i) - nacsdims(i) = header_info(1)%get_hdimid(i) - end do - else if (patch_output) then - ! All patches for this variable should be on the same grid - num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(f)%field%decomp_type) - else - ! Normal grid output - ! Find appropriate grid in header_info - if (.not. allocated(header_info)) then - ! Safety check - call endrun('h_define: header_info not allocated') - end if - grd = -1 - do i = 1, size(header_info) - if (header_info(i)%get_gridid() == tape(t)%hlist(f)%field%decomp_type) then - grd = i - exit - end if - end do - if (grd < 0) then - write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(f)%field%decomp_type,', not found for ',trim(fname_tmp) - call endrun('H_DEFINE: '//errormsg) - end if - num_hdims = header_info(grd)%num_hdims() - do i = 1, num_hdims - dimindex(i) = header_info(grd)%get_hdimid(i) - nacsdims(i) = header_info(grd)%get_hdimid(i) - end do - end if ! is_satfile + if (f == instantaneous_file_index) then +#if ( defined BFB_CAM_SCAM_IOP ) + ierr=pio_def_var (tape(t)%Files(f),'tsec ',pio_int,(/timdim/), tape(t)%tsecid) + str = 'current seconds of current date needed for scam' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%tsecid, 'long_name', trim(str)) +#endif + ierr=pio_def_var (tape(t)%Files(f),'nsteph ',pio_int,(/timdim/),tape(t)%nstephid) + str = 'current timestep' + ierr=pio_put_att (tape(t)%Files(f), tape(t)%nstephid, 'long_name', trim(str)) + end if + end if ! .not. is_satfile + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Create variables and attributes for field list + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do fld = 1, nflds(t) + if (.not. is_satfile(t) .and. .not. restart .and. .not. is_initfile(t)) then + if (f == accumulated_file_index) then + ! this is the accumulated file of a potentially split history tape - skip instantaneous fields + if (tape(t)%hlist(fld)%avgflag == 'I') then + cycle + end if + else + ! this is the instantaneous file of a potentially split history tape - skip accumulated fields + if (tape(t)%hlist(fld)%avgflag /= 'I') then + cycle + end if + end if + end if + !! Collect some field properties + call AvgflagToString(tape(t)%hlist(fld)%avgflag, tape(t)%hlist(fld)%time_op) + if ((tape(t)%hlist(fld)%hwrt_prec == 8) .or. restart) then + ncreal = pio_double + else + ncreal = pio_real + end if - ! - ! Create variables and atributes for fields written out as columns - ! + if(associated(tape(t)%hlist(fld)%field%mdims)) then + mdims => tape(t)%hlist(fld)%field%mdims + mdimsize = size(mdims) + else if(tape(t)%hlist(fld)%field%numlev > 1) then + call endrun('mdims not defined for variable '//trim(tape(t)%hlist(fld)%field%name)) + else + mdimsize=0 + end if - do i = 1, num_patches - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - varid => tape(t)%hlist(f)%varid(i) - dimids_tmp = dimindex - ! Figure the dimension ID array for this field - ! We have defined the horizontal grid dimensions in dimindex - fdims = num_hdims - do j = 1, mdimsize - fdims = fdims + 1 - dimids_tmp(fdims) = mdimids(mdims(j)) - end do - if(.not. restart) then - ! Only add time dimension if this is not a restart history tape - fdims = fdims + 1 - dimids_tmp(fdims) = timdim - end if - if (patch_output) then - ! For patch output, we need new dimension IDs and a different name - call tape(t)%patches(i)%get_var_data(fname_tmp, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%field%decomp_type) - end if - ! Define the variable - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), ncreal, & - dimids_tmp(1:fdims), varid) - if (mdimsize > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'mdims', mdims(1:mdimsize)) - call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) - end if - str = tape(t)%hlist(f)%field%sampling_seq - if (len_trim(str) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'Sampling_Sequence', trim(str)) - call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) - end if + ! num_patches will loop through the number of patches (or just one + ! for the whole grid) for this field for this tape + if (patch_output) then + num_patches = size(tape(t)%patches) + else + num_patches = 1 + end if + if(.not.associated(tape(t)%hlist(fld)%varid)) then + allocate(tape(t)%hlist(fld)%varid(num_patches)) + end if + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + call sat_hist_define(tape(t)%Files(f)) + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + dimindex(i) = header_info(1)%get_hdimid(i) + nacsdims(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(fld)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(fld)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(fld)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + dimindex(i) = header_info(grd)%get_hdimid(i) + nacsdims(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile + + ! + ! Create variables and atributes for fields written out as columns + ! + + do i = 1, num_patches + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + varid => tape(t)%hlist(fld)%varid(i) + dimids_tmp = dimindex + ! Figure the dimension ID array for this field + ! We have defined the horizontal grid dimensions in dimindex + fdims = num_hdims + do j = 1, mdimsize + fdims = fdims + 1 + dimids_tmp(fdims) = mdimids(mdims(j)) + end do + if(.not. restart) then + ! Only add time dimension if this is not a restart history tape + fdims = fdims + 1 + dimids_tmp(fdims) = timdim + end if + if (patch_output) then + ! For patch output, we need new dimension IDs and a different name + call tape(t)%patches(i)%get_var_data(fname_tmp, & + dimids_tmp(1:fdims), tape(t)%hlist(fld)%field%decomp_type) + end if + ! Define the variable + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), ncreal, & + dimids_tmp(1:fdims), varid) + if (mdimsize > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'mdims', mdims(1:mdimsize)) + call cam_pio_handle_error(ierr, 'h_define: cannot define mdims for '//trim(fname_tmp)) + end if + str = tape(t)%hlist(fld)%field%sampling_seq + if (len_trim(str) > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'Sampling_Sequence', trim(str)) + call cam_pio_handle_error(ierr, 'h_define: cannot define Sampling_Sequence for '//trim(fname_tmp)) + end if - if (tape(t)%hlist(f)%field%flag_xyfill) then - ! Add both _FillValue and missing_value to cover expectations - ! of various applications. - ! The attribute type must match the data type. - if ((tape(t)%hlist(f)%hwrt_prec == 8) .or. restart) then - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - tape(t)%hlist(f)%field%fillvalue) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - else - ierr = pio_put_att(tape(t)%File, varid, '_FillValue', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define _FillValue for '//trim(fname_tmp)) - ierr = pio_put_att(tape(t)%File, varid, 'missing_value', & - REAL(tape(t)%hlist(f)%field%fillvalue,r4)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define missing_value for '//trim(fname_tmp)) - end if - end if + if (tape(t)%hlist(fld)%field%flag_xyfill) then + ! Add both _FillValue and missing_value to cover expectations + ! of various applications. + ! The attribute type must match the data type. + if ((tape(t)%hlist(fld)%hwrt_prec == 8) .or. restart) then + ierr = pio_put_att(tape(t)%Files(f), varid, '_FillValue', & + tape(t)%hlist(fld)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%Files(f), varid, 'missing_value', & + tape(t)%hlist(fld)%field%fillvalue) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + else + ierr = pio_put_att(tape(t)%Files(f), varid, '_FillValue', & + REAL(tape(t)%hlist(fld)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define _FillValue for '//trim(fname_tmp)) + ierr = pio_put_att(tape(t)%Files(f), varid, 'missing_value', & + REAL(tape(t)%hlist(fld)%field%fillvalue,r4)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define missing_value for '//trim(fname_tmp)) + end if + end if - str = tape(t)%hlist(f)%field%units - if (len_trim(str) > 0) then - ierr=pio_put_att (tape(t)%File, varid, 'units', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define units for '//trim(fname_tmp)) - end if + str = tape(t)%hlist(fld)%field%units + if (len_trim(str) > 0) then + ierr=pio_put_att (tape(t)%Files(f), varid, 'units', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define units for '//trim(fname_tmp)) + end if - str = tape(t)%hlist(f)%field%mixing_ratio - if (len_trim(str) > 0) then - ierr=pio_put_att (tape(t)%File, varid, 'mixing_ratio', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define mixing_ratio for '//trim(fname_tmp)) - end if + str = tape(t)%hlist(fld)%field%mixing_ratio + if (len_trim(str) > 0) then + ierr=pio_put_att (tape(t)%Files(f), varid, 'mixing_ratio', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define mixing_ratio for '//trim(fname_tmp)) + end if - str = tape(t)%hlist(f)%field%long_name - ierr=pio_put_att (tape(t)%File, varid, 'long_name', trim(str)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define long_name for '//trim(fname_tmp)) + str = tape(t)%hlist(fld)%field%long_name + ierr=pio_put_att (tape(t)%Files(f), varid, 'long_name', trim(str)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define long_name for '//trim(fname_tmp)) - ! Assign field attributes defining valid levels and averaging info + ! Assign field attributes defining valid levels and averaging info - cell_methods = '' - if (len_trim(tape(t)%hlist(f)%field%cell_methods) > 0) then - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(f)%field%cell_methods) - else - cell_methods = trim(cell_methods)//trim(tape(t)%hlist(f)%field%cell_methods) - end if - end if - ! Time cell methods is after field method because time averaging is - ! applied later (just before output) than field method which is applied - ! before outfld call. - str = tape(t)%hlist(f)%time_op - select case (str) - case ('mean', 'maximum', 'minimum', 'standard_deviation') - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//'time: '//str - else - cell_methods = trim(cell_methods)//'time: '//str - end if - end select - if (len_trim(cell_methods) > 0) then - ierr = pio_put_att(tape(t)%File, varid, 'cell_methods', trim(cell_methods)) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define cell_methods for '//trim(fname_tmp)) - end if - if (patch_output) then - ierr = pio_put_att(tape(t)%File, varid, 'basename', & - tape(t)%hlist(f)%field%name) - call cam_pio_handle_error(ierr, & - 'h_define: cannot define basename for '//trim(fname_tmp)) - end if + cell_methods = '' + if (len_trim(tape(t)%hlist(fld)%field%cell_methods) > 0) then + if (len_trim(cell_methods) > 0) then + cell_methods = trim(cell_methods)//' '//trim(tape(t)%hlist(fld)%field%cell_methods) + else + cell_methods = trim(cell_methods)//trim(tape(t)%hlist(fld)%field%cell_methods) + end if + end if + ! Time cell methods is after field method because time averaging is + ! applied later (just before output) than field method which is applied + ! before outfld call. + str = tape(t)%hlist(fld)%time_op + if (tape(t)%hlist(fld)%avgflag == 'I') then + str = 'point' + else + str = tape(t)%hlist(fld)%time_op + end if + cell_methods = adjustl(trim(cell_methods)//' '//'time: '//str) + if (len_trim(cell_methods) > 0) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'cell_methods', trim(cell_methods)) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define cell_methods for '//trim(fname_tmp)) + end if + if (patch_output) then + ierr = pio_put_att(tape(t)%Files(f), varid, 'basename', & + tape(t)%hlist(fld)%field%name) + call cam_pio_handle_error(ierr, & + 'h_define: cannot define basename for '//trim(fname_tmp)) + end if - if (restart) then - ! For restart history files, we need to save accumulation counts - fname_tmp = trim(fname_tmp)//'_nacs' - if (.not. associated(tape(t)%hlist(f)%nacs_varid)) then - allocate(tape(t)%hlist(f)%nacs_varid) - end if - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - nacsdims(1:num_hdims), tape(t)%hlist(f)%nacs_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_int, & - tape(t)%hlist(f)%nacs_varid) - end if - ! for standard deviation - if (associated(tape(t)%hlist(f)%sbuf)) then - fname_tmp = strip_suffix(tape(t)%hlist(f)%field%name) - fname_tmp = trim(fname_tmp)//'_var' - if ( .not.associated(tape(t)%hlist(f)%sbuf_varid)) then - allocate(tape(t)%hlist(f)%sbuf_varid) + if (restart) then + ! For restart history files, we need to save accumulation counts + fname_tmp = trim(fname_tmp)//'_nacs' + if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then + allocate(tape(t)%hlist(fld)%nacs_varid) + end if + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + tape(t)%hlist(fld)%nacs_varid) + end if + ! for standard deviation + if (associated(tape(t)%hlist(fld)%sbuf)) then + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + fname_tmp = trim(fname_tmp)//'_var' + if ( .not.associated(tape(t)%hlist(fld)%sbuf_varid)) then + allocate(tape(t)%hlist(fld)%sbuf_varid) + endif + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_double, & + dimids_tmp(1:fdims), tape(t)%hlist(fld)%sbuf_varid) endif - call cam_pio_def_var(tape(t)%File, trim(fname_tmp), pio_double, & - dimids_tmp(1:fdims), tape(t)%hlist(f)%sbuf_varid) - endif - end if - end do ! Loop over output patches - end do ! Loop over fields - ! - deallocate(mdimids) - ret = pio_enddef(tape(t)%File) + end if + end do ! Loop over output patches + end do ! Loop over fields + ! + deallocate(mdimids) + ret = pio_enddef(tape(t)%Files(f)) + if (ret /= PIO_NOERR) then + call endrun('H_DEFINE: ERROR exiting define mode in PIO') + end if - if(masterproc) then - write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' - endif + if(masterproc) then + write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' + endif + end do ! Loop over files ! ! Write time-invariant portion of history header ! if(.not. is_satfile(t)) then if(interpolate) then - call cam_grid_write_var(tape(t)%File, interpolate_info(t)%grid_id) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, file_index=f) + end if + end do else if((.not. patch_output) .or. restart) then do i = 1, size(tape(t)%grid_ids) - call cam_grid_write_var(tape(t)%File, tape(t)%grid_ids(i)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), file_index=f) + end if + end do end do else ! Patch output do i = 1, size(tape(t)%patches) - call tape(t)%patches(i)%write_vals(tape(t)%File) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call tape(t)%patches(i)%write_vals(tape(t)%Files(f)) + end if + end do end do end if ! interpolate if (allocated(lonvar)) then @@ -4797,28 +4926,32 @@ subroutine h_define (t, restart) end if dtime = get_step_size() - ierr = pio_put_var(tape(t)%File, tape(t)%mdtid, (/dtime/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') - ! - ! Model date info - ! - ierr = pio_put_var(tape(t)%File, tape(t)%ndbaseid, (/ndbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') - ierr = pio_put_var(tape(t)%File, tape(t)%nsbaseid, (/nsbase/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') - - ierr = pio_put_var(tape(t)%File, tape(t)%nbdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ierr = pio_put_var(tape(t)%Files(f), tape(t)%mdtid, (/dtime/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') + ! + ! Model date info + ! + ierr = pio_put_var(tape(t)%Files(f), tape(t)%ndbaseid, (/ndbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put ndbase') + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nsbaseid, (/nsbase/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nsbase') + + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nbdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbdate') #if ( defined BFB_CAM_SCAM_IOP ) - ierr = pio_put_var(tape(t)%File, tape(t)%bdateid, (/nbdate/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') + ierr = pio_put_var(tape(t)%Files(f), tape(t)%bdateid, (/nbdate/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put bdate') #endif - ierr = pio_put_var(tape(t)%File, tape(t)%nbsecid, (/nbsec/)) - call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') - ! - ! Reduced grid info - ! - + ierr = pio_put_var(tape(t)%Files(f), tape(t)%nbsecid, (/nbsec/)) + call cam_pio_handle_error(ierr, 'h_define: cannot put nbsec') + ! + ! Reduced grid info + ! + end do end if ! .not. is_satfile if (allocated(header_info)) then @@ -4829,13 +4962,17 @@ subroutine h_define (t, restart) end if ! Write the mdim variable data - call write_hist_coord_vars(tape(t)%File, restart) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call write_hist_coord_vars(tape(t)%Files(f), restart) + end if + end do end subroutine h_define !####################################################################### - subroutine h_normalize (f, t) + subroutine h_normalize (fld, t) use cam_history_support, only: dim_index_2d use time_manager, only: get_nstep @@ -4852,7 +4989,7 @@ subroutine h_normalize (f, t) ! ! Input arguments ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace @@ -4874,16 +5011,16 @@ subroutine h_normalize (f, t) call t_startf ('h_normalize') - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) ! ! normalize by number of accumulations for averaged case ! - flag_xyfill = tape(t)%hlist(f)%field%flag_xyfill - avgflag = tape(t)%hlist(f)%avgflag + flag_xyfill = tape(t)%hlist(fld)%field%flag_xyfill + avgflag = tape(t)%hlist(fld)%avgflag do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) + dimind = tape(t)%hlist(fld)%field%get_dims(c) ib = dimind%beg1 ie = dimind%end1 @@ -4892,55 +5029,55 @@ subroutine h_normalize (f, t) if (flag_xyfill) then do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie, c) == 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = tape(t)%hlist(f)%field%fillvalue + where (tape(t)%hlist(fld)%nacs(ib:ie, c) == 0) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = tape(t)%hlist(fld)%field%fillvalue endwhere end do end if if (avgflag == 'A' .or. avgflag == 'B' .or. avgflag == 'L') then - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then do k = jb, je - where (tape(t)%hlist(f)%nacs(ib:ie,c) /= 0) - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(ib:ie,c) + where (tape(t)%hlist(fld)%nacs(ib:ie,c) /= 0) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(fld)%nacs(ib:ie,c) endwhere end do - else if(tape(t)%hlist(f)%nacs(1,c) > 0) then + else if(tape(t)%hlist(fld)%nacs(1,c) > 0) then do k=jb,je - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & - / tape(t)%hlist(f)%nacs(1,c) + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & + / tape(t)%hlist(fld)%nacs(1,c) end do end if end if currstep=get_nstep() if (avgflag == 'N' .and. currstep > 0) then - if( currstep > tape(t)%hlist(f)%beg_nstep) then - nsteps=currstep-tape(t)%hlist(f)%beg_nstep + if( currstep > tape(t)%hlist(fld)%beg_nstep) then + nsteps=currstep-tape(t)%hlist(fld)%beg_nstep do k=jb,je - tape(t)%hlist(f)%hbuf(ib:ie,k,c) = & - tape(t)%hlist(f)%hbuf(ib:ie,k,c) & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) = & + tape(t)%hlist(fld)%hbuf(ib:ie,k,c) & / nsteps end do else - write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep=',currstep,',',tape(t)%hlist(f)%beg_nstep + write(errmsg,*) sub,'FATAL: bad nstep normalization, currstep, beg_nstep=',currstep,',',tape(t)%hlist(fld)%beg_nstep call endrun(trim(errmsg)) end if end if if (avgflag == 'S') then ! standard deviation ... ! from http://www.johndcook.com/blog/standard_deviation/ - tmpfill = merge(tape(t)%hlist(f)%field%fillvalue,0._r8,flag_xyfill) + tmpfill = merge(tape(t)%hlist(fld)%field%fillvalue,0._r8,flag_xyfill) do k=jb,je do i = ib,ie ii = merge(i,1,flag_xyfill) - if (tape(t)%hlist(f)%nacs(ii,c) > 1) then - variance = tape(t)%hlist(f)%sbuf(i,k,c)/(tape(t)%hlist(f)%nacs(ii,c)-1) - tape(t)%hlist(f)%hbuf(i,k,c) = sqrt(variance) + if (tape(t)%hlist(fld)%nacs(ii,c) > 1) then + variance = tape(t)%hlist(fld)%sbuf(i,k,c)/(tape(t)%hlist(fld)%nacs(ii,c)-1) + tape(t)%hlist(fld)%hbuf(i,k,c) = sqrt(variance) else - tape(t)%hlist(f)%hbuf(i,k,c) = tmpfill + tape(t)%hlist(fld)%hbuf(i,k,c) = tmpfill endif end do end do @@ -4954,7 +5091,7 @@ end subroutine h_normalize !####################################################################### - subroutine h_zero (f, t) + subroutine h_zero (fld, t) use cam_history_support, only: dim_index_2d use time_manager, only: get_nstep, is_first_restart_step ! @@ -4966,7 +5103,7 @@ subroutine h_zero (f, t) ! !----------------------------------------------------------------------- ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace @@ -4978,19 +5115,19 @@ subroutine h_zero (f, t) call t_startf ('h_zero') - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) - tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 - if (associated(tape(t)%hlist(f)%sbuf)) then ! zero out variance buffer for standard deviation - tape(t)%hlist(f)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + dimind = tape(t)%hlist(fld)%field%get_dims(c) + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 + if (associated(tape(t)%hlist(fld)%sbuf)) then ! zero out variance buffer for standard deviation + tape(t)%hlist(fld)%sbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c)=0._r8 end if end do - tape(t)%hlist(f)%nacs(:,:) = 0 + tape(t)%hlist(fld)%nacs(:,:) = 0 !Don't reset beg_nstep if this is a restart - if (.not. is_first_restart_step()) tape(t)%hlist(f)%beg_nstep = get_nstep() + if (.not. is_first_restart_step()) tape(t)%hlist(fld)%beg_nstep = get_nstep() call t_stopf ('h_zero') @@ -4999,7 +5136,7 @@ end subroutine h_zero !####################################################################### - subroutine h_global (f, t) + subroutine h_global (fld, t) use cam_history_support, only: dim_index_2d use shr_reprosum_mod, only: shr_reprosum_calc @@ -5013,7 +5150,7 @@ subroutine h_global (f, t) ! !----------------------------------------------------------------------- ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace @@ -5031,42 +5168,42 @@ subroutine h_global (f, t) call t_startf ('h_global') ! wbuf contains the area weighting for this field decomposition - if (associated(tape(t)%hlist(f)%wbuf) ) then + if (associated(tape(t)%hlist(fld)%wbuf) ) then - begdim1 = tape(t)%hlist(f)%field%begdim1 - enddim1 = tape(t)%hlist(f)%field%enddim1 + begdim1 = tape(t)%hlist(fld)%field%begdim1 + enddim1 = tape(t)%hlist(fld)%field%enddim1 fdims(1) = enddim1 - begdim1 + 1 - begdim2 = tape(t)%hlist(f)%field%begdim2 - enddim2 = tape(t)%hlist(f)%field%enddim2 + begdim2 = tape(t)%hlist(fld)%field%begdim2 + enddim2 = tape(t)%hlist(fld)%field%enddim2 fdims(2) = enddim2 - begdim2 + 1 - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 fdims(3) = enddim3 - begdim3 + 1 allocate(globalarr(fdims(1)*fdims(2)*fdims(3))) count=0 globalarr=0._r8 do ie = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(ie) + dimind = tape(t)%hlist(fld)%field%get_dims(ie) do j1 = dimind%beg2, dimind%end2 do i1 = dimind%beg1, dimind%end1 count=count+1 - globalarr(count)=globalarr(count)+tape(t)%hlist(f)%hbuf(i1,j1,ie)*tape(t)%hlist(f)%wbuf(i1,ie) + globalarr(count)=globalarr(count)+tape(t)%hlist(fld)%hbuf(i1,j1,ie)*tape(t)%hlist(fld)%wbuf(i1,ie) end do end do end do ! call fixed-point algorithm call shr_reprosum_calc (globalarr, globalsum, count, count, 1, commid=mpicom) - if (masterproc) write(iulog,*)'h_global:field:',trim(tape(t)%hlist(f)%field%name),' global integral=',globalsum(1) + if (masterproc) write(iulog,*)'h_global:field:',trim(tape(t)%hlist(fld)%field%name),' global integral=',globalsum(1) ! store global entry for this history tape entry - call tape(t)%hlist(f)%put_global(globalsum(1)) + call tape(t)%hlist(fld)%put_global(globalsum(1)) ! deallocate temp array deallocate(globalarr) end if call t_stopf ('h_global') end subroutine h_global - subroutine h_field_op (f, t) + subroutine h_field_op (fld, t) use cam_history_support, only: dim_index_2d ! !----------------------------------------------------------------------- @@ -5077,56 +5214,57 @@ subroutine h_field_op (f, t) ! !----------------------------------------------------------------------- ! - integer, intent(in) :: f ! field index + integer, intent(in) :: fld ! field index integer, intent(in) :: t ! tape index ! ! Local workspace ! type (dim_index_2d) :: dimind ! 2-D dimension index integer :: c ! chunk index - integer :: f1,f2 ! fields to be operated on + integer :: fld1,fld2 ! fields to be operated on integer :: begdim1, begdim2, begdim3 ! on-node chunk or lat start index integer :: enddim1, enddim2, enddim3 ! on-node chunk or lat end index character(len=field_op_len) :: optype ! field operation only sum or diff supported call t_startf ('h_field_op') - f1 = tape(t)%hlist(f)%field%op_field1_id - f2 = tape(t)%hlist(f)%field%op_field2_id - optype = trim(adjustl(tape(t)%hlist(f)%field%field_op)) + fld1 = tape(t)%hlist(fld)%field%op_field1_id + fld2 = tape(t)%hlist(fld)%field%op_field2_id + optype = trim(adjustl(tape(t)%hlist(fld)%field%field_op)) - begdim3 = tape(t)%hlist(f)%field%begdim3 - enddim3 = tape(t)%hlist(f)%field%enddim3 + begdim3 = tape(t)%hlist(fld)%field%begdim3 + enddim3 = tape(t)%hlist(fld)%field%enddim3 do c = begdim3, enddim3 - dimind = tape(t)%hlist(f)%field%get_dims(c) + dimind = tape(t)%hlist(fld)%field%get_dims(c) if (trim(optype) == 'dif') then - tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & - tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & - tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(fld1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) - & + tape(t)%hlist(fld2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else if (trim(optype) == 'sum') then - tape(t)%hlist(f)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & - tape(t)%hlist(f1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & - tape(t)%hlist(f2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + tape(t)%hlist(fld)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) = & + tape(t)%hlist(fld1)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) + & + tape(t)%hlist(fld2)%hbuf(dimind%beg1:dimind%end1,dimind%beg2:dimind%end2,c) else call endrun('h_field_op: ERROR: composed field operation type unknown:'//trim(optype)) end if end do ! Set nsteps for composed fields using value of one of the component fields - tape(t)%hlist(f)%beg_nstep=tape(t)%hlist(f1)%beg_nstep - tape(t)%hlist(f)%nacs(:,:)=tape(t)%hlist(f1)%nacs(:,:) + tape(t)%hlist(fld)%beg_nstep=tape(t)%hlist(fld1)%beg_nstep + tape(t)%hlist(fld)%nacs(:,:)=tape(t)%hlist(fld1)%nacs(:,:) call t_stopf ('h_field_op') end subroutine h_field_op !####################################################################### - subroutine dump_field (f, t, restart) + subroutine dump_field (fld, t, f, restart) use cam_history_support, only: history_patch_t, dim_index_2d, dim_index_3d use cam_grid_support, only: cam_grid_write_dist_array, cam_grid_dimensions use interp_mod, only : write_interpolated ! Dummy arguments - integer, intent(in) :: f - integer, intent(in) :: t + integer, intent(in) :: fld ! Field index + integer, intent(in) :: t ! Tape index + integer, intent(in) :: f ! File index logical, intent(in) :: restart ! !----------------------------------------------------------------------- @@ -5166,10 +5304,10 @@ subroutine dump_field (f, t, restart) !!! Get the field's shape and decomposition ! Shape on disk - call tape(t)%hlist(f)%field%get_shape(fdims, frank) + call tape(t)%hlist(fld)%field%get_shape(fdims, frank) ! Shape of array - dimind = tape(t)%hlist(f)%field%get_dims() + dimind = tape(t)%hlist(fld)%field%get_dims() call dimind%dim_sizes(adims) if (adims(2) <= 1) then adims(2) = adims(3) @@ -5177,7 +5315,7 @@ subroutine dump_field (f, t, restart) else nadims = 3 end if - fdecomp = tape(t)%hlist(f)%field%decomp_type + fdecomp = tape(t)%hlist(fld)%field%decomp_type ! num_patches will loop through the number of patches (or just one ! for the whole grid) for this field for this tape @@ -5188,12 +5326,12 @@ subroutine dump_field (f, t, restart) end if do index = 1, num_patches - varid => tape(t)%hlist(f)%varid(index) + varid => tape(t)%hlist(fld)%varid(index) if (restart) then - call pio_setframe(tape(t)%File, varid, int(-1,kind=PIO_OFFSET_KIND)) + call pio_setframe(tape(t)%Files(f), varid, int(-1,kind=PIO_OFFSET_KIND)) else - call pio_setframe(tape(t)%File, varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + call pio_setframe(tape(t)%Files(f), varid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) end if if (patch_output) then ! We are outputting patches @@ -5201,115 +5339,108 @@ subroutine dump_field (f, t, restart) if (interpolate) then call endrun('dump_field: interpolate incompatible with regional output') end if - call patchptr%write_var(tape(t)%File, fdecomp, adims(1:nadims), & - pio_double, tape(t)%hlist(f)%hbuf, varid) + call patchptr%write_var(tape(t)%Files(f), fdecomp, adims(1:nadims), & + pio_double, tape(t)%hlist(fld)%hbuf, varid) else ! We are doing output via the field's grid if (interpolate) then !Determine what the output field kind should be: - if (tape(t)%hlist(f)%hwrt_prec == 8) then + if (tape(t)%hlist(fld)%hwrt_prec == 8) then ncreal = pio_double else ncreal = pio_real end if - mdimsize = tape(t)%hlist(f)%field%enddim2 - tape(t)%hlist(f)%field%begdim2 + 1 + mdimsize = tape(t)%hlist(fld)%field%enddim2 - tape(t)%hlist(fld)%field%begdim2 + 1 if (mdimsize == 0) then - mdimsize = tape(t)%hlist(f)%field%numlev + mdimsize = tape(t)%hlist(fld)%field%numlev end if - if (tape(t)%hlist(f)%field%meridional_complement > 0) then - compind = tape(t)%hlist(f)%field%meridional_complement + if (tape(t)%hlist(fld)%field%meridional_complement > 0) then + compind = tape(t)%hlist(fld)%field%meridional_complement compid => tape(t)%hlist(compind)%varid(index) ! We didn't call set frame on the meridional complement field - call pio_setframe(tape(t)%File, compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) - call write_interpolated(tape(t)%File, varid, compid, & - tape(t)%hlist(f)%hbuf, tape(t)%hlist(compind)%hbuf, & + call pio_setframe(tape(t)%Files(f), compid, int(max(1,nfils(t)),kind=PIO_OFFSET_KIND)) + call write_interpolated(tape(t)%Files(f), varid, compid, & + tape(t)%hlist(fld)%hbuf, tape(t)%hlist(compind)%hbuf, & mdimsize, ncreal, fdecomp) - else if (tape(t)%hlist(f)%field%zonal_complement > 0) then - ! We don't want to double write so do nothing here -! compind = tape(t)%hlist(f)%field%zonal_complement -! compid => tape(t)%hlist(compind)%varid(index) -! call write_interpolated(tape(t)%File, compid, varid, & -! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & -! mdimsize, PIO_DOUBLE, fdecomp) - else + else if (tape(t)%hlist(fld)%field%zonal_complement <= 0) then ! Scalar field - call write_interpolated(tape(t)%File, varid, & - tape(t)%hlist(f)%hbuf, mdimsize, ncreal, fdecomp) + call write_interpolated(tape(t)%Files(f), varid, & + tape(t)%hlist(fld)%hbuf, mdimsize, ncreal, fdecomp) end if else if (nadims == 2) then ! Special case for 2D field (no levels) due to hbuf structure - if ((tape(t)%hlist(f)%hwrt_prec == 4) .and. (.not. restart)) then - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + if ((tape(t)%hlist(fld)%hwrt_prec == 4) .and. (.not. restart)) then + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) allocate(rtemp2(dimind%beg1:dimind%end1, begdim3:enddim3)) rtemp2 = 0.0_r4 do ind3 = begdim3, enddim3 - dimind2 = tape(t)%hlist(f)%field%get_dims(ind3) + dimind2 = tape(t)%hlist(fld)%field%get_dims(ind3) rtemp2(dimind2%beg1:dimind2%end1,ind3) = & - tape(t)%hlist(f)%hbuf(dimind2%beg1:dimind2%end1, 1, ind3) + tape(t)%hlist(fld)%hbuf(dimind2%beg1:dimind2%end1, 1, ind3) end do - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & adims(1:nadims), fdims(1:frank), rtemp2, varid) deallocate(rtemp2) else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & adims(1:nadims), fdims(1:frank), & - tape(t)%hlist(f)%hbuf(:,1,:), varid) + tape(t)%hlist(fld)%hbuf(:,1,:), varid) end if else - if ((tape(t)%hlist(f)%hwrt_prec == 4) .and. (.not. restart)) then - call tape(t)%hlist(f)%field%get_bounds(3, begdim3, enddim3) + if ((tape(t)%hlist(fld)%hwrt_prec == 4) .and. (.not. restart)) then + call tape(t)%hlist(fld)%field%get_bounds(3, begdim3, enddim3) allocate(rtemp3(dimind%beg1:dimind%end1, & dimind%beg2:dimind%end2, begdim3:enddim3)) rtemp3 = 0.0_r4 do ind3 = begdim3, enddim3 - dimind2 = tape(t)%hlist(f)%field%get_dims(ind3) + dimind2 = tape(t)%hlist(fld)%field%get_dims(ind3) rtemp3(dimind2%beg1:dimind2%end1, dimind2%beg2:dimind2%end2, & - ind3) = tape(t)%hlist(f)%hbuf(dimind2%beg1:dimind2%end1,& + ind3) = tape(t)%hlist(fld)%hbuf(dimind2%beg1:dimind2%end1,& dimind2%beg2:dimind2%end2, ind3) end do - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & fdims(1:frank), rtemp3, varid) deallocate(rtemp3) else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & fdims(1:frank), & - tape(t)%hlist(f)%hbuf, varid) + tape(t)%hlist(fld)%hbuf, varid) end if end if end if end do !! write accumulation counter and variance to hist restart file if(restart) then - if (associated(tape(t)%hlist(f)%sbuf) ) then + if (associated(tape(t)%hlist(fld)%sbuf) ) then ! write variance data to restart file for standard deviation calc if (nadims == 2) then ! Special case for 2D field (no levels) due to sbuf structure - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & adims(1:nadims), fdims(1:frank), & - tape(t)%hlist(f)%sbuf(:,1,:), tape(t)%hlist(f)%sbuf_varid) + tape(t)%hlist(fld)%sbuf(:,1,:), tape(t)%hlist(fld)%sbuf_varid) else - call cam_grid_write_dist_array(tape(t)%File, fdecomp, adims, & - fdims(1:frank), tape(t)%hlist(f)%sbuf, & - tape(t)%hlist(f)%sbuf_varid) + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, adims, & + fdims(1:frank), tape(t)%hlist(fld)%sbuf, & + tape(t)%hlist(fld)%sbuf_varid) endif endif !! NACS - if (size(tape(t)%hlist(f)%nacs, 1) > 1) then + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then if (nadims > 2) then adims(2) = adims(3) nadims = 2 end if call cam_grid_dimensions(fdecomp, fdims(1:2), nacsrank) - call cam_grid_write_dist_array(tape(t)%File, fdecomp, & + call cam_grid_write_dist_array(tape(t)%Files(f), fdecomp, & adims(1:nadims), fdims(1:nacsrank), & - tape(t)%hlist(f)%nacs, tape(t)%hlist(f)%nacs_varid) + tape(t)%hlist(fld)%nacs, tape(t)%hlist(fld)%nacs_varid) else - bdim3 = tape(t)%hlist(f)%field%begdim3 - edim3 = tape(t)%hlist(f)%field%enddim3 - ierr = pio_put_var(tape(t)%File, tape(t)%hlist(f)%nacs_varid, & - tape(t)%hlist(f)%nacs(:, bdim3:edim3)) + bdim3 = tape(t)%hlist(fld)%field%begdim3 + edim3 = tape(t)%hlist(fld)%field%enddim3 + ierr = pio_put_var(tape(t)%Files(f), tape(t)%hlist(fld)%nacs_varid, & + tape(t)%hlist(fld)%nacs(:, bdim3:edim3)) end if end if @@ -5376,6 +5507,7 @@ subroutine wshist (rgnht_in) ! !----------------------------------------------------------------------- use time_manager, only: get_nstep, get_curr_date, get_curr_time, get_step_size + use time_manager, only: set_date_from_time_float use chem_surfvals, only: chem_surfvals_get, chem_surfvals_co2_rad use solar_irrad_data, only: sol_tsi use sat_hist, only: sat_hist_write @@ -5391,7 +5523,7 @@ subroutine wshist (rgnht_in) character(len=8) :: ctime ! system time logical :: rgnht(ptapes), restart - integer t, f ! tape, field indices + integer t, f, fld ! tape, file, field indices integer start ! starting index required by nf_put_vara integer count1 ! count values required by nf_put_vara integer startc(2) ! start values required by nf_put_vara (character) @@ -5403,20 +5535,23 @@ subroutine wshist (rgnht_in) integer :: yr, mon, day ! year, month, and day components of a date integer :: nstep ! current timestep number - integer :: ncdate ! current date in integer format [yyyymmdd] - integer :: ncsec ! current time of day [seconds] + integer :: ncdate(maxsplitfiles) ! current (or midpoint) date in integer format [yyyymmdd] + integer :: ncsec(maxsplitfiles) ! current (or midpoint) time of day [seconds] integer :: ndcur ! day component of current time integer :: nscur ! seconds component of current time - real(r8) :: time ! current time + real(r8) :: time ! current (or midpoint) time real(r8) :: tdata(2) ! time interval boundaries character(len=max_string_len) :: fname ! Filename + character(len=max_string_len) :: fname_inst ! Filename for instantaneous tape + character(len=max_string_len) :: fname_acc ! Filename for accumulated tape logical :: prev ! Label file with previous date rather than current + logical :: duplicate ! Flag for duplicate file name integer :: ierr + integer :: ncsec_temp #if ( defined BFB_CAM_SCAM_IOP ) integer :: tsec ! day component of current time integer :: dtime ! seconds component of current time #endif - if(present(rgnht_in)) then rgnht=rgnht_in restart=.true. @@ -5428,8 +5563,8 @@ subroutine wshist (rgnht_in) end if nstep = get_nstep() - call get_curr_date(yr, mon, day, ncsec) - ncdate = yr*10000 + mon*100 + day + call get_curr_date(yr, mon, day, ncsec(instantaneous_file_index)) + ncdate(instantaneous_file_index) = yr*10000 + mon*100 + day call get_curr_time(ndcur, nscur) ! ! Write time-varying portion of history file header @@ -5447,7 +5582,7 @@ subroutine wshist (rgnht_in) prev = .false. else if (nhtfrq(t) == 0) then - hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec == 0 + hstwr(t) = nstep /= 0 .and. day == 1 .and. ncsec(instantaneous_file_index) == 0 prev = .true. else hstwr(t) = mod(nstep,nhtfrq(t)) == 0 @@ -5455,22 +5590,39 @@ subroutine wshist (rgnht_in) end if end if end if + time = ndcur + nscur/86400._r8 + if (is_initfile(file_index=t)) then + tdata = time ! Inithist file is always instantanious data + else + tdata(1) = beg_time(t) + tdata(2) = time + end if + ! Set midpoint date/datesec for accumulated file + call set_date_from_time_float((tdata(1) + tdata(2)) / 2._r8, yr, mon, day, ncsec_temp) + ncsec(accumulated_file_index) = ncsec_temp + ncdate(accumulated_file_index) = yr*10000 + mon*100 + day if (hstwr(t) .or. (restart .and. rgnht(t))) then if(masterproc) then if(is_initfile(file_index=t)) then - write(iulog,100) yr,mon,day,ncsec + write(iulog,100) yr,mon,day,ncsec(init_file_index) 100 format('WSHIST: writing time sample to Initial Conditions h-file', & ' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(is_satfile(t)) then - write(iulog,150) nfils(t),t,yr,mon,day,ncsec + write(iulog,150) nfils(t),t,yr,mon,day,ncsec(sat_file_index) 150 format('WSHIST: writing sat columns ',i6,' to h-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) else if(hstwr(t)) then - write(iulog,200) nfils(t),t,yr,mon,day,ncsec -200 format('WSHIST: writing time sample ',i3,' to h-file ', & - i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + do f = 1, maxsplitfiles + if (f == instantaneous_file_index) then + write(iulog,200) nfils(t),'instantaneous',t,yr,mon,day,ncsec(f) + else + write(iulog,200) nfils(t),'accumulated',t,yr,mon,day,ncsec(f) + end if +200 format('WSHIST: writing time sample ',i3,' to ', a, ' h-file ', & + i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) + end do else if(restart .and. rgnht(t)) then - write(iulog,300) nfils(t),t,yr,mon,day,ncsec + write(iulog,300) nfils(t),t,yr,mon,day,ncsec(restart_file_index) 300 format('WSHIST: writing history restart ',i3,' to hr-file ', & i1,' DATE=',i4.4,'/',i2.2,'/',i2.2,' NCSEC=',i6) end if @@ -5479,6 +5631,9 @@ subroutine wshist (rgnht_in) ! ! Starting a new volume => define the metadata ! + fname = '' + fname_acc = '' + fname_inst = '' if (nfils(t)==0 .or. (restart.and.rgnht(t))) then if(restart) then rhfilename_spec = '%c.cam' // trim(inst_suffix) // '.rh%t.%y-%m-%d-%s.nc' @@ -5487,28 +5642,53 @@ subroutine wshist (rgnht_in) else if(is_initfile(file_index=t)) then fname = interpret_filename_spec( hfilename_spec(t) ) else - fname = interpret_filename_spec( hfilename_spec(t), number=(t-1), & - prev=prev ) + fname_acc = interpret_filename_spec( hfilename_spec(t), number=(t-1), & + prev=prev, flag_spec='a' ) + fname_inst = interpret_filename_spec( hfilename_spec(t), number=(t-1), & + prev=prev, flag_spec='i' ) end if ! ! Check that this new filename isn't the same as a previous or current filename ! - do f = 1, ptapes - if (masterproc.and. trim(fname) == trim(nhfil(f)) )then - write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) - write(iulog,*)'Is there an error in your filename specifiers?' - write(iulog,*)'hfilename_spec(', t, ') = ', hfilename_spec(t) - if ( t /= f )then - write(iulog,*)'hfilename_spec(', f, ') = ', hfilename_spec(f) + duplicate = .false. + do f = 1, t + if (masterproc)then + if (trim(fname) == trim(nhfil(f,1)) .and. trim(fname) /= '') then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + duplicate = .true. + else if (trim(fname_acc) == trim(nhfil(f,accumulated_file_index)) .and. trim(fname_acc) /= '') then + write(iulog,*)'WSHIST: New accumulated filename same as old file = ', trim(fname_acc) + duplicate = .true. + else if (trim(fname_inst) == trim(nhfil(f,instantaneous_file_index)) .and. trim(fname_inst) /= '') then + write(iulog,*)'WSHIST: New instantaneous filename same as old file = ', trim(fname_inst) + duplicate = .true. + end if + if (duplicate) then + write(iulog,*)'Is there an error in your filename specifiers?' + write(iulog,*)'hfilename_spec(', t, ') = ', trim(hfilename_spec(t)) + if ( t /= f )then + write(iulog,*)'hfilename_spec(', f, ') = ', trim(hfilename_spec(f)) + end if + call endrun('WSHIST: ERROR - see atm log file for information') end if - call endrun end if end do if(.not. restart) then - nhfil(t) = fname - if(masterproc) write(iulog,*)'WSHIST: nhfil(',t,')=',trim(nhfil(t)) - cpath(t) = nhfil(t) - if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) + if (is_initfile(file_index=t)) then + nhfil(t,:) = fname + if(masterproc) then + write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,init_file_index)) + end if + else + nhfil(t,accumulated_file_index) = fname_acc + nhfil(t,instantaneous_file_index) = fname_inst + if(masterproc) then + write(iulog,*)'WSHIST: accumulated nhfil(',t,')=',trim(nhfil(t,accumulated_file_index)) + write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,instantaneous_file_index)) + end if + end if + cpath(t,:) = nhfil(t,:) + if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t, 1) end if call h_define (t, restart) end if @@ -5527,85 +5707,106 @@ subroutine wshist (rgnht_in) if (interpolate_output(t) .and. (.not. restart)) then call set_interp_hfile(t, interpolate_info) end if + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%ndcurid,(/start/),(/count1/),(/ndcur/)) + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index), tape(t)%nscurid,(/start/),(/count1/),(/nscur/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/),(/count1/),(/ncdate(f)/)) + end if + end do - ierr = pio_put_var (tape(t)%File, tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) - ierr = pio_put_var (tape(t)%File, tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) - - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - ierr=pio_put_var (tape(t)%File, tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) - ierr=pio_put_var (tape(t)%File, tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) - ierr=pio_put_var (tape(t)%File, tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) - - if (solar_parms_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%apid, (/start/), (/count1/),(/ ap /) ) - endif - if (solar_wind_on) then - ierr=pio_put_var (tape(t)%File, tape(t)%byimfid, (/start/), (/count1/),(/ byimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%bzimfid, (/start/), (/count1/),(/ bzimf /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swvelid, (/start/), (/count1/),(/ swvel /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%swdenid, (/start/), (/count1/),(/ swden /) ) - endif - if (epot_active) then - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit1_id, (/start/), (/count1/),(/ epot_crit_colats(1) /) ) - ierr=pio_put_var (tape(t)%File, tape(t)%colat_crit2_id, (/start/), (/count1/),(/ epot_crit_colats(2) /) ) - endif - end if - - ierr = pio_put_var (tape(t)%File, tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + do f = 1, maxsplitfiles + if (.not. is_initfile(file_index=t) .and. f == instantaneous_file_index) then + ! Don't write the GHG/Solar forcing data to the IC file. + ! Only write GHG/Solar forcing data to the instantaneous file + ierr=pio_put_var (tape(t)%Files(f), tape(t)%co2vmrid,(/start/), (/count1/),(/chem_surfvals_co2_rad(vmr_in=.true.)/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%ch4vmrid,(/start/), (/count1/),(/chem_surfvals_get('CH4VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%n2ovmrid,(/start/), (/count1/),(/chem_surfvals_get('N2OVMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f11vmrid,(/start/), (/count1/),(/chem_surfvals_get('F11VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f12vmrid,(/start/), (/count1/),(/chem_surfvals_get('F12VMR')/)) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%sol_tsiid,(/start/), (/count1/),(/sol_tsi/)) + + if (solar_parms_on) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107id, (/start/), (/count1/),(/ f107 /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107aid,(/start/), (/count1/),(/ f107a /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%f107pid,(/start/), (/count1/),(/ f107p /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%kpid, (/start/), (/count1/),(/ kp /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%apid, (/start/), (/count1/),(/ ap /) ) + endif + if (solar_wind_on) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%byimfid, (/start/), (/count1/),(/ byimf /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%bzimfid, (/start/), (/count1/),(/ bzimf /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%swvelid, (/start/), (/count1/),(/ swvel /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%swdenid, (/start/), (/count1/),(/ swden /) ) + endif + if (epot_active) then + ierr=pio_put_var (tape(t)%Files(f), tape(t)%colat_crit1_id, (/start/), (/count1/),(/ epot_crit_colats(1) /) ) + ierr=pio_put_var (tape(t)%Files(f), tape(t)%colat_crit2_id, (/start/), (/count1/),(/ epot_crit_colats(2) /) ) + endif + end if + end do + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f),tape(t)%datesecid,(/start/),(/count1/),(/ncsec(f)/)) + end if + end do #if ( defined BFB_CAM_SCAM_IOP ) dtime = get_step_size() tsec=dtime*nstep - ierr = pio_put_var (tape(t)%File, tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f),tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + end if + end do #endif - ierr = pio_put_var (tape(t)%File, tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) - time = ndcur + nscur/86400._r8 - ierr=pio_put_var (tape(t)%File, tape(t)%timeid, (/start/),(/count1/),(/time/)) - + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) startc(1) = 1 startc(2) = start countc(1) = 2 countc(2) = 1 - if (is_initfile(file_index=t)) then - tdata = time ! Inithist file is always instantanious data - else - tdata(1) = beg_time(t) - tdata(2) = time - end if - ierr=pio_put_var (tape(t)%File, tape(t)%tbndid, startc, countc, tdata) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! We have two files - one for accumulated and one for instantaneous fields + if (f == accumulated_file_index .and. .not. restart .and. .not. is_initfile(t)) then + ! accumulated tape - time is midpoint of time_bounds + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/(tdata(1) + tdata(2)) / 2._r8/)) + else + ! not an accumulated history tape - time is current time + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) + end if + ierr=pio_put_var (tape(t)%Files(f), tape(t)%tbndid, startc, countc, tdata) + end do if(.not.restart) beg_time(t) = time ! update beginning time of next interval startc(1) = 1 startc(2) = start countc(1) = 8 countc(2) = 1 call datetime (cdate, ctime) - ierr = pio_put_var (tape(t)%File, tape(t)%date_writtenid, startc, countc, (/cdate/)) - ierr = pio_put_var (tape(t)%File, tape(t)%time_writtenid, startc, countc, (/ctime/)) + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%date_writtenid, startc, countc, (/cdate/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%time_writtenid, startc, countc, (/ctime/)) + end if + end do if(.not. restart) then - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) ! Normalize all non composed fields, composed fields are calculated next using the normalized components - if (tape(t)%hlist(f)%avgflag /= 'I'.and..not.tape(t)%hlist(f)%field%is_composed()) then - call h_normalize (f, t) + if (tape(t)%hlist(fld)%avgflag /= 'I'.and..not.tape(t)%hlist(fld)%field%is_composed()) then + call h_normalize (fld, t) end if end do end if if(.not. restart) then - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) ! calculate composed fields from normalized components - if (tape(t)%hlist(f)%field%is_composed()) then - call h_field_op (f, t) + if (tape(t)%hlist(fld)%field%is_composed()) then + call h_field_op (fld, t) end if end do end if @@ -5613,31 +5814,42 @@ subroutine wshist (rgnht_in) ! Write field to history tape. Note that this is NOT threaded due to netcdf limitations ! call t_startf ('dump_field') - do f=1,nflds(t) - call dump_field(f, t, restart) + do fld=1,nflds(t) + do f = 1, maxsplitfiles + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if + ! we may have a history split, conditionally skip fields that are for the other file + if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. f == accumulated_file_index .and. .not. restart) then + cycle + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == instantaneous_file_index .and. .not. restart) then + cycle + end if + call dump_field(fld, t, f, restart) + end do end do call t_stopf ('dump_field') ! ! Calculate globals ! - do f=1,nflds(t) - call h_global(f, t) + do fld=1,nflds(t) + call h_global(fld, t) end do ! ! Zero history buffers and accumulators now that the fields have been written. ! if(restart) then - do f=1,nflds(t) - if(associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + if(associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) end if end do - call cam_pio_closefile(tape(t)%File) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) else - !$OMP PARALLEL DO PRIVATE (F) - do f=1,nflds(t) - call h_zero (f, t) + !$OMP PARALLEL DO PRIVATE (FLD) + do fld=1,nflds(t) + call h_zero (fld, t) end do end if end if @@ -6172,7 +6384,6 @@ subroutine wrapup (rstwr, nlend) ! !----------------------------------------------------------------------- ! - use pio, only : pio_file_is_open use shr_kind_mod, only: r8 => shr_kind_r8 use ioFileMod use time_manager, only: get_nstep, get_curr_date, get_curr_time @@ -6198,7 +6409,8 @@ subroutine wrapup (rstwr, nlend) logical :: lhfill ! true => history file is full integer :: t ! History file number - integer :: f + integer :: f ! File index + integer :: fld ! Field index real(r8) :: tday ! Model day number for printout !----------------------------------------------------------------------- @@ -6218,7 +6430,6 @@ subroutine wrapup (rstwr, nlend) ! do t=1,ptapes if (nflds(t) == 0) cycle - lfill(t) = .false. ! ! Find out if file is full @@ -6240,18 +6451,29 @@ subroutine wrapup (rstwr, nlend) ! Is this the 0 timestep data of a monthly run? ! If so, just close primary unit do not dispose. ! - if (masterproc) write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t)) - if(pio_file_is_open(tape(t)%File)) then + if (masterproc) then + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,f)) + end if + end do + end if + if(pio_file_is_open(tape(t)%Files(accumulated_file_index)) .or. & + pio_file_is_open(tape(t)%Files(instantaneous_file_index))) then if (nlend .or. lfill(t)) then - do f=1,nflds(t) - if (associated(tape(t)%hlist(f)%varid)) then - deallocate(tape(t)%hlist(f)%varid) - nullify(tape(t)%hlist(f)%varid) + do fld=1,nflds(t) + if (associated(tape(t)%hlist(fld)%varid)) then + deallocate(tape(t)%hlist(fld)%varid) + nullify(tape(t)%hlist(fld)%varid) end if end do end if - call cam_pio_closefile(tape(t)%File) end if + do f = 1, maxsplitfiles + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_closefile(tape(t)%Files(f)) + end if + end do if (nhtfrq(t) /= 0 .or. nstep > 0) then ! @@ -6274,7 +6496,12 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - call cam_PIO_openfile (tape(t)%File, nhfil(t), PIO_WRITE) + ! Always open the instantaneous file + call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) + if (hfile_accum(t)) then + ! Conditionally open the accumulated file + call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) + end if call h_inquire(t) end if endif ! if 0 timestep of montly run**** @@ -6519,7 +6746,7 @@ subroutine bld_htapefld_indices ! ! Local. ! - integer :: f + integer :: fld integer :: t ! @@ -6537,17 +6764,17 @@ subroutine bld_htapefld_indices end do do t = 1, ptapes - do f = 1, nflds(t) - listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(f)%field%name) + do fld = 1, nflds(t) + listentry => get_entry_by_name(masterlinkedlist, tape(t)%hlist(fld)%field%name) if(.not.associated(listentry)) then write(iulog,*) 'BLD_HTAPEFLD_INDICES: something wrong, field not found on masterlist' - write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, f - write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(f)%field%name + write(iulog,*) 'BLD_HTAPEFLD_INDICES: t, f, ff = ', t, fld + write(iulog,*) 'BLD_HTAPEFLD_INDICES: tape%name = ', tape(t)%hlist(fld)%field%name call endrun end if listentry%act_sometape = .true. listentry%actflag(t) = .true. - listentry%htapeindx(t) = f + listentry%htapeindx(t) = fld end do end do @@ -6610,10 +6837,10 @@ function hist_fld_col_active(fname, lchnk, numcols) logical :: hist_fld_col_active(numcols) ! Local variables - integer :: ff ! masterlist index pointer + integer :: ffld ! masterlist index pointer integer :: i integer :: t ! history file (tape) index - integer :: f ! field index + integer :: fld ! field index integer :: decomp logical :: activeloc(numcols) integer :: num_patches @@ -6629,22 +6856,22 @@ function hist_fld_col_active(fname, lchnk, numcols) hist_fld_col_active = .false. ! Check for name in the master list. - call get_field_properties(fname, found, tape_out=tape, ff_out=ff) + call get_field_properties(fname, found, tape_out=tape, ff_out=ffld) ! If not in master list then return. if (.not. found) return ! If in master list, but not active on any file then return - if (.not. masterlist(ff)%thisentry%act_sometape) return + if (.not. masterlist(ffld)%thisentry%act_sometape) return ! Loop over history files and check for the field/column in each one do t = 1, ptapes ! Is the field active in this file? If not the cycle to next file. - if (.not. masterlist(ff)%thisentry%actflag(t)) cycle + if (.not. masterlist(ffld)%thisentry%actflag(t)) cycle - f = masterlist(ff)%thisentry%htapeindx(t) - decomp = tape(t)%hlist(f)%field%decomp_type + fld = masterlist(ffld)%thisentry%htapeindx(t) + decomp = tape(t)%hlist(fld)%field%decomp_type patch_output = associated(tape(t)%patches) ! Check whether this file has patch (column) output. diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 495ce7b519..07ab2dd81a 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -15,7 +15,7 @@ module cam_history_support use cam_logfile, only: iulog use spmd_utils, only: masterproc use cam_grid_support, only: cam_grid_patch_t, cam_grid_header_info_t - use cam_grid_support, only: max_hcoordname_len + use cam_grid_support, only: max_hcoordname_len, maxsplitfiles use cam_pio_utils, only: cam_pio_handle_error implicit none @@ -197,7 +197,7 @@ module cam_history_support ! PIO ids ! - type(file_desc_t) :: File ! PIO file id + type(file_desc_t) :: Files(maxsplitfiles) ! PIO file ids type(var_desc_t) :: mdtid ! var id for timestep type(var_desc_t) :: ndbaseid ! var id for base day @@ -220,7 +220,7 @@ module cam_history_support #endif type(var_desc_t) :: nstephid ! var id for current timestep type(var_desc_t) :: timeid ! var id for time - type(var_desc_t) :: tbndid ! var id for time_bnds + type(var_desc_t) :: tbndid ! var id for time_bounds type(var_desc_t) :: date_writtenid ! var id for date time sample written type(var_desc_t) :: time_writtenid ! var id for time time sample written type(var_desc_t) :: f107id ! var id for f107 diff --git a/src/control/filenames.F90 b/src/control/filenames.F90 index 71166c4b07..2640ab6d20 100644 --- a/src/control/filenames.F90 +++ b/src/control/filenames.F90 @@ -48,7 +48,7 @@ end function get_dir !=============================================================================== character(len=cl) function interpret_filename_spec( filename_spec, number, prev, case, & - yr_spec, mon_spec, day_spec, sec_spec ) + yr_spec, mon_spec, day_spec, sec_spec, flag_spec ) ! Create a filename from a filename specifier. The ! filename specifyer includes codes for setting things such as the @@ -77,12 +77,14 @@ end function get_dir integer , intent(in), optional :: mon_spec ! Simulation month integer , intent(in), optional :: day_spec ! Simulation day integer , intent(in), optional :: sec_spec ! Seconds into current simulation day + character(len=*), intent(in), optional :: flag_spec ! flag for accumulated or instantaneous ! Local variables integer :: year ! Simulation year integer :: month ! Simulation month integer :: day ! Simulation day integer :: ncsec ! Seconds into current simulation day + character(len=1) :: flag character(len=cl) :: string ! Temporary character string character(len=cl) :: format ! Format character string integer :: i, n ! Loop variables @@ -116,6 +118,11 @@ end function get_dir call get_curr_date(year, month, day, ncsec) end if end if + if (present(flag_spec)) then + flag = flag_spec + else + flag = '' + end if ! ! Go through each character in the filename specifyer and interpret if special string ! @@ -170,6 +177,8 @@ end function get_dir write(string,'(i2.2)') day case( 's' ) ! second write(string,'(i5.5)') ncsec + case( 'f' ) ! flag + write(string,'(a)') flag case( '%' ) ! percent character string = "%" case default diff --git a/src/control/sat_hist.F90 b/src/control/sat_hist.F90 index 9e777e6519..35879cff90 100644 --- a/src/control/sat_hist.F90 +++ b/src/control/sat_hist.F90 @@ -466,53 +466,53 @@ subroutine sat_hist_write( tape , nflds, nfils) call get_indices( obs_lats, obs_lons, ncols, nocols, has_dyn_flds, col_ndxs, chk_ndxs, & fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners, mlats, mlons, phs_dists ) - if ( .not. pio_file_is_open(tape%File) ) then + if ( .not. pio_file_is_open(tape%Files(1)) ) then call endrun('sat file not open') endif - ierr = pio_inq_dimid(tape%File,'ncol',coldim ) + ierr = pio_inq_dimid(tape%Files(1),'ncol',coldim ) - ierr = pio_inq_varid(tape%File, 'lat', out_latid ) - ierr = pio_inq_varid(tape%File, 'lon', out_lonid ) - ierr = pio_inq_varid(tape%File, 'distance', out_dstid ) + ierr = pio_inq_varid(tape%Files(1), 'lat', out_latid ) + ierr = pio_inq_varid(tape%Files(1), 'lon', out_lonid ) + ierr = pio_inq_varid(tape%Files(1), 'distance', out_dstid ) call write_record_coord( tape, mlats(:), mlons(:), phs_dists(:), ncols, nfils ) ! dump columns of 2D fields if (has_phys_srf_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, 1, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_srf_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, 1, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, 1, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif ! dump columns of 3D fields defined on mid pres levels if (has_phys_lev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pver, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_lev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pver, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pver, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif ! dump columns of 3D fields defined on interface pres levels if (has_phys_ilev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pverp, nfils, & col_ndxs, chk_ndxs, phs_owners, phys_decomp ) endif if (has_dyn_ilev_flds) then - call dump_columns( tape%File, tape%hlist, nflds, nocols, pverp, nfils, & + call dump_columns( tape%Files(1), tape%hlist, nflds, nocols, pverp, nfils, & fdyn_ndxs, ldyn_ndxs, dyn_owners, dyn_decomp ) endif deallocate( col_ndxs, chk_ndxs, fdyn_ndxs, ldyn_ndxs, phs_owners, dyn_owners ) deallocate( mlons, mlats, phs_dists ) deallocate( obs_lons, obs_lats ) - call pio_syncfile(tape%File) + call pio_syncfile(tape%Files(1)) nfils = nfils + nocols @@ -763,19 +763,19 @@ subroutine write_record_coord( tape, mod_lats, mod_lons, mod_dists, ncols, nfils allocate( rtmp(ncols * sathist_nclosest) ) itmp(:) = ncdate - ierr = pio_put_var(tape%File, tape%dateid,(/nfils/), (/ncols * sathist_nclosest/),itmp) + ierr = pio_put_var(tape%Files(1), tape%dateid,(/nfils/), (/ncols * sathist_nclosest/),itmp) itmp(:) = ncsec - ierr = pio_put_var(tape%File, tape%datesecid,(/nfils/),(/ncols * sathist_nclosest/),itmp) + ierr = pio_put_var(tape%Files(1), tape%datesecid,(/nfils/),(/ncols * sathist_nclosest/),itmp) rtmp(:) = time - ierr = pio_put_var(tape%File, tape%timeid, (/nfils/),(/ncols * sathist_nclosest/),rtmp) + ierr = pio_put_var(tape%Files(1), tape%timeid, (/nfils/),(/ncols * sathist_nclosest/),rtmp) deallocate(itmp) deallocate(rtmp) ! output model column coordinates - ierr = pio_put_var(tape%File, out_latid, (/nfils/),(/ncols * sathist_nclosest/), mod_lats) - ierr = pio_put_var(tape%File, out_lonid, (/nfils/),(/ncols * sathist_nclosest/), mod_lons) - ierr = pio_put_var(tape%File, out_dstid, (/nfils/),(/ncols * sathist_nclosest/), mod_dists / 1000._r8) + ierr = pio_put_var(tape%Files(1), out_latid, (/nfils/),(/ncols * sathist_nclosest/), mod_lats) + ierr = pio_put_var(tape%Files(1), out_lonid, (/nfils/),(/ncols * sathist_nclosest/), mod_lons) + ierr = pio_put_var(tape%Files(1), out_dstid, (/nfils/),(/ncols * sathist_nclosest/), mod_dists / 1000._r8) ! output instrument location allocate( out_lats(ncols * sathist_nclosest) ) @@ -786,40 +786,40 @@ subroutine write_record_coord( tape, mod_lats, mod_lons, mod_dists, ncols, nfils out_lons(((i-1)*sathist_nclosest)+1 : (i*sathist_nclosest)) = obs_lons(i) enddo - ierr = pio_put_var(tape%File, out_instr_lat_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lats) - ierr = pio_put_var(tape%File, out_instr_lon_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lons) + ierr = pio_put_var(tape%Files(1), out_instr_lat_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lats) + ierr = pio_put_var(tape%Files(1), out_instr_lon_vid, (/nfils/),(/ncols * sathist_nclosest/), out_lons) deallocate(out_lats) deallocate(out_lons) - ierr = copy_data( infile, date_vid, tape%File, out_obs_date_vid, in_start_col, nfils, ncols ) - ierr = copy_data( infile, time_vid, tape%File, out_obs_time_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, date_vid, tape%Files(1), out_obs_date_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, time_vid, tape%Files(1), out_obs_time_vid, in_start_col, nfils, ncols ) ! output observation identifiers if (instr_vid>0) then - ierr = copy_data( infile, instr_vid, tape%File, out_instrid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, instr_vid, tape%Files(1), out_instrid, in_start_col, nfils, ncols ) endif if (orbit_vid>0) then - ierr = copy_data( infile, orbit_vid, tape%File, out_orbid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, orbit_vid, tape%Files(1), out_orbid, in_start_col, nfils, ncols ) endif if (prof_vid>0) then - ierr = copy_data( infile, prof_vid, tape%File, out_profid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, prof_vid, tape%Files(1), out_profid, in_start_col, nfils, ncols ) endif if (zenith_vid>0) then - ierr = copy_data( infile, zenith_vid, tape%File, out_zenithid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, zenith_vid, tape%Files(1), out_zenithid, in_start_col, nfils, ncols ) endif if (in_julian_vid>0) then - ierr = copy_data( infile, in_julian_vid, tape%File, out_julian_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_julian_vid, tape%Files(1), out_julian_vid, in_start_col, nfils, ncols ) endif if (in_occ_type_vid>0) then - ierr = copy_data( infile, in_occ_type_vid, tape%File, out_occ_type_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_occ_type_vid, tape%Files(1), out_occ_type_vid, in_start_col, nfils, ncols ) endif if (in_localtime_vid>0) then - ierr = copy_data( infile, in_localtime_vid, tape%File, out_localtime_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_localtime_vid, tape%Files(1), out_localtime_vid, in_start_col, nfils, ncols ) endif if (in_doy_vid>0) then - ierr = copy_data( infile, in_doy_vid, tape%File, out_doy_vid, in_start_col, nfils, ncols ) + ierr = copy_data( infile, in_doy_vid, tape%Files(1), out_doy_vid, in_start_col, nfils, ncols ) endif call t_stopf ('sat_hist::write_record_coord') diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index d86c829e77..de3cbb210b 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -15,6 +15,11 @@ module cam_grid_support public iMap integer, parameter, public :: max_hcoordname_len = 16 + integer, parameter, public :: maxsplitfiles = 2 + + type, public :: vardesc_ptr_t + type(var_desc_t), pointer :: p => NULL() + end type vardesc_ptr_t !--------------------------------------------------------------------------- ! ! horiz_coord_t: Information for horizontal dimension attributes @@ -32,8 +37,8 @@ module cam_grid_support integer(iMap), pointer :: map(:) => NULL() ! map (dof) for dist. coord logical :: latitude ! .false. means longitude real(r8), pointer :: bnds(:,:) => NULL() ! bounds, if present - type(var_desc_t), pointer :: vardesc => NULL() ! If we are to write coord - type(var_desc_t), pointer :: bndsvdesc => NULL() ! If we are to write bounds + type(vardesc_ptr_t) :: vardesc(maxsplitfiles) ! If we are to write coord + type(vardesc_ptr_t) :: bndsvdesc(maxsplitfiles) ! If we are to write bounds contains procedure :: get_coord_len => horiz_coord_len procedure :: num_elem => horiz_coord_num_elem @@ -54,7 +59,7 @@ module cam_grid_support type, abstract :: cam_grid_attribute_t character(len=max_hcoordname_len) :: name = '' ! attribute name character(len=max_chars) :: long_name = '' ! attribute long_name - type(var_desc_t), pointer :: vardesc => NULL() + type(vardesc_ptr_t) :: vardesc(maxsplitfiles) ! We aren't going to use this until we sort out PGI issues class(cam_grid_attribute_t), pointer :: next => NULL() contains @@ -156,7 +161,7 @@ module cam_grid_support type(horiz_coord_t), pointer :: lon_coord => NULL() ! Longitude coord logical :: unstructured ! Is this needed? logical :: block_indexed ! .false. for lon/lat - logical :: attrs_defined = .false. + logical :: attrs_defined(2) = .false. logical :: zonal_grid = .false. type(cam_filemap_t), pointer :: map => null() ! global dim map (dof) type(cam_grid_attr_ptr_t), pointer :: attributes => NULL() @@ -266,12 +271,13 @@ module cam_grid_support ! NB: This will not compile on some pre-13 Intel compilers ! (fails on 12.1.0.233 on Frankfurt, passes on 13.0.1.117 on Yellowstone) abstract interface - subroutine write_cam_grid_attr(attr, File) + subroutine write_cam_grid_attr(attr, File, file_index) use pio, only: file_desc_t import :: cam_grid_attribute_t ! Dummy arguments class(cam_grid_attribute_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index end subroutine write_cam_grid_attr end interface @@ -545,7 +551,7 @@ end function horiz_coord_create ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_attr(this, File, dimid_out) + subroutine write_horiz_coord_attr(this, File, dimid_out, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double use pio, only: pio_bcast_error, pio_seterrorhandling, pio_inq_varid use cam_pio_utils, only: cam_pio_def_dim, cam_pio_def_var @@ -554,6 +560,7 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) class(horiz_coord_t), intent(inout) :: this type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, optional, intent(out) :: dimid_out + integer, optional, intent(in) :: file_index ! Local variables type(var_desc_t) :: vardesc @@ -562,9 +569,16 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) integer :: bnds_dimid ! PIO dim ID for bounds integer :: err_handling integer :: ierr + integer :: file_index_loc ! We will handle errors for this routine - call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Make sure the dimension exists in the file call this%get_dim_name(dimname) @@ -574,33 +588,33 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) ierr = pio_inq_varid(File, trim(this%name), vardesc) if (ierr /= PIO_NOERR) then ! Variable not already defined, it is up to us to define the variable - if (associated(this%vardesc)) then + if (associated(this%vardesc(file_index_loc)%p)) then ! This should not happen (i.e., internal error) call endrun('write_horiz_coord_attr: vardesc already allocated for '//trim(dimname)) end if - allocate(this%vardesc) + allocate(this%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(this%name), pio_double, & - (/ dimid /), this%vardesc, existOK=.false.) + (/ dimid /), this%vardesc(file_index_loc)%p, existOK=.false.) ! long_name - ierr=pio_put_att(File, this%vardesc, 'long_name', trim(this%long_name)) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'long_name', trim(this%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_horiz_coord_attr') ! units - ierr=pio_put_att(File, this%vardesc, 'units', trim(this%units)) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'units', trim(this%units)) call cam_pio_handle_error(ierr, 'Error writing "units" attr in write_horiz_coord_attr') ! Take care of bounds if they exist if (associated(this%bnds)) then - allocate(this%bndsvdesc) - ierr=pio_put_att(File, this%vardesc, 'bounds', trim(this%name)//'_bnds') + allocate(this%bndsvdesc(file_index_loc)%p) + ierr=pio_put_att(File, this%vardesc(file_index_loc)%p, 'bounds', trim(this%name)//'_bnds') call cam_pio_handle_error(ierr, 'Error writing "'//trim(this%name)//'_bnds" attr in write_horiz_coord_attr') call cam_pio_def_dim(File, 'nbnd', 2, bnds_dimid, existOK=.true.) call cam_pio_def_var(File, trim(this%name)//'_bnds', pio_double, & - (/ bnds_dimid, dimid /), this%bndsvdesc, existOK=.false.) + (/ bnds_dimid, dimid /), this%bndsvdesc(file_index_loc)%p, existOK=.false.) call cam_pio_handle_error(ierr, 'Error defining "'//trim(this%name)//'bnds" in write_horiz_coord_attr') ! long_name - ierr=pio_put_att(File, this%bndsvdesc, 'long_name', trim(this%name)//' bounds') + ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'long_name', trim(this%name)//' bounds') call cam_pio_handle_error(ierr, 'Error writing bounds "long_name" attr in write_horiz_coord_attr') ! units - ierr=pio_put_att(File, this%bndsvdesc, 'units', trim(this%units)) + ierr=pio_put_att(File, this%bndsvdesc(file_index_loc)%p, 'units', trim(this%units)) call cam_pio_handle_error(ierr, 'Error writing bounds "units" attr in write_horiz_coord_attr') end if ! There are bounds for this coordinate end if ! We define the variable @@ -622,7 +636,7 @@ end subroutine write_horiz_coord_attr ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_var(this, File) + subroutine write_horiz_coord_var(this, File, file_index) use cam_pio_utils, only: cam_pio_get_decomp use pio, only: file_desc_t, pio_double, iosystem_desc_t use pio, only: pio_put_var, pio_write_darray @@ -637,6 +651,7 @@ subroutine write_horiz_coord_var(this, File) ! Dummy arguments class(horiz_coord_t), intent(inout) :: this type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables character(len=120) :: errormsg @@ -645,12 +660,19 @@ subroutine write_horiz_coord_var(this, File) integer :: fdims(1) integer :: err_handling type(io_desc_t) :: iodesc + integer :: file_index_loc !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! type(iosystem_desc_t), pointer :: piosys !!XXgoldyXX: End of this part of the hack + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if + ! Check to make sure we are supposed to write this var - if (associated(this%vardesc)) then + if (associated(this%vardesc(file_index_loc)%p)) then ! We will handle errors for this routine call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) @@ -662,22 +684,22 @@ subroutine write_horiz_coord_var(this, File) call this%get_coord_len(fdims(1)) allocate(iodesc) call cam_pio_get_decomp(iodesc, ldims, fdims, PIO_DOUBLE, this%map) - call pio_write_darray(File, this%vardesc, iodesc, this%values, ierr) + call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr) nullify(iodesc) ! CAM PIO system takes over memory management of iodesc #else !!XXgoldyXX: HACK to get around circular dependencies. Fix this!! piosys => shr_pio_getiosys(atm_id) call pio_initdecomp(piosys, pio_double, (/this%dimsize/), this%map, & iodesc) - call pio_write_darray(File, this%vardesc, iodesc, this%values, ierr) + call pio_write_darray(File, this%vardesc(file_index_loc)%p, iodesc, this%values, ierr) call pio_syncfile(File) call pio_freedecomp(File, iodesc) ! Take care of bounds if they exist - if (associated(this%bnds) .and. associated(this%bndsvdesc)) then + if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then call pio_initdecomp(piosys, pio_double, (/2, this%dimsize/), & this%map, iodesc) - call pio_write_darray(File, this%bndsvdesc, iodesc, this%bnds, ierr) + call pio_write_darray(File, this%bndsvdesc(file_index_loc)%p, iodesc, this%bnds, ierr) call pio_syncfile(File) call pio_freedecomp(File, iodesc) end if @@ -685,10 +707,10 @@ subroutine write_horiz_coord_var(this, File) !!XXgoldyXX: End of this part of the hack else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, this%vardesc, this%values) + ierr = pio_put_var(File, this%vardesc(file_index_loc)%p, this%values) ! Take care of bounds if they exist - if (associated(this%bnds) .and. associated(this%bndsvdesc)) then - ierr = pio_put_var(File, this%bndsvdesc, this%bnds) + if (associated(this%bnds) .and. associated(this%bndsvdesc(file_index_loc)%p)) then + ierr = pio_put_var(File, this%bndsvdesc(file_index_loc)%p, this%bnds) end if end if write(errormsg, *) 'Error writing variable values for ',trim(this%name),& @@ -699,12 +721,12 @@ subroutine write_horiz_coord_var(this, File) call pio_seterrorhandling(File, err_handling) ! We are done with this variable descriptor, reset for next file - deallocate(this%vardesc) - nullify(this%vardesc) + deallocate(this%vardesc(file_index_loc)%p) + nullify(this%vardesc(file_index_loc)%p) ! Same with the bounds descriptor - if (associated(this%bndsvdesc)) then - deallocate(this%bndsvdesc) - nullify(this%bndsvdesc) + if (associated(this%bndsvdesc(file_index_loc)%p)) then + deallocate(this%bndsvdesc(file_index_loc)%p) + nullify(this%bndsvdesc(file_index_loc)%p) end if end if ! Do we write the variable? @@ -2170,7 +2192,7 @@ end subroutine setAttrPtrNext ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_int(attr, File) + subroutine write_cam_grid_attr_0d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_int, & pio_inq_att, PIO_GLOBAL use cam_pio_utils, only: cam_pio_def_var @@ -2178,22 +2200,30 @@ subroutine write_cam_grid_attr_0d_int(attr, File) ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then if (len_trim(attr%long_name) > 0) then ! This 0d attribute is a scalar variable with a long_name attribute ! First, define the variable - allocate(attr%vardesc) - call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc, & + allocate(attr%vardesc(file_index_loc)%p) + call cam_pio_def_var(File, trim(attr%name), pio_int, attr%vardesc(file_index_loc)%p, & existOK=.false.) - ierr=pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + ierr=pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_0d_int') else ! This 0d attribute is a global attribute @@ -2217,22 +2247,30 @@ end subroutine write_cam_grid_attr_0d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_char(attr, File) + subroutine write_cam_grid_attr_0d_char(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, & pio_inq_att, PIO_GLOBAL ! Dummy arguments class(cam_grid_attribute_0d_char_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! The 0d char attributes are global attribues ! Check to see if the attribute already exists in the file ierr = pio_inq_att(File, PIO_GLOBAL, attr%name, attrtype, attrlen) @@ -2253,7 +2291,7 @@ end subroutine write_cam_grid_attr_0d_char ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_int(attr, File) + subroutine write_cam_grid_attr_1d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr use pio, only: pio_inq_dimid, pio_int use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile @@ -2261,15 +2299,23 @@ subroutine write_cam_grid_attr_1d_int(attr, File) ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! Check to see if the dimension already exists in the file ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) if (ierr /= PIO_NOERR) then @@ -2281,10 +2327,10 @@ subroutine write_cam_grid_attr_1d_int(attr, File) call endrun(errormsg) end if ! Time to define the variable - allocate(attr%vardesc) + allocate(attr%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(attr%name), pio_int, (/dimid/), & - attr%vardesc, existOK=.false.) - ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + attr%vardesc(file_index_loc)%p, existOK=.false.) + ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int') end if @@ -2298,7 +2344,7 @@ end subroutine write_cam_grid_attr_1d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_r8(attr, File) + subroutine write_cam_grid_attr_1d_r8(attr, File, file_index) use pio, only: file_desc_t, pio_put_att, pio_noerr, pio_double, & pio_inq_dimid use cam_pio_utils, only: cam_pio_def_var, cam_pio_closefile @@ -2306,15 +2352,23 @@ subroutine write_cam_grid_attr_1d_r8(attr, File) ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute - if (.not. associated(attr%vardesc)) then + if (.not. associated(attr%vardesc(file_index_loc)%p)) then ! Check to see if the dimension already exists in the file ierr = pio_inq_dimid(File, trim(attr%dimname), dimid) if (ierr /= PIO_NOERR) then @@ -2326,11 +2380,11 @@ subroutine write_cam_grid_attr_1d_r8(attr, File) call endrun(errormsg) end if ! Time to define the variable - allocate(attr%vardesc) + allocate(attr%vardesc(file_index_loc)%p) call cam_pio_def_var(File, trim(attr%name), pio_double, (/dimid/), & - attr%vardesc, existOK=.false.) + attr%vardesc(file_index_loc)%p, existOK=.false.) ! long_name - ierr = pio_put_att(File, attr%vardesc, 'long_name', trim(attr%long_name)) + ierr = pio_put_att(File, attr%vardesc(file_index_loc)%p, 'long_name', trim(attr%long_name)) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8') end if @@ -2386,13 +2440,14 @@ end subroutine cam_grid_attribute_copy ! coordinates. ! !--------------------------------------------------------------------------- - subroutine cam_grid_write_attr(File, grid_id, header_info) + subroutine cam_grid_write_attr(File, grid_id, header_info, file_index) use pio, only: file_desc_t, PIO_BCAST_ERROR, pio_seterrorhandling ! Dummy arguments type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, intent(in) :: grid_id type(cam_grid_header_info_t), intent(inout) :: header_info + integer, optional, intent(in) :: file_index ! Local variables integer :: gridind @@ -2400,13 +2455,19 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) type(cam_grid_attr_ptr_t), pointer :: attrPtr integer :: dimids(2) integer :: err_handling + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if gridind = get_cam_grid_index(grid_id) !! Fill this in to make sure history finds grid header_info%grid_id = grid_id if (allocated(header_info%hdims)) then - ! This shouldn't happen but, no harm, no foul deallocate(header_info%hdims) end if @@ -2420,7 +2481,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) end if ! Only write this grid if not already defined - if (cam_grids(gridind)%attrs_defined) then + if (cam_grids(gridind)%attrs_defined(file_index_loc)) then ! We need to fill out the hdims info for this grid call cam_grids(gridind)%find_dimids(File, dimids) if (dimids(2) < 0) then @@ -2432,8 +2493,8 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) end if else ! Write the horizontal coord attributes first so that we have the dims - call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2)) - call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1)) + call cam_grids(gridind)%lat_coord%write_attr(File, dimids(2), file_index=file_index_loc) + call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), file_index=file_index_loc) if (dimids(2) == dimids(1)) then allocate(header_info%hdims(1)) @@ -2451,7 +2512,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) !!XXgoldyXX: Is this not working in PGI? ! attr => attrPtr%getAttr() attr => attrPtr%attr - call attr%write_attr(File) + call attr%write_attr(File, file_index=file_index_loc) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2459,45 +2520,53 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - - cam_grids(gridind)%attrs_defined = .true. + cam_grids(gridind)%attrs_defined(file_index_loc) = .true. end if end subroutine cam_grid_write_attr - subroutine write_cam_grid_val_0d_int(attr, File) + subroutine write_cam_grid_val_0d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_var ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables integer :: ierr + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if ! We only write this var if it is a variable - if (associated(attr%vardesc)) then - ierr = pio_put_var(File, attr%vardesc, attr%ival) + if (associated(attr%vardesc(file_index_loc)%p)) then + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%ival) call cam_pio_handle_error(ierr, 'Error writing value in write_cam_grid_val_0d_int') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_0d_int - subroutine write_cam_grid_val_0d_char(attr, File) + subroutine write_cam_grid_val_0d_char(attr, File, file_index) use pio, only: file_desc_t ! Dummy arguments class(cam_grid_attribute_0d_char_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! This subroutine is a stub because global attributes are written ! in define mode return end subroutine write_cam_grid_val_0d_char - subroutine write_cam_grid_val_1d_int(attr, File) + subroutine write_cam_grid_val_1d_int(attr, File, file_index) use pio, only: file_desc_t, pio_put_var, pio_int, & pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp @@ -2505,36 +2574,44 @@ subroutine write_cam_grid_val_1d_int(attr, File) ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables integer :: ierr type(io_desc_t), pointer :: iodesc + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if nullify(iodesc) ! Since more than one grid can share an attribute, assume that if the ! vardesc is not associated, another grid write the values - if (associated(attr%vardesc)) then + if (associated(attr%vardesc(file_index_loc)%p)) then ! Write out the values for this dimension variable if (associated(attr%map)) then ! This is a distributed variable, use pio_write_darray allocate(iodesc) call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_int) - call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr) + call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr) call pio_freedecomp(File, iodesc) deallocate(iodesc) nullify(iodesc) else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, attr%vardesc, attr%values) + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values) end if call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_int') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_1d_int - subroutine write_cam_grid_val_1d_r8(attr, File) + subroutine write_cam_grid_val_1d_r8(attr, File, file_index) use pio, only: file_desc_t, pio_put_var, pio_double, & pio_write_darray, io_desc_t, pio_freedecomp use cam_pio_utils, only: cam_pio_newdecomp @@ -2542,54 +2619,69 @@ subroutine write_cam_grid_val_1d_r8(attr, File) ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File + integer, optional, intent(in) :: file_index ! Local variables integer :: ierr type(io_desc_t), pointer :: iodesc + integer :: file_index_loc + + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if nullify(iodesc) ! Since more than one grid can share an attribute, assume that if the ! vardesc is not associated, another grid write the values - if (associated(attr%vardesc)) then + if (associated(attr%vardesc(file_index_loc)%p)) then ! Write out the values for this dimension variable if (associated(attr%map)) then ! This is a distributed variable, use pio_write_darray allocate(iodesc) call cam_pio_newdecomp(iodesc, (/attr%dimsize/), attr%map, pio_double) - call pio_write_darray(File, attr%vardesc, iodesc, attr%values, ierr) + call pio_write_darray(File, attr%vardesc(file_index_loc)%p, iodesc, attr%values, ierr) call pio_freedecomp(File, iodesc) deallocate(iodesc) nullify(iodesc) else ! This is a local variable, pio_put_var should work fine - ierr = pio_put_var(File, attr%vardesc, attr%values) + ierr = pio_put_var(File, attr%vardesc(file_index_loc)%p, attr%values) end if call cam_pio_handle_error(ierr, 'Error writing variable values in write_cam_grid_val_1d_r8') - deallocate(attr%vardesc) - nullify(attr%vardesc) + deallocate(attr%vardesc(file_index_loc)%p) + nullify(attr%vardesc(file_index_loc)%p) end if end subroutine write_cam_grid_val_1d_r8 - subroutine cam_grid_write_var(File, grid_id) + subroutine cam_grid_write_var(File, grid_id, file_index) use pio, only: file_desc_t, pio_bcast_error, pio_seterrorhandling ! Dummy arguments type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, intent(in) :: grid_id + integer, optional, intent(in) :: file_index ! Local variables integer :: gridind integer :: err_handling class(cam_grid_attribute_t), pointer :: attr type(cam_grid_attr_ptr_t), pointer :: attrPtr + integer :: file_index_loc + if (present(file_index)) then + file_index_loc = file_index + else + file_index_loc = 1 + end if gridind = get_cam_grid_index(grid_id) ! Only write if not already done - if (cam_grids(gridind)%attrs_defined) then + if (cam_grids(gridind)%attrs_defined(file_index_loc)) then ! Write the horizontal coorinate values - call cam_grids(gridind)%lon_coord%write_var(File) - call cam_grids(gridind)%lat_coord%write_var(File) + call cam_grids(gridind)%lon_coord%write_var(File, file_index) + call cam_grids(gridind)%lat_coord%write_var(File, file_index) ! We will handle errors for this routine call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) @@ -2600,7 +2692,7 @@ subroutine cam_grid_write_var(File, grid_id) !!XXgoldyXX: Is this not working in PGI? ! attr => attrPtr%getAttr() attr => attrPtr%attr - call attr%write_val(File) + call attr%write_val(File, file_index=file_index_loc) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2609,7 +2701,7 @@ subroutine cam_grid_write_var(File, grid_id) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - cam_grids(gridind)%attrs_defined = .false. + cam_grids(gridind)%attrs_defined(file_index_loc) = .false. end if end subroutine cam_grid_write_var