From 8d0754e79f07a61bdff8506fea60805e16eee309 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 22 Sep 2023 00:54:50 -0600 Subject: [PATCH 01/28] separate accumulated and instantaneous fields --- src/control/cam_history.F90 | 1502 +++++++++++++++------------ src/control/cam_history_support.F90 | 4 +- src/control/filenames.F90 | 11 +- src/control/sat_hist.F90 | 60 +- src/utils/cam_grid_support.F90 | 122 ++- 5 files changed, 979 insertions(+), 720 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 4cafd3d6c1..0fe8aed455 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -126,7 +126,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 +139,7 @@ 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 integer :: nfmaster = 0 ! number of fields in master field list integer :: nflds(ptapes) ! number of fields per tape @@ -164,7 +165,7 @@ module cam_history 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) :: nhfil(ptapes,2) ! 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 @@ -192,6 +193,7 @@ module cam_history logical :: collect_column_output(ptapes) integer :: maxvarmdims=1 + integer :: maxsplitfiles=2 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -296,6 +298,10 @@ 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. + ! Flag for if there are instantaneous fields specified for a given tape + logical :: hfile_inst(ptapes) = .false. interface addfld @@ -470,6 +476,11 @@ subroutine intht (model_doi_url_in) ! do t=1,ptapes do f=1,nflds(t) + if (tape(t)%hlist(f)%avgflag .eq. 'I') then + hfile_inst(t) = .true. + else + hfile_accum(t) = .true. + end if begdim1 = tape(t)%hlist(f)%field%begdim1 enddim1 = tape(t)%hlist(f)%field%enddim1 begdim2 = tape(t)%hlist(f)%field%begdim2 @@ -778,9 +789,9 @@ 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%ta.%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 end if ! @@ -1077,9 +1088,10 @@ subroutine restart_vars_setnames() 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 +1414,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 @@ -1542,7 +1557,6 @@ subroutine write_restart_history ( File, & integer :: maxnflds real(r8) :: integral ! hbuf area weighted integral - maxnflds = maxval(nflds) allocate(xyfill(maxnflds, ptapes)) xyfill = 0 @@ -1584,7 +1598,6 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('fincl') ierr= pio_put_var(File, vdesc, fincl(:,1:ptapes)) - vdesc => restartvar_getdesc('fincllonlat') ierr= pio_put_var(File, vdesc, fincllonlat(:,1:ptapes)) @@ -1608,13 +1621,10 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('nfpath') ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) - vdesc => restartvar_getdesc('cpath') 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)) vdesc => restartvar_getdesc('ncprec') @@ -1630,6 +1640,7 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('lcltod_stop') ierr = pio_put_var(File, vdesc, lcltod_stop(1:ptapes)) + write(iulog,*) 'finished put var' field_name_desc => restartvar_getdesc('field_name') decomp_type_desc => restartvar_getdesc('decomp_type') @@ -1779,7 +1790,7 @@ subroutine read_restart_history (File) ! ! Local workspace ! - integer t, f, ff ! tape, field indices + integer t, f, fld, ff ! 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 @@ -1894,7 +1905,7 @@ subroutine read_restart_history (File) ierr = pio_inq_varid(File, 'cpath', vdesc) 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)) @@ -2214,21 +2225,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(1), 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(1), fname_tmp, vdesc) + call cam_pio_var_info(tape(t)%Files(1), 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(1), dimids(i), dname_tmp) dimid = get_hist_coord_index(dname_tmp) if(dimid >= 1) then dimcnt = dimcnt + 1 @@ -2237,20 +2248,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 @@ -2258,53 +2269,53 @@ 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(1), 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(1), fdecomp, & + fdims(1:nfdims), dimlens(1:ndims), tape(t)%hlist(fld)%hbuf(:,1,:), vdesc) end if if ( associated(tape(t)%hlist(f)%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(1), 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(1), 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(1), 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(1), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(1), 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(1), 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(1), 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(1), trim(fname_tmp)//'_nacs', vdesc) + call cam_pio_var_info(tape(t)%Files(1), 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(1)) end if ! rgnht(t) @@ -2343,12 +2354,12 @@ subroutine read_restart_history (File) else if (nfils(t) > 0) then call getfil (cpath(t), locfn) - call cam_pio_openfile(tape(t)%File, locfn, PIO_WRITE) + call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) 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(1)) end if end if ! @@ -2356,13 +2367,13 @@ 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) + write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,1), mfilt(t) end if do f=1,nflds(t) deallocate(tape(t)%hlist(f)%varid) nullify(tape(t)%hlist(f)%varid) end do - call cam_pio_closefile(tape(t)%File) + call cam_pio_closefile(tape(t)%Files(1)) nfils(t) = 0 end if end if @@ -3939,48 +3950,48 @@ subroutine h_inquire (t) ! 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)%Files(1),'ndcur ', tape(t)%ndcurid) + ierr=pio_inq_varid (tape(t)%Files(1),'nscur ', tape(t)%nscurid) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'time_bounds', tape(t)%tbndid) + ierr=pio_inq_varid (tape(t)%Files(1),'date_written',tape(t)%date_writtenid) + ierr=pio_inq_varid (tape(t)%Files(1),'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(1),'tsec ',tape(t)%tsecid) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'co2vmr ', tape(t)%co2vmrid) + ierr=pio_inq_varid (tape(t)%Files(1),'ch4vmr ', tape(t)%ch4vmrid) + ierr=pio_inq_varid (tape(t)%Files(1),'n2ovmr ', tape(t)%n2ovmrid) + ierr=pio_inq_varid (tape(t)%Files(1),'f11vmr ', tape(t)%f11vmrid) + ierr=pio_inq_varid (tape(t)%Files(1),'f12vmr ', tape(t)%f12vmrid) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'f107 ', tape(t)%f107id) + ierr=pio_inq_varid (tape(t)%Files(1),'f107a ', tape(t)%f107aid) + ierr=pio_inq_varid (tape(t)%Files(1),'f107p ', tape(t)%f107pid) + ierr=pio_inq_varid (tape(t)%Files(1),'kp ', tape(t)%kpid) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'byimf', tape(t)%byimfid) + ierr=pio_inq_varid (tape(t)%Files(1),'bzimf', tape(t)%bzimfid) + ierr=pio_inq_varid (tape(t)%Files(1),'swvel', tape(t)%swvelid) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'colat_crit1', tape(t)%colat_crit1_id) + ierr=pio_inq_varid (tape(t)%Files(1),'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) + ierr=pio_inq_varid (tape(t)%Files(1),'date ', tape(t)%dateid) + ierr=pio_inq_varid (tape(t)%Files(1),'datesec ', tape(t)%datesecid) + ierr=pio_inq_varid (tape(t)%Files(1),'time ', tape(t)%timeid) ! @@ -4003,9 +4014,9 @@ subroutine h_inquire (t) 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)) + ierr = pio_inq_varid(tape(t)%Files(1), 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) + ierr = pio_get_att(tape(t)%Files(1), 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)//')') @@ -4013,15 +4024,15 @@ subroutine h_inquire (t) 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)) + ierr = pio_inq_varid(tape(t)%Files(1), 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) + ierr = pio_inq_attlen(tape(t)%Files(1),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', & + ierr=pio_get_att(tape(t)%Files(1),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) @@ -4167,9 +4178,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 @@ -4219,6 +4230,7 @@ subroutine h_define (t, restart) integer :: amode logical :: interpolate logical :: patch_output + logical :: set_flag integer :: cam_snapshot_before_num integer :: cam_snapshot_after_num character(len=32) :: cam_take_snapshot_before @@ -4229,38 +4241,58 @@ subroutine h_define (t, restart) cam_snapshot_before_num_out = cam_snapshot_before_num, & cam_snapshot_after_num_out = cam_snapshot_after_num) + if (masterproc) then + write(iulog,*) 'peverwhee - starting h_define' + end if + if(restart) then tape => restarthistory_tape 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) write(iulog,*)'Opening netcdf history file ', trim(nhfil(t,1)) end if amode = PIO_CLOBBER if(restart) then - call cam_pio_createfile (tape(t)%File, hrestpath(t), amode) + allocate(tape(t)%Files(1)) + call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) else - call cam_pio_createfile (tape(t)%File, nhfil(t), amode) + ! figure out how many history files to generate for this tape + if (hfile_accum(t) .and. hfile_inst(t)) then + allocate(tape(t)%Files(2)) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) + call cam_pio_createfile (tape(t)%Files(2), nhfil(t,2), amode) + else if (hfile_accum(t)) then + allocate(tape(t)%Files(1)) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) + else if (hfile_inst(t)) then + allocate(tape(t)%Files(1)) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,2), 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) + do f = 1, size(tape(t)%Files) + call cam_pio_def_dim(tape(t)%Files(f), 'ncol', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(f), 'nbnd', 2, bnddim) + end do allocate(latvar(1), lonvar(1)) allocate(latvar(1)%vd, lonvar(1)%vd) - call cam_pio_def_var(tape(t)%File, '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') - - call cam_pio_def_var(tape(t)%File, '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') + do f = 1, size(tape(t)%Files) + call cam_pio_def_var(tape(t)%Files(f), 'lat', pio_double, (/timdim/), & + latvar(1)%vd) + ierr=pio_put_att (tape(t)%Files(f), latvar(1)%vd, 'long_name', 'latitude') + ierr=pio_put_att (tape(t)%Files(f), latvar(1)%vd, 'units', 'degrees_north') + + call cam_pio_def_var(tape(t)%Files(f), 'lon', pio_double, (/timdim/), & + lonvar(1)%vd) + ierr=pio_put_att (tape(t)%Files(f), lonvar(1)%vd,'long_name','longitude') + ierr=pio_put_att (tape(t)%Files(f), lonvar(1)%vd,'units','degrees_east') + end do else ! @@ -4274,7 +4306,14 @@ 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, size(tape(t)%Files) + if (f == size(tape(t)%Files)) then + set_flag = .true. + else + set_flag = .false. + end if + call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), set_attr_flag=set_flag) + end do else if (patch_output) then ! We are doing patch (column) output if (allocated(header_info)) then @@ -4282,91 +4321,41 @@ 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, size(tape(t)%Files) + call tape(t)%patches(i)%write_attrs(tape(t)%Files(f)) + 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, size(tape(t)%Files) + if (f == size(tape(t)%Files)) then + set_flag = .true. + else + set_flag = .false. + end if + call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), set_attr_flag=set_flag) + 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, size(tape(t)%Files) + 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 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' @@ -4380,412 +4369,502 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) + do f = 1, size(tape(t)%Files) + ! 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)) + ! 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) - if(.not. is_satfile(t)) then + ierr=pio_def_var (tape(t)%Files(f),'time',pio_double,(/timdim/),tape(t)%timeid) - ierr=pio_put_att (tape(t)%File, tape(t)%timeid, 'bounds', 'time_bnds') + 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,'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, 'calendar', trim(calendar)) - 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_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_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') - - ! - ! Create variables for model timing and header information - ! - - 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)) + 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) +! Put these back in when they are filled properly +! ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'title',ctitle) +! ierr= pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'Version', & +! '$Name$') +! ierr= pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'revision_Id', & +! '$Id$') + + 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 - 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_put_att (tape(t)%Files(f), PIO_GLOBAL, 'time_period_freq', trim(time_per_freq)) - 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)) + if(.not. is_satfile(t)) then - 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_put_att (tape(t)%Files(f), tape(t)%timeid, 'bounds', 'time_bounds') - 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)%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') + ! + ! 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)%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)%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)%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)) - - 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),'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 - ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - do f = 1, nflds(t) + 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 + ! + + 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)) + + + 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)%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 / geomagetic 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)) - !! 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 + 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 - 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 - ! 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 ( 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 ! .not. is_satfile + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! + ! Create variables and attributes for field list + ! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + do fld = 1, nflds(t) + if (size(tape(t)%Files) > 1) then + ! we have two files - instantaneous and accumulated + if (f == 1) 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 + 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 = 'instantaneous' + else + str = tape(t)%hlist(fld)%time_op + end if + if (len_trim(cell_methods) > 0) then + cell_methods = trim(cell_methods)//' '//'time: '//str + else + cell_methods = trim(cell_methods)//'time: '//str + end if + 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) - - if(masterproc) then - write(iulog,*)'H_DEFINE: Successfully opened netcdf file ' - endif + end if + end do ! Loop over output patches + end do ! Loop over fields + ! + deallocate(mdimids) + ret = pio_enddef(tape(t)%Files(f)) + + 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, size(tape(t)%Files) + if (f == size(tape(t)%Files)) then + set_flag = .true. + else + set_flag = .false. + end if + call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, set_attr_flag=set_flag) + 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, size(tape(t)%Files) + if (f == size(tape(t)%Files)) then + set_flag = .true. + else + set_flag = .false. + end if + call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), set_attr_flag=set_flag) + 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, size(tape(t)%Files) + call tape(t)%patches(i)%write_vals(tape(t)%Files(f)) + end do end do end if ! interpolate if (allocated(lonvar)) then @@ -4796,28 +4875,29 @@ 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, size(tape(t)%Files) + 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 @@ -4828,7 +4908,9 @@ subroutine h_define (t, restart) end if ! Write the mdim variable data - call write_hist_coord_vars(tape(t)%File, restart) + do f = 1, size(tape(t)%Files) + call write_hist_coord_vars(tape(t)%Files(f), restart) + end do end subroutine h_define @@ -5118,14 +5200,15 @@ 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) :: fld integer, intent(in) :: t + integer, intent(in) :: f logical, intent(in) :: restart ! !----------------------------------------------------------------------- @@ -5165,10 +5248,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) @@ -5176,7 +5259,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 @@ -5187,12 +5270,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 @@ -5200,115 +5283,115 @@ 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 + else if (tape(t)%hlist(fld)%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, & +! call write_interpolated(tape(t)%Files(f), compid, varid, & ! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & ! mdimsize, PIO_DOUBLE, fdecomp) else ! 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 @@ -5390,7 +5473,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) @@ -5409,13 +5492,16 @@ subroutine wshist (rgnht_in) real(r8) :: time ! current 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 #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. @@ -5486,28 +5572,49 @@ 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 ! + duplicate = .false. 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) + if (masterproc)then + if (trim(fname) == trim(nhfil(f,1))) then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + duplicate = .true. + else if (trim(fname_acc) == trim(nhfil(f,1))) then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + duplicate = .true. + else if (trim(fname_inst) == trim(nhfil(f,2))) then + write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + duplicate = .true. + end if + if (duplicate) then + 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) + end if + call endrun 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) + nhfil(t,1) = fname_acc + nhfil(t,2) = fname_inst + if(masterproc) then + write(iulog,*)'WSHIST: accumulated nhfil(',t,')=',trim(nhfil(t,1)) + write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,2)) + end if + cpath(t) = nhfil(t,1) if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) + else + nhfil(t,1) = fname + nhfil(t,2) = fname end if call h_define (t, restart) end if @@ -5526,48 +5633,62 @@ 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)%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/)) + do f = 1, size(tape(t)%Files) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) + end do 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/)) + do f = 1, size(tape(t)%Files) + 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/)) + end do 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 /) ) + do f = 1, size(tape(t)%Files) + 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 /) ) + end do 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 /) ) + do f = 1, size(tape(t)%Files) + 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 /) ) + end do 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) /) ) + do f = 1, size(tape(t)%Files) + 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) /) ) + end do endif end if - ierr = pio_put_var (tape(t)%File, tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + do f = 1, size(tape(t)%Files) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + 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, size(tape(t)%Files) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + end do #endif - ierr = pio_put_var (tape(t)%File, tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) + do f = 1, size(tape(t)%Files) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) + end do time = ndcur + nscur/86400._r8 - ierr=pio_put_var (tape(t)%File, tape(t)%timeid, (/start/),(/count1/),(/time/)) startc(1) = 1 startc(2) = start @@ -5579,32 +5700,54 @@ subroutine wshist (rgnht_in) 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, size(tape(t)%Files) + if (size(tape(t)%Files) > 1) then + ! We have two files - one for accumulated and one for instantaneous fields + if (f == 1) 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 + ! instantaneous tape - time is current time + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) + end if + else + if (hfile_accum(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 + ! instantaneous tape - time is current time + ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) + end if + 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, size(tape(t)%Files) + 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 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 @@ -5612,31 +5755,48 @@ 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, size(tape(t)%Files) + if (size(tape(t)%Files) > 1) then + if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. f == 1) then + cycle + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == 2) then + cycle + end if + else + if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. hfile_accum(t)) then + cycle + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. hfile_inst(t)) then + cycle + end if + 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) + do f = 1, size(tape(t)%Files) + call cam_pio_closefile(tape(t)%Files(f)) + end do 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 @@ -6239,8 +6399,10 @@ 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 + write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,1)) + end if + if(pio_file_is_open(tape(t)%Files(1))) then if (nlend .or. lfill(t)) then do f=1,nflds(t) if (associated(tape(t)%hlist(f)%varid)) then @@ -6249,8 +6411,10 @@ subroutine wrapup (rstwr, nlend) end if end do end if - call cam_pio_closefile(tape(t)%File) end if + do f = 1, size(tape(t)%Files) + call cam_pio_closefile(tape(t)%Files(f)) + end do if (nhtfrq(t) /= 0 .or. nstep > 0) then ! @@ -6273,7 +6437,9 @@ 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) + do f = 1, size(tape(t)%Files) + call cam_PIO_openfile (tape(t)%Files(f), nhfil(t,f), PIO_WRITE) + end do call h_inquire(t) end if endif ! if 0 timestep of montly run**** diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 495ce7b519..3865604851 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -197,7 +197,7 @@ module cam_history_support ! PIO ids ! - type(file_desc_t) :: File ! PIO file id + type(file_desc_t), allocatable :: Files(:) ! 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..3b46bf2115 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -266,12 +266,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, last_entry) 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 + logical, optional, intent(in) :: last_entry end subroutine write_cam_grid_attr end interface @@ -545,7 +546,7 @@ end function horiz_coord_create ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_attr(this, File, dimid_out) + subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) 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 +555,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 + logical, optional, intent(in) :: last_entry ! Local variables type(var_desc_t) :: vardesc @@ -562,10 +564,17 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) integer :: bnds_dimid ! PIO dim ID for bounds integer :: err_handling integer :: ierr + logical :: last_entry_loc ! We will handle errors for this routine call pio_seterrorhandling(File, PIO_BCAST_ERROR,err_handling) + if (present(last_entry)) then + last_entry_loc = last_entry + else + last_entry_loc = .true. + end if + ! Make sure the dimension exists in the file call this%get_dim_name(dimname) call cam_pio_def_dim(File, trim(dimname), this%dimsize, dimid, & @@ -609,6 +618,11 @@ subroutine write_horiz_coord_attr(this, File, dimid_out) dimid_out = dimid end if + if (.not. last_entry_loc) then + ! if we still have more split files to process, enable that + deallocate(this%vardesc) + end if + ! Back to old error handling call pio_seterrorhandling(File, err_handling) @@ -2170,7 +2184,7 @@ end subroutine setAttrPtrNext ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_int(attr, File) + subroutine write_cam_grid_attr_0d_int(attr, File, last_entry) 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,11 +2192,19 @@ 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr + logical :: last_entry_loc + + if (present(last_entry)) then + last_entry_loc = last_entry + else + last_entry_loc = .true. + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute @@ -2207,6 +2229,10 @@ subroutine write_cam_grid_attr_0d_int(attr, File) end if end if + if (.not. last_entry_loc .and. associated(attr%vardesc)) then + deallocate(attr%vardesc) + end if + end subroutine write_cam_grid_attr_0d_int !--------------------------------------------------------------------------- @@ -2217,18 +2243,26 @@ 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, last_entry) 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr + logical :: last_entry_loc + + if (present(last_entry)) then + last_entry_loc = last_entry + else + last_entry_loc = .true. + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute @@ -2243,6 +2277,10 @@ subroutine write_cam_grid_attr_0d_char(attr, File) end if end if + if (.not. last_entry_loc .and. associated(attr%vardesc)) then + deallocate(attr%vardesc) + end if + end subroutine write_cam_grid_attr_0d_char !--------------------------------------------------------------------------- @@ -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, last_entry) 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,11 +2299,19 @@ 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + logical :: last_entry_loc + + if (present(last_entry)) then + last_entry_loc = last_entry + else + last_entry_loc = .true. + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute @@ -2288,6 +2334,10 @@ subroutine write_cam_grid_attr_1d_int(attr, File) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_int') end if + if (.not. last_entry_loc .and. associated(attr%vardesc)) then + deallocate(attr%vardesc) + end if + end subroutine write_cam_grid_attr_1d_int !--------------------------------------------------------------------------- @@ -2298,7 +2348,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, last_entry) 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,11 +2356,19 @@ 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr + logical :: last_entry_loc + + if (present(last_entry)) then + last_entry_loc = last_entry + else + last_entry_loc = .true. + end if ! Since more than one grid can share an attribute, assume that if the ! vardesc is associated, that grid defined the attribute @@ -2334,6 +2392,10 @@ subroutine write_cam_grid_attr_1d_r8(attr, File) call cam_pio_handle_error(ierr, 'Error writing "long_name" attr in write_cam_grid_attr_1d_r8') end if + if (.not. last_entry_loc .and. associated(attr%vardesc)) then + deallocate(attr%vardesc) + end if + end subroutine write_cam_grid_attr_1d_r8 !--------------------------------------------------------------------------- @@ -2386,13 +2448,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, set_attr_flag) 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 + logical, optional, intent(in) :: set_attr_flag ! Local variables integer :: gridind @@ -2400,6 +2463,13 @@ subroutine cam_grid_write_attr(File, grid_id, header_info) type(cam_grid_attr_ptr_t), pointer :: attrPtr integer :: dimids(2) integer :: err_handling + logical :: set_flag_local + + if (present(set_attr_flag)) then + set_flag_local = set_attr_flag + else + set_flag_local = .true. + end if gridind = get_cam_grid_index(grid_id) !! Fill this in to make sure history finds grid @@ -2432,8 +2502,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), last_entry=set_flag_local) + call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), last_entry=set_flag_local) if (dimids(2) == dimids(1)) then allocate(header_info%hdims(1)) @@ -2451,7 +2521,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, last_entry=set_flag_local) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2459,18 +2529,20 @@ 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. + if (set_flag_local) then + cam_grids(gridind)%attrs_defined = .true. + end if 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, last_entry) 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: ierr @@ -2485,19 +2557,20 @@ subroutine write_cam_grid_val_0d_int(attr, File) 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, last_entry) 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 + logical, optional, intent(in) :: last_entry ! 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, last_entry) 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,6 +2578,7 @@ 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: ierr @@ -2534,7 +2608,7 @@ subroutine write_cam_grid_val_1d_int(attr, File) 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, last_entry) 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,6 +2616,7 @@ 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 + logical, optional, intent(in) :: last_entry ! Local variables integer :: ierr @@ -2571,18 +2646,26 @@ subroutine write_cam_grid_val_1d_r8(attr, File) end subroutine write_cam_grid_val_1d_r8 - subroutine cam_grid_write_var(File, grid_id) + subroutine cam_grid_write_var(File, grid_id, set_attr_flag) 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 + logical, optional, intent(in) :: set_attr_flag ! Local variables integer :: gridind integer :: err_handling class(cam_grid_attribute_t), pointer :: attr type(cam_grid_attr_ptr_t), pointer :: attrPtr + logical :: set_flag_local + + if (present(set_attr_flag)) then + set_flag_local = set_attr_flag + else + set_flag_local = .true. + end if gridind = get_cam_grid_index(grid_id) ! Only write if not already done @@ -2608,8 +2691,9 @@ 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. + if (set_flag_local) then + cam_grids(gridind)%attrs_defined = .false. + end if end if end subroutine cam_grid_write_var From 6191558bc55d5241f730488eecb6412d63eab534 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Mon, 2 Oct 2023 16:44:07 -0600 Subject: [PATCH 02/28] fix issue with multiple grids with the same attribute(s) --- src/control/cam_history.F90 | 73 +++++---- src/utils/cam_grid_support.F90 | 268 +++++++++++++++++---------------- 2 files changed, 173 insertions(+), 168 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 0fe8aed455..7aea09e354 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -58,6 +58,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 @@ -193,7 +194,6 @@ module cam_history logical :: collect_column_output(ptapes) integer :: maxvarmdims=1 - integer :: maxsplitfiles=2 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -789,7 +789,7 @@ 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%ta.%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%f.%y-%m-%d-%s.nc' end if @@ -4230,7 +4230,6 @@ subroutine h_define (t, restart) integer :: amode logical :: interpolate logical :: patch_output - logical :: set_flag integer :: cam_snapshot_before_num integer :: cam_snapshot_after_num character(len=32) :: cam_take_snapshot_before @@ -4241,16 +4240,20 @@ subroutine h_define (t, restart) cam_snapshot_before_num_out = cam_snapshot_before_num, & cam_snapshot_after_num_out = cam_snapshot_after_num) - if (masterproc) then - write(iulog,*) 'peverwhee - starting h_define' - end if - if(restart) then tape => restarthistory_tape 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,1)) + if(masterproc) then + if (hfile_accum(t) .and. hfile_inst(t)) then + write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,1)), trim(nhfil(t,2)) + else if (hfile_accum(t)) then + write(iulog,*)'Opening accumulated netcdf history file ', trim(nhfil(t,1)) + else if (hfile_inst(t)) then + write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,2)) + end if + end if end if amode = PIO_CLOBBER @@ -4258,6 +4261,9 @@ subroutine h_define (t, restart) if(restart) then allocate(tape(t)%Files(1)) call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) + else if (is_initfile(file_index=t)) then + allocate(tape(t)%Files(1)) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) else ! figure out how many history files to generate for this tape if (hfile_accum(t) .and. hfile_inst(t)) then @@ -4307,12 +4313,7 @@ subroutine h_define (t, restart) if(interpolate) then allocate(header_info(1)) do f = 1, size(tape(t)%Files) - if (f == size(tape(t)%Files)) then - set_flag = .true. - else - set_flag = .false. - end if - call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), set_attr_flag=set_flag) + call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), file_index=f) end do else if (patch_output) then ! We are doing patch (column) output @@ -4329,12 +4330,7 @@ subroutine h_define (t, restart) allocate(header_info(size(tape(t)%grid_ids))) do i = 1, size(tape(t)%grid_ids) do f = 1, size(tape(t)%Files) - if (f == size(tape(t)%Files)) then - set_flag = .true. - else - set_flag = .false. - end if - call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), set_attr_flag=set_flag) + call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), file_index=f) end do end do end if ! interpolate @@ -4841,22 +4837,12 @@ subroutine h_define (t, restart) if(.not. is_satfile(t)) then if(interpolate) then do f = 1, size(tape(t)%Files) - if (f == size(tape(t)%Files)) then - set_flag = .true. - else - set_flag = .false. - end if - call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, set_attr_flag=set_flag) + call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, file_index=f) end do else if((.not. patch_output) .or. restart) then do i = 1, size(tape(t)%grid_ids) do f = 1, size(tape(t)%Files) - if (f == size(tape(t)%Files)) then - set_flag = .true. - else - set_flag = .false. - end if - call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), set_attr_flag=set_flag) + call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), file_index=f) end do end do else @@ -5564,6 +5550,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' @@ -5604,11 +5593,19 @@ subroutine wshist (rgnht_in) end if end do if(.not. restart) then - nhfil(t,1) = fname_acc - nhfil(t,2) = fname_inst - if(masterproc) then - write(iulog,*)'WSHIST: accumulated nhfil(',t,')=',trim(nhfil(t,1)) - write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,2)) + if (is_initfile(file_index=t)) then + nhfil(t,1) = fname + nhfil(t,2) = fname + if(masterproc) then + write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,1)) + end if + else + nhfil(t,1) = fname_acc + nhfil(t,2) = fname_inst + if(masterproc) then + write(iulog,*)'WSHIST: accumulated nhfil(',t,')=',trim(nhfil(t,1)) + write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,2)) + end if end if cpath(t) = nhfil(t,1) if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) @@ -6441,6 +6438,8 @@ subroutine wrapup (rstwr, nlend) call cam_PIO_openfile (tape(t)%Files(f), nhfil(t,f), PIO_WRITE) end do call h_inquire(t) + else + deallocate(tape(t)%Files) end if endif ! if 0 timestep of montly run**** end if ! if time dispose history fiels*** diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 3b46bf2115..8385256a0e 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,7 +37,7 @@ 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(vardesc_ptr_t) :: vardesc(2) ! If we are to write coord type(var_desc_t), pointer :: bndsvdesc => NULL() ! If we are to write bounds contains procedure :: get_coord_len => horiz_coord_len @@ -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(2) ! 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,13 +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, last_entry) + 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 - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index end subroutine write_cam_grid_attr end interface @@ -546,7 +551,7 @@ end function horiz_coord_create ! !--------------------------------------------------------------------------- - subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) + 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 @@ -555,7 +560,7 @@ subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) class(horiz_coord_t), intent(inout) :: this type(file_desc_t), intent(inout) :: File ! PIO file Handle integer, optional, intent(out) :: dimid_out - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index ! Local variables type(var_desc_t) :: vardesc @@ -564,15 +569,15 @@ subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) integer :: bnds_dimid ! PIO dim ID for bounds integer :: err_handling integer :: ierr - logical :: last_entry_loc + 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(last_entry)) then - last_entry_loc = last_entry + if (present(file_index)) then + file_index_loc = file_index else - last_entry_loc = .true. + file_index_loc = 1 end if ! Make sure the dimension exists in the file @@ -583,23 +588,23 @@ subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) 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') + 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, & @@ -618,11 +623,6 @@ subroutine write_horiz_coord_attr(this, File, dimid_out, last_entry) dimid_out = dimid end if - if (.not. last_entry_loc) then - ! if we still have more split files to process, enable that - deallocate(this%vardesc) - end if - ! Back to old error handling call pio_seterrorhandling(File, err_handling) @@ -636,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 @@ -651,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 @@ -659,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) @@ -676,14 +684,14 @@ 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) @@ -699,7 +707,7 @@ 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) @@ -713,8 +721,8 @@ 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) @@ -2184,7 +2192,7 @@ end subroutine setAttrPtrNext ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_int(attr, File, last_entry) + 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 @@ -2192,30 +2200,30 @@ subroutine write_cam_grid_attr_0d_int(attr, File, last_entry) ! Dummy arguments class(cam_grid_attribute_0d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr - logical :: last_entry_loc + integer :: file_index_loc - if (present(last_entry)) then - last_entry_loc = last_entry + if (present(file_index)) then + file_index_loc = file_index else - last_entry_loc = .true. + 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 @@ -2229,10 +2237,6 @@ subroutine write_cam_grid_attr_0d_int(attr, File, last_entry) end if end if - if (.not. last_entry_loc .and. associated(attr%vardesc)) then - deallocate(attr%vardesc) - end if - end subroutine write_cam_grid_attr_0d_int !--------------------------------------------------------------------------- @@ -2243,30 +2247,30 @@ end subroutine write_cam_grid_attr_0d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_0d_char(attr, File, last_entry) + 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 - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index ! Local variables integer :: attrtype integer(imap) :: attrlen integer :: ierr - logical :: last_entry_loc + integer :: file_index_loc - if (present(last_entry)) then - last_entry_loc = last_entry + if (present(file_index)) then + file_index_loc = file_index else - last_entry_loc = .true. + 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) @@ -2277,10 +2281,6 @@ subroutine write_cam_grid_attr_0d_char(attr, File, last_entry) end if end if - if (.not. last_entry_loc .and. associated(attr%vardesc)) then - deallocate(attr%vardesc) - end if - end subroutine write_cam_grid_attr_0d_char !--------------------------------------------------------------------------- @@ -2291,7 +2291,7 @@ end subroutine write_cam_grid_attr_0d_char ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_int(attr, File, last_entry) + 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 @@ -2299,23 +2299,23 @@ subroutine write_cam_grid_attr_1d_int(attr, File, last_entry) ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr - logical :: last_entry_loc + integer :: file_index_loc - if (present(last_entry)) then - last_entry_loc = last_entry + if (present(file_index)) then + file_index_loc = file_index else - last_entry_loc = .true. + 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 @@ -2327,17 +2327,13 @@ subroutine write_cam_grid_attr_1d_int(attr, File, last_entry) 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 - if (.not. last_entry_loc .and. associated(attr%vardesc)) then - deallocate(attr%vardesc) - end if - end subroutine write_cam_grid_attr_1d_int !--------------------------------------------------------------------------- @@ -2348,7 +2344,7 @@ end subroutine write_cam_grid_attr_1d_int ! !--------------------------------------------------------------------------- - subroutine write_cam_grid_attr_1d_r8(attr, File, last_entry) + 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 @@ -2356,23 +2352,23 @@ subroutine write_cam_grid_attr_1d_r8(attr, File, last_entry) ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File ! PIO file Handle - logical, optional, intent(in) :: last_entry + integer, optional, intent(in) :: file_index ! Local variables integer :: dimid ! PIO dimension ID character(len=120) :: errormsg integer :: ierr - logical :: last_entry_loc + integer :: file_index_loc - if (present(last_entry)) then - last_entry_loc = last_entry + if (present(file_index)) then + file_index_loc = file_index else - last_entry_loc = .true. + 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 @@ -2384,18 +2380,14 @@ subroutine write_cam_grid_attr_1d_r8(attr, File, last_entry) 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 - if (.not. last_entry_loc .and. associated(attr%vardesc)) then - deallocate(attr%vardesc) - end if - end subroutine write_cam_grid_attr_1d_r8 !--------------------------------------------------------------------------- @@ -2448,14 +2440,14 @@ end subroutine cam_grid_attribute_copy ! coordinates. ! !--------------------------------------------------------------------------- - subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) + 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 - logical, optional, intent(in) :: set_attr_flag + integer, optional, intent(in) :: file_index ! Local variables integer :: gridind @@ -2463,12 +2455,12 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) type(cam_grid_attr_ptr_t), pointer :: attrPtr integer :: dimids(2) integer :: err_handling - logical :: set_flag_local + integer :: file_index_loc - if (present(set_attr_flag)) then - set_flag_local = set_attr_flag + if (present(file_index)) then + file_index_loc = file_index else - set_flag_local = .true. + file_index_loc = 1 end if gridind = get_cam_grid_index(grid_id) @@ -2476,7 +2468,6 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) 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 @@ -2490,7 +2481,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) 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 @@ -2502,8 +2493,8 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) 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), last_entry=set_flag_local) - call cam_grids(gridind)%lon_coord%write_attr(File, dimids(1), last_entry=set_flag_local) + 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)) @@ -2521,7 +2512,7 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) !!XXgoldyXX: Is this not working in PGI? ! attr => attrPtr%getAttr() attr => attrPtr%attr - call attr%write_attr(File, last_entry=set_flag_local) + call attr%write_attr(File, file_index=file_index_loc) !!XXgoldyXX: Is this not working in PGI? ! attrPtr => attrPtr%getNext() attrPtr => attrPtr%next @@ -2529,48 +2520,53 @@ subroutine cam_grid_write_attr(File, grid_id, header_info, set_attr_flag) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - if (set_flag_local) then - cam_grids(gridind)%attrs_defined = .true. - end if + 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, last_entry) + 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 - logical, optional, intent(in) :: last_entry + 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, last_entry) + 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 - logical, optional, intent(in) :: last_entry + 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, last_entry) + 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 @@ -2578,37 +2574,44 @@ subroutine write_cam_grid_val_1d_int(attr, File, last_entry) ! Dummy arguments class(cam_grid_attribute_1d_int_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File - logical, optional, intent(in) :: last_entry + 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, last_entry) + 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 @@ -2616,60 +2619,66 @@ subroutine write_cam_grid_val_1d_r8(attr, File, last_entry) ! Dummy arguments class(cam_grid_attribute_1d_r8_t), intent(inout) :: attr type(file_desc_t), intent(inout) :: File - logical, optional, intent(in) :: last_entry + 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, set_attr_flag) + 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 - logical, optional, intent(in) :: set_attr_flag + 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 - logical :: set_flag_local + integer :: file_index_loc - if (present(set_attr_flag)) then - set_flag_local = set_attr_flag + if (present(file_index)) then + file_index_loc = file_index else - set_flag_local = .true. + 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) @@ -2683,7 +2692,7 @@ subroutine cam_grid_write_var(File, grid_id, set_attr_flag) !!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 @@ -2691,9 +2700,6 @@ subroutine cam_grid_write_var(File, grid_id, set_attr_flag) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) - if (set_flag_local) then - cam_grids(gridind)%attrs_defined = .false. - end if end if end subroutine cam_grid_write_var From 96ea50241ec08f01af6454688a23647165750e97 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 3 Oct 2023 22:50:19 -0600 Subject: [PATCH 03/28] fix bug in lat lon coords, append file type to user-supplied filespec --- src/control/cam_history.F90 | 22 ++++++++++++++-------- src/utils/cam_grid_support.F90 | 6 ++++-- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 7aea09e354..fcf5783f1e 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -166,7 +166,7 @@ module cam_history 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,2) ! Array of current file names + 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 @@ -564,6 +564,7 @@ subroutine history_readnl(nlfile) integer :: dtime ! Step time in seconds integer :: unitn, ierr, f, t character(len=8) :: ctemp ! Temporary character string + character(len=max_string_len) :: temp_spec character(len=fieldname_lenp2) :: fincl1(pflds) character(len=fieldname_lenp2) :: fincl2(pflds) @@ -793,6 +794,11 @@ subroutine history_readnl(nlfile) else 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 + temp_spec = trim(hfilename_spec(t)) // '%f' + hfilename_spec(t) = temp_spec end if ! ! Only one time sample allowed per monthly average file @@ -1640,7 +1646,6 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('lcltod_stop') ierr = pio_put_var(File, vdesc, lcltod_stop(1:ptapes)) - write(iulog,*) 'finished put var' field_name_desc => restartvar_getdesc('field_name') decomp_type_desc => restartvar_getdesc('decomp_type') @@ -2225,6 +2230,7 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) + allocate(tape(t)%Files(1)) call cam_pio_openfile(tape(t)%Files(1), locfn, 0) ! ! Read history restart file @@ -2278,7 +2284,7 @@ subroutine read_restart_history (File) 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)%Files(1), trim(fname_tmp)//'_var', vdesc) if (nfdims > 2) then @@ -5570,23 +5576,23 @@ subroutine wshist (rgnht_in) ! Check that this new filename isn't the same as a previous or current filename ! duplicate = .false. - do f = 1, ptapes + do f = 1, t if (masterproc)then if (trim(fname) == trim(nhfil(f,1))) then write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) duplicate = .true. else if (trim(fname_acc) == trim(nhfil(f,1))) then - write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + write(iulog,*)'WSHIST: New accumulated filename same as old file = ', trim(fname_acc) duplicate = .true. else if (trim(fname_inst) == trim(nhfil(f,2))) then - write(iulog,*)'WSHIST: New filename same as old file = ', trim(fname) + 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, ') = ', hfilename_spec(t) + write(iulog,*)'hfilename_spec(', t, ') = ', trim(hfilename_spec(t)) if ( t /= f )then - write(iulog,*)'hfilename_spec(', f, ') = ', hfilename_spec(f) + write(iulog,*)'hfilename_spec(', f, ') = ', trim(hfilename_spec(f)) end if call endrun end if diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index 8385256a0e..c7263caa02 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -2680,8 +2680,8 @@ subroutine cam_grid_write_var(File, grid_id, file_index) ! Only write if not already done 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) @@ -2700,6 +2700,8 @@ subroutine cam_grid_write_var(File, grid_id, file_index) ! Back to previous I/O error handling call pio_seterrorhandling(File, err_handling) + + cam_grids(gridind)%attrs_defined(file_index_loc) = .false. end if end subroutine cam_grid_write_var From cad3879f6dd62fa41b75c695586da126231d7d1a Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 11 Oct 2023 18:20:07 -0600 Subject: [PATCH 04/28] fix restarts --- src/control/cam_history.F90 | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index fcf5783f1e..6d1606a44d 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -533,6 +533,9 @@ subroutine intht (model_doi_url_in) tape(t)%hlist(f)%field%meridional_complement = -1 tape(t)%hlist(f)%field%zonal_complement = -1 end do +! if (.not. hfile_accum(t) .and. .not. hfile_inst(t)) then +! hfile_accum(t) = .true. +! end if end do ! Setup vector pairs for unstructured grid interpolation call setup_interpolation_and_define_vector_complements() @@ -1763,7 +1766,7 @@ subroutine write_restart_history ( File, & ierr = pio_put_var(File, mdimname_desc, start, hist_coord_name(f)) end do - deallocate(xyfill, allmdims) + deallocate(xyfill, allmdims, is_subcol, interp_output, restarthistory_tape) return end subroutine write_restart_history @@ -2133,6 +2136,11 @@ subroutine read_restart_history (File) gridsontape = -1 do t = 1, ptapes do f = 1, nflds(t) + if (tape(t)%hlist(f)%avgflag .eq. 'I') then + hfile_inst(t) = .true. + else + hfile_accum(t) = .true. + end if call set_field_dimensions(tape(t)%hlist(f)%field) begdim1 = tape(t)%hlist(f)%field%begdim1 @@ -2359,6 +2367,7 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then + allocate(tape(t)%Files(1)) call getfil (cpath(t), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) call h_inquire (t) @@ -4264,6 +4273,10 @@ subroutine h_define (t, restart) amode = PIO_CLOBBER + if (allocated(tape(t)%Files)) then + deallocate(tape(t)%Files) + end if + if(restart) then allocate(tape(t)%Files(1)) call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) @@ -5578,13 +5591,13 @@ subroutine wshist (rgnht_in) duplicate = .false. do f = 1, t if (masterproc)then - if (trim(fname) == trim(nhfil(f,1))) 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,1))) then + else if (trim(fname_acc) == trim(nhfil(f,1)) .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,2))) then + else if (trim(fname_inst) == trim(nhfil(f,2)) .and. trim(fname_inst) /= '') then write(iulog,*)'WSHIST: New instantaneous filename same as old file = ', trim(fname_inst) duplicate = .true. end if @@ -5714,7 +5727,7 @@ subroutine wshist (rgnht_in) ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) end if else - if (hfile_accum(t)) then + if (hfile_accum(t) .and. .not. restart) 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 @@ -5767,9 +5780,9 @@ subroutine wshist (rgnht_in) cycle end if else - if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. hfile_accum(t)) then + if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. hfile_accum(t) .and. .not. restart) then cycle - else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. hfile_inst(t)) then + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. hfile_inst(t) .and. .not. restart) then cycle end if end if From 7349d16ea8d4956305494d6401469474e4d31afe Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 12 Oct 2023 00:42:45 -0600 Subject: [PATCH 05/28] another restart bug; update sct tests to reference new filename --- cime_config/SystemTests/sct.py | 2 +- src/control/cam_history.F90 | 241 +++++++++++++++++++-------------- 2 files changed, 140 insertions(+), 103 deletions(-) diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index ffcf85411a..6b68f4ac2a 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.h1a."+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.") diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 6d1606a44d..19425c62a2 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -165,7 +165,7 @@ 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) :: 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 @@ -1090,9 +1090,10 @@ 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' @@ -1631,7 +1632,7 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('nfpath') 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,:)) vdesc => restartvar_getdesc('ndens') @@ -1911,7 +1912,7 @@ 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_inq_varid(File, 'hrestpath', vdesc) @@ -2060,7 +2061,8 @@ 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))) @@ -2238,6 +2240,9 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) + if (allocated(tape(t)%Files)) then + deallocate(tape(t)%Files) + end if allocate(tape(t)%Files(1)) call cam_pio_openfile(tape(t)%Files(1), locfn, 0) ! @@ -2357,7 +2362,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 @@ -2366,10 +2370,25 @@ subroutine read_restart_history (File) else if (nflds(t) == 0) then nfils(t) = 0 else + if (allocated(tape(t)%Files)) then + deallocate(tape(t)%Files) + end if if (nfils(t) > 0) then - allocate(tape(t)%Files(1)) - call getfil (cpath(t), locfn) - call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + if (hfile_accum(t) .and. hfile_inst(t)) then + allocate(tape(t)%Files(2)) + call getfil (cpath(t,1), locfn) + call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + call getfil (cpath(t,2), locfn) + call cam_pio_openfile(tape(t)%Files(2), locfn, PIO_WRITE) + else if (hfile_accum(t)) then + allocate(tape(t)%Files(1)) + call getfil (cpath(t,1), locfn) + call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + else if (hfile_inst(t)) then + allocate(tape(t)%Files(1)) + call getfil (cpath(t,2), locfn) + call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + end if call h_inquire (t) if(is_satfile(t)) then ! Initialize the sat following history subsystem @@ -2388,7 +2407,9 @@ subroutine read_restart_history (File) deallocate(tape(t)%hlist(f)%varid) nullify(tape(t)%hlist(f)%varid) end do - call cam_pio_closefile(tape(t)%Files(1)) + do f = 1, size(tape(t)%Files) + call cam_pio_closefile(tape(t)%Files(f)) + end do nfils(t) = 0 end if end if @@ -2418,7 +2439,7 @@ character(len=max_string_len) function get_hfilepath( tape ) ! integer, intent(in) :: tape ! Tape number - get_hfilepath = cpath( tape ) + get_hfilepath = cpath( tape, 1 ) end function get_hfilepath !####################################################################### @@ -3946,7 +3967,7 @@ subroutine h_inquire (t) ! ! Local workspace ! - integer :: f ! field index + integer :: f, fld ! file, field index integer :: ierr integer :: i integer :: num_patches @@ -3964,98 +3985,113 @@ subroutine h_inquire (t) ! ! Create variables for model timing and header information ! - if(.not. is_satfile(t)) then - ierr=pio_inq_varid (tape(t)%Files(1),'ndcur ', tape(t)%ndcurid) - ierr=pio_inq_varid (tape(t)%Files(1),'nscur ', tape(t)%nscurid) - ierr=pio_inq_varid (tape(t)%Files(1),'nsteph ', tape(t)%nstephid) + do f = 1, size(tape(t)%Files) + if(.not. is_satfile(t)) 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) - ierr=pio_inq_varid (tape(t)%Files(1),'time_bounds', tape(t)%tbndid) - ierr=pio_inq_varid (tape(t)%Files(1),'date_written',tape(t)%date_writtenid) - ierr=pio_inq_varid (tape(t)%Files(1),'time_written',tape(t)%time_writtenid) + 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)%Files(1),'tsec ',tape(t)%tsecid) - ierr=pio_inq_varid (tape(t)%Files(1),'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)%Files(1),'co2vmr ', tape(t)%co2vmrid) - ierr=pio_inq_varid (tape(t)%Files(1),'ch4vmr ', tape(t)%ch4vmrid) - ierr=pio_inq_varid (tape(t)%Files(1),'n2ovmr ', tape(t)%n2ovmrid) - ierr=pio_inq_varid (tape(t)%Files(1),'f11vmr ', tape(t)%f11vmrid) - ierr=pio_inq_varid (tape(t)%Files(1),'f12vmr ', tape(t)%f12vmrid) - ierr=pio_inq_varid (tape(t)%Files(1),'sol_tsi ', tape(t)%sol_tsiid) - if (solar_parms_on) then - ierr=pio_inq_varid (tape(t)%Files(1),'f107 ', tape(t)%f107id) - ierr=pio_inq_varid (tape(t)%Files(1),'f107a ', tape(t)%f107aid) - ierr=pio_inq_varid (tape(t)%Files(1),'f107p ', tape(t)%f107pid) - ierr=pio_inq_varid (tape(t)%Files(1),'kp ', tape(t)%kpid) - ierr=pio_inq_varid (tape(t)%Files(1),'ap ', tape(t)%apid) - endif - if (solar_wind_on) then - ierr=pio_inq_varid (tape(t)%Files(1),'byimf', tape(t)%byimfid) - ierr=pio_inq_varid (tape(t)%Files(1),'bzimf', tape(t)%bzimfid) - ierr=pio_inq_varid (tape(t)%Files(1),'swvel', tape(t)%swvelid) - ierr=pio_inq_varid (tape(t)%Files(1),'swden', tape(t)%swdenid) - endif - if (epot_active) then - ierr=pio_inq_varid (tape(t)%Files(1),'colat_crit1', tape(t)%colat_crit1_id) - ierr=pio_inq_varid (tape(t)%Files(1),'colat_crit2', tape(t)%colat_crit2_id) - endif - end if - end if - ierr=pio_inq_varid (tape(t)%Files(1),'date ', tape(t)%dateid) - ierr=pio_inq_varid (tape(t)%Files(1),'datesec ', tape(t)%datesecid) - ierr=pio_inq_varid (tape(t)%Files(1),'time ', tape(t)%timeid) + 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)%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 (size(tape(t)%Files) > 1) then + ! we have two files - instantaneous and accumulated + if (f == 1) 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 + 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)%Files(1), 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)%Files(1), 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)%Files(1), 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)%Files(1),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)%Files(1),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 @@ -5626,11 +5662,12 @@ subroutine wshist (rgnht_in) write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,2)) end if end if - cpath(t) = nhfil(t,1) - if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t) - else - nhfil(t,1) = fname - nhfil(t,2) = fname + cpath(t,1) = nhfil(t,1) + cpath(t,2) = nhfil(t,2) + if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t, 1) +! else +! nhfil(t,1) = fname +! nhfil(t,2) = fname end if call h_define (t, restart) end if From 0183095b21cb04a92034338f649813b5a76bc658 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 12 Oct 2023 15:33:04 -0600 Subject: [PATCH 06/28] fix for sct tests and fix for restart tests that have only one type of history file --- cime_config/SystemTests/sct.py | 2 +- src/control/cam_history.F90 | 20 ++++++++++++++------ 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index 6b68f4ac2a..7abcbc74bf 100644 --- a/cime_config/SystemTests/sct.py +++ b/cime_config/SystemTests/sct.py @@ -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/*h1a*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/src/control/cam_history.F90 b/src/control/cam_history.F90 index 19425c62a2..e70bceed2e 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -533,9 +533,6 @@ subroutine intht (model_doi_url_in) tape(t)%hlist(f)%field%meridional_complement = -1 tape(t)%hlist(f)%field%zonal_complement = -1 end do -! if (.not. hfile_accum(t) .and. .not. hfile_inst(t)) then -! hfile_accum(t) = .true. -! end if end do ! Setup vector pairs for unstructured grid interpolation call setup_interpolation_and_define_vector_complements() @@ -6490,9 +6487,20 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - do f = 1, size(tape(t)%Files) - call cam_PIO_openfile (tape(t)%Files(f), nhfil(t,f), PIO_WRITE) - end do + if (allocated(tape(t)%Files)) then + deallocate(tape(t)%Files) + end if + if (hfile_accum(t) .and. hfile_inst(t)) then + allocate(tape(t)%Files(2)) + call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(2), nhfil(t,2), PIO_WRITE) + else if (hfile_accum(t)) then + allocate(tape(t)%Files(1)) + call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) + else if (hfile_inst(t)) then + allocate(tape(t)%Files(1)) + call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,2), PIO_WRITE) + end if call h_inquire(t) else deallocate(tape(t)%Files) From 1fac980bc28b8709dabea9041fb676c286beb4c9 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 12 Oct 2023 18:27:43 -0600 Subject: [PATCH 07/28] code cleanup --- src/control/cam_history.F90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index e70bceed2e..6adebf6d02 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -1564,6 +1564,7 @@ subroutine write_restart_history ( File, & integer :: maxnflds real(r8) :: integral ! hbuf area weighted integral + maxnflds = maxval(nflds) allocate(xyfill(maxnflds, ptapes)) xyfill = 0 @@ -1605,6 +1606,7 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('fincl') ierr= pio_put_var(File, vdesc, fincl(:,1:ptapes)) + vdesc => restartvar_getdesc('fincllonlat') ierr= pio_put_var(File, vdesc, fincllonlat(:,1:ptapes)) @@ -1628,10 +1630,13 @@ subroutine write_restart_history ( File, & vdesc => restartvar_getdesc('nfpath') ierr= pio_put_var(File, vdesc, nfpath(1:ptapes)) + vdesc => restartvar_getdesc('cpath') ierr= pio_put_var(File, vdesc, cpath(1:ptapes,:)) + vdesc => restartvar_getdesc('nhfil') ierr= pio_put_var(File, vdesc, nhfil(1:ptapes,:)) + vdesc => restartvar_getdesc('ndens') ierr= pio_put_var(File, vdesc, ndens(1:ptapes)) vdesc => restartvar_getdesc('ncprec') @@ -4313,7 +4318,7 @@ subroutine h_define (t, restart) if(restart) then allocate(tape(t)%Files(1)) call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) - else if (is_initfile(file_index=t)) then + else if (is_initfile(file_index=t) .and. is_satfile(t)) then allocate(tape(t)%Files(1)) call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) else From 8aa74376d2481d3ba32319d57dbc529e7f830a02 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Sun, 15 Oct 2023 21:40:56 -0600 Subject: [PATCH 08/28] change implementation to static array --- src/control/cam_history.F90 | 103 +++++++++++----------------- src/control/cam_history_support.F90 | 5 +- 2 files changed, 42 insertions(+), 66 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 6adebf6d02..5463da9dba 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -2242,10 +2242,6 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) - if (allocated(tape(t)%Files)) then - deallocate(tape(t)%Files) - end if - allocate(tape(t)%Files(1)) call cam_pio_openfile(tape(t)%Files(1), locfn, 0) ! ! Read history restart file @@ -2372,22 +2368,19 @@ subroutine read_restart_history (File) else if (nflds(t) == 0) then nfils(t) = 0 else - if (allocated(tape(t)%Files)) then - deallocate(tape(t)%Files) - end if if (nfils(t) > 0) then if (hfile_accum(t) .and. hfile_inst(t)) then - allocate(tape(t)%Files(2)) + tape(t)%num_files = 2 call getfil (cpath(t,1), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) call getfil (cpath(t,2), locfn) call cam_pio_openfile(tape(t)%Files(2), locfn, PIO_WRITE) else if (hfile_accum(t)) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call getfil (cpath(t,1), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) else if (hfile_inst(t)) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call getfil (cpath(t,2), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) end if @@ -2409,7 +2402,7 @@ subroutine read_restart_history (File) deallocate(tape(t)%hlist(f)%varid) nullify(tape(t)%hlist(f)%varid) end do - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_pio_closefile(tape(t)%Files(f)) end do nfils(t) = 0 @@ -3982,12 +3975,10 @@ subroutine h_inquire (t) ! tape => history_tape - - ! ! Create variables for model timing and header information ! - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files if(.not. is_satfile(t)) 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) @@ -4036,7 +4027,7 @@ subroutine h_inquire (t) ! Obtain variable name from ID which was read from restart file ! do fld=1,nflds(t) - if (size(tape(t)%Files) > 1) then + if (tape(t)%num_files > 1) then ! we have two files - instantaneous and accumulated if (f == 1) then ! this is the accumulated file - skip instantaneous fields @@ -4311,41 +4302,37 @@ subroutine h_define (t, restart) amode = PIO_CLOBBER - if (allocated(tape(t)%Files)) then - deallocate(tape(t)%Files) - end if - if(restart) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) else if (is_initfile(file_index=t) .and. is_satfile(t)) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) else ! figure out how many history files to generate for this tape if (hfile_accum(t) .and. hfile_inst(t)) then - allocate(tape(t)%Files(2)) + tape(t)%num_files = 2 call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) call cam_pio_createfile (tape(t)%Files(2), nhfil(t,2), amode) else if (hfile_accum(t)) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) else if (hfile_inst(t)) then - allocate(tape(t)%Files(1)) + tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), nhfil(t,2), amode) end if end if if(is_satfile(t)) then interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? patch_output = .false. - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_pio_def_dim(tape(t)%Files(f), 'ncol', pio_unlimited, timdim) call cam_pio_def_dim(tape(t)%Files(f), 'nbnd', 2, bnddim) end do allocate(latvar(1), lonvar(1)) allocate(latvar(1)%vd, lonvar(1)%vd) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_pio_def_var(tape(t)%Files(f), 'lat', pio_double, (/timdim/), & latvar(1)%vd) ierr=pio_put_att (tape(t)%Files(f), latvar(1)%vd, 'long_name', 'latitude') @@ -4369,7 +4356,7 @@ subroutine h_define (t, restart) ! Interpolation is special in that we ignore the native grids if(interpolate) then allocate(header_info(1)) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), file_index=f) end do else if (patch_output) then @@ -4379,20 +4366,20 @@ 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) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call tape(t)%patches(i)%write_attrs(tape(t)%Files(f)) end do end do else allocate(header_info(size(tape(t)%grid_ids))) do i = 1, size(tape(t)%grid_ids) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), file_index=f) end do end do end if ! interpolate ! Define the unlimited time dim - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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) @@ -4422,7 +4409,7 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ! Store snapshot location if (t == cam_snapshot_before_num) then ierr=pio_put_att(tape(t)%Files(f), PIO_GLOBAL, 'cam_snapshot_before', & @@ -4648,7 +4635,7 @@ subroutine h_define (t, restart) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do fld = 1, nflds(t) - if (size(tape(t)%Files) > 1) then + if (tape(t)%num_files > 1) then ! we have two files - instantaneous and accumulated if (f == 1) then ! this is the accumulated file - skip instantaneous fields @@ -4893,19 +4880,19 @@ subroutine h_define (t, restart) ! if(.not. is_satfile(t)) then if(interpolate) then - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, file_index=f) end do else if((.not. patch_output) .or. restart) then do i = 1, size(tape(t)%grid_ids) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), file_index=f) end do end do else ! Patch output do i = 1, size(tape(t)%patches) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call tape(t)%patches(i)%write_vals(tape(t)%Files(f)) end do end do @@ -4918,7 +4905,7 @@ subroutine h_define (t, restart) end if dtime = get_step_size() - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ierr = pio_put_var(tape(t)%Files(f), tape(t)%mdtid, (/dtime/)) call cam_pio_handle_error(ierr, 'h_define: cannot put mdt') ! @@ -4951,7 +4938,7 @@ subroutine h_define (t, restart) end if ! Write the mdim variable data - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call write_hist_coord_vars(tape(t)%Files(f), restart) end do @@ -5667,9 +5654,6 @@ subroutine wshist (rgnht_in) cpath(t,1) = nhfil(t,1) cpath(t,2) = nhfil(t,2) if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t, 1) -! else -! nhfil(t,1) = fname -! nhfil(t,2) = fname end if call h_define (t, restart) end if @@ -5688,7 +5672,7 @@ subroutine wshist (rgnht_in) if (interpolate_output(t) .and. (.not. restart)) then call set_interp_hfile(t, interpolate_info) end if - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ierr = pio_put_var (tape(t)%Files(f), tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) @@ -5696,7 +5680,7 @@ subroutine wshist (rgnht_in) if (.not. is_initfile(file_index=t)) then ! Don't write the GHG/Solar forcing data to the IC file. - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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')/)) @@ -5706,7 +5690,7 @@ subroutine wshist (rgnht_in) end do if (solar_parms_on) then - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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 /) ) @@ -5715,7 +5699,7 @@ subroutine wshist (rgnht_in) end do endif if (solar_wind_on) then - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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 /) ) @@ -5723,24 +5707,24 @@ subroutine wshist (rgnht_in) end do endif if (epot_active) then - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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) /) ) end do endif end if - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ierr = pio_put_var (tape(t)%Files(f), tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) end do #if ( defined BFB_CAM_SCAM_IOP ) dtime = get_step_size() tsec=dtime*nstep - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ierr = pio_put_var (tape(t)%Files(f), tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) end do #endif - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) end do time = ndcur + nscur/86400._r8 @@ -5755,8 +5739,8 @@ subroutine wshist (rgnht_in) tdata(1) = beg_time(t) tdata(2) = time end if - do f = 1, size(tape(t)%Files) - if (size(tape(t)%Files) > 1) then + do f = 1, tape(t)%num_files + if (tape(t)%num_files > 1) then ! We have two files - one for accumulated and one for instantaneous fields if (f == 1) then ! accumulated tape - time is midpoint of time_bounds @@ -5782,7 +5766,7 @@ subroutine wshist (rgnht_in) countc(1) = 8 countc(2) = 1 call datetime (cdate, ctime) - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files 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 do @@ -5811,8 +5795,8 @@ subroutine wshist (rgnht_in) ! call t_startf ('dump_field') do fld=1,nflds(t) - do f = 1, size(tape(t)%Files) - if (size(tape(t)%Files) > 1) then + do f = 1, tape(t)%num_files + if (tape(t)%num_files > 1) then if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. f == 1) then cycle else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == 2) then @@ -5845,7 +5829,7 @@ subroutine wshist (rgnht_in) nullify(tape(t)%hlist(fld)%varid) end if end do - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_pio_closefile(tape(t)%Files(f)) end do else @@ -6432,7 +6416,6 @@ subroutine wrapup (rstwr, nlend) ! do t=1,ptapes if (nflds(t) == 0) cycle - lfill(t) = .false. ! ! Find out if file is full @@ -6467,7 +6450,7 @@ subroutine wrapup (rstwr, nlend) end do end if end if - do f = 1, size(tape(t)%Files) + do f = 1, tape(t)%num_files call cam_pio_closefile(tape(t)%Files(f)) end do if (nhtfrq(t) /= 0 .or. nstep > 0) then @@ -6492,23 +6475,15 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - if (allocated(tape(t)%Files)) then - deallocate(tape(t)%Files) - end if if (hfile_accum(t) .and. hfile_inst(t)) then - allocate(tape(t)%Files(2)) call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) call cam_PIO_openfile (tape(t)%Files(2), nhfil(t,2), PIO_WRITE) else if (hfile_accum(t)) then - allocate(tape(t)%Files(1)) call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) else if (hfile_inst(t)) then - allocate(tape(t)%Files(1)) call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,2), PIO_WRITE) end if call h_inquire(t) - else - deallocate(tape(t)%Files) end if endif ! if 0 timestep of montly run**** end if ! if time dispose history fiels*** diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 3865604851..4d6040d5fc 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,8 @@ module cam_history_support ! PIO ids ! - type(file_desc_t), allocatable :: Files(:) ! PIO file ids + type(file_desc_t) :: Files(maxsplitfiles) ! PIO file ids + integer :: num_files ! number of files to use type(var_desc_t) :: mdtid ! var id for timestep type(var_desc_t) :: ndbaseid ! var id for base day From 57fc39c7f5bc5cd45d18213a35232d44527c8ee4 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 17 Oct 2023 12:39:11 -0600 Subject: [PATCH 09/28] add units and calendar to time_bounds variable --- src/control/cam_history.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 5463da9dba..db24d7a14e 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -4476,6 +4476,9 @@ subroutine h_define (t, restart) 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 ! From 8df5b6b02abe818499a7f968db1c2966ef541d2d Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 09:30:40 -0600 Subject: [PATCH 10/28] fix for dims with bnds; make field indexing consistent --- src/control/cam_history.F90 | 563 +++++++++++++++++---------------- src/utils/cam_grid_support.F90 | 24 +- 2 files changed, 294 insertions(+), 293 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index db24d7a14e..f652c1d65c 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -375,7 +375,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 @@ -407,18 +407,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 ! @@ -475,29 +475,29 @@ subroutine intht (model_doi_url_in) ! Initialize history variables ! do t=1,ptapes - do f=1,nflds(t) - if (tape(t)%hlist(f)%avgflag .eq. 'I') then + do fld=1,nflds(t) + if (tape(t)%hlist(fld)%avgflag .eq. 'I') then hfile_inst(t) = .true. else hfile_accum(t) = .true. end if - 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 + 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 @@ -512,7 +512,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 @@ -520,18 +520,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 @@ -952,7 +952,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 @@ -964,31 +964,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 @@ -1007,33 +1007,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') @@ -1523,7 +1523,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 @@ -1697,40 +1697,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 @@ -1764,9 +1764,9 @@ 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) @@ -1801,7 +1801,7 @@ subroutine read_restart_history (File) ! ! Local workspace ! - integer t, f, fld, ff ! tape, file, 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 @@ -2068,63 +2068,63 @@ subroutine read_restart_history (File) 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 @@ -2139,62 +2139,62 @@ subroutine read_restart_history (File) allocate(gridsontape(cam_grid_num_grids() + 1, ptapes)) gridsontape = -1 do t = 1, ptapes - do f = 1, nflds(t) - if (tape(t)%hlist(f)%avgflag .eq. 'I') then + do fld = 1, nflds(t) + if (tape(t)%hlist(fld)%avgflag .eq. 'I') then hfile_inst(t) = .true. else hfile_accum(t) = .true. 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 - 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)) + 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 @@ -2208,7 +2208,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 @@ -2216,7 +2216,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 @@ -2337,18 +2337,18 @@ subroutine read_restart_history (File) 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) @@ -2398,9 +2398,9 @@ subroutine read_restart_history (File) if (masterproc) then write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,1), mfilt(t) 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, tape(t)%num_files call cam_pio_closefile(tape(t)%Files(f)) @@ -2538,8 +2538,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 @@ -2580,24 +2580,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 @@ -2607,7 +2607,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) @@ -2617,7 +2617,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 @@ -2629,7 +2629,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 @@ -2638,11 +2638,11 @@ subroutine fldlst () ! 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 + 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. @@ -2661,39 +2661,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) @@ -2702,7 +2702,7 @@ subroutine fldlst () errors_found = errors_found + 1 end if end do - f = f + 1 + fld = fld + 1 end do end do @@ -2740,14 +2740,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 @@ -2755,11 +2755,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 @@ -2788,27 +2788,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 @@ -2817,21 +2817,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. @@ -2857,30 +2857,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 @@ -2924,7 +2924,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 @@ -2975,23 +2975,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 @@ -4305,7 +4305,7 @@ subroutine h_define (t, restart) if(restart) then tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) - else if (is_initfile(file_index=t) .and. is_satfile(t)) then + else if (is_initfile(file_index=t) .or. is_satfile(t)) then tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) else @@ -6399,7 +6399,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 !----------------------------------------------------------------------- @@ -6445,10 +6446,10 @@ subroutine wrapup (rstwr, nlend) end if if(pio_file_is_open(tape(t)%Files(1))) 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 @@ -6730,7 +6731,7 @@ subroutine bld_htapefld_indices ! ! Local. ! - integer :: f + integer :: fld integer :: t ! @@ -6748,17 +6749,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 diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index c7263caa02..d5ae61c4d0 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -38,7 +38,7 @@ module cam_grid_support logical :: latitude ! .false. means longitude real(r8), pointer :: bnds(:,:) => NULL() ! bounds, if present type(vardesc_ptr_t) :: vardesc(2) ! If we are to write coord - type(var_desc_t), pointer :: bndsvdesc => NULL() ! If we are to write bounds + type(vardesc_ptr_t) :: bndsvdesc(2) ! If we are to write bounds contains procedure :: get_coord_len => horiz_coord_len procedure :: num_elem => horiz_coord_num_elem @@ -603,18 +603,18 @@ subroutine write_horiz_coord_attr(this, File, dimid_out, file_index) 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) + 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 @@ -696,10 +696,10 @@ subroutine write_horiz_coord_var(this, File, file_index) 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 @@ -709,8 +709,8 @@ subroutine write_horiz_coord_var(this, File, file_index) ! This is a local variable, pio_put_var should work fine 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),& @@ -724,9 +724,9 @@ subroutine write_horiz_coord_var(this, File, file_index) 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? From 2320d0e38592cac19a6def3acc1b87bcc198db8c Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 10:20:03 -0600 Subject: [PATCH 11/28] make field indexing consistent; remove satfile file loop --- src/control/cam_history.F90 | 215 ++++++++++++++++++------------------ 1 file changed, 105 insertions(+), 110 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index f652c1d65c..83e0467360 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -3588,7 +3588,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 @@ -3625,30 +3625,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 @@ -3662,15 +3662,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 @@ -3725,7 +3725,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 @@ -3767,7 +3767,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 @@ -4325,25 +4325,20 @@ subroutine h_define (t, restart) if(is_satfile(t)) then interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? patch_output = .false. - do f = 1, tape(t)%num_files - call cam_pio_def_dim(tape(t)%Files(f), 'ncol', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%Files(f), 'nbnd', 2, bnddim) - end do + call cam_pio_def_dim(tape(t)%Files(1), 'ncol', pio_unlimited, timdim) + call cam_pio_def_dim(tape(t)%Files(1), 'nbnd', 2, bnddim) allocate(latvar(1), lonvar(1)) allocate(latvar(1)%vd, lonvar(1)%vd) - do f = 1, tape(t)%num_files - call cam_pio_def_var(tape(t)%Files(f), 'lat', pio_double, (/timdim/), & - latvar(1)%vd) - ierr=pio_put_att (tape(t)%Files(f), latvar(1)%vd, 'long_name', 'latitude') - ierr=pio_put_att (tape(t)%Files(f), latvar(1)%vd, 'units', 'degrees_north') - - call cam_pio_def_var(tape(t)%Files(f), 'lon', pio_double, (/timdim/), & - lonvar(1)%vd) - ierr=pio_put_att (tape(t)%Files(f), lonvar(1)%vd,'long_name','longitude') - ierr=pio_put_att (tape(t)%Files(f), lonvar(1)%vd,'units','degrees_east') - end do - + call cam_pio_def_var(tape(t)%Files(1), 'lat', pio_double, (/timdim/), & + latvar(1)%vd) + ierr=pio_put_att (tape(t)%Files(1), latvar(1)%vd, 'long_name', 'latitude') + ierr=pio_put_att (tape(t)%Files(1), latvar(1)%vd, 'units', 'degrees_north') + + call cam_pio_def_var(tape(t)%Files(1), 'lon', pio_double, (/timdim/), & + lonvar(1)%vd) + ierr=pio_put_att (tape(t)%Files(1), lonvar(1)%vd,'long_name','longitude') + ierr=pio_put_att (tape(t)%Files(1), lonvar(1)%vd,'units','degrees_east') else ! ! Setup netcdf file - create the dimensions of lat,lon,time,level @@ -4949,7 +4944,7 @@ 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 @@ -4966,7 +4961,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 @@ -4988,16 +4983,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 @@ -5006,55 +5001,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 @@ -5068,7 +5063,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 ! @@ -5080,7 +5075,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 @@ -5092,19 +5087,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') @@ -5113,7 +5108,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 @@ -5127,7 +5122,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 @@ -5145,42 +5140,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 ! !----------------------------------------------------------------------- @@ -5191,43 +5186,43 @@ 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 @@ -5343,10 +5338,10 @@ subroutine dump_field (fld, t, f, restart) mdimsize, ncreal, fdecomp) else if (tape(t)%hlist(fld)%field%zonal_complement > 0) then ! We don't want to double write so do nothing here -! compind = tape(t)%hlist(f)%field%zonal_complement +! compind = tape(t)%hlist(fld)%field%zonal_complement ! compid => tape(t)%hlist(compind)%varid(index) ! call write_interpolated(tape(t)%Files(f), compid, varid, & -! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(f)%hbuf, & +! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(fld)%hbuf, & ! mdimsize, PIO_DOUBLE, fdecomp) else ! Scalar field @@ -6822,10 +6817,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 @@ -6841,22 +6836,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. From e2742392e1a158f3dfe5eae7295dac8121a5404b Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 11:51:17 -0600 Subject: [PATCH 12/28] add parameters for split file indices --- src/control/cam_history.F90 | 81 +++++++++++++++++++++---------------- 1 file changed, 47 insertions(+), 34 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 83e0467360..17bc3c8e7f 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -142,6 +142,10 @@ module cam_history 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, but could be swapped if desired + integer, parameter :: accumulated_file_index = 1 + integer, parameter :: instantaneous_file_index = 2 + integer :: nfmaster = 0 ! number of fields in master field list integer :: nflds(ptapes) ! number of fields per tape @@ -2371,17 +2375,17 @@ subroutine read_restart_history (File) if (nfils(t) > 0) then if (hfile_accum(t) .and. hfile_inst(t)) then tape(t)%num_files = 2 - call getfil (cpath(t,1), locfn) - call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) - call getfil (cpath(t,2), locfn) - call cam_pio_openfile(tape(t)%Files(2), locfn, PIO_WRITE) + call getfil (cpath(t,accumulated_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) + call getfil (cpath(t,instantaneous_file_index), locfn) + call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) else if (hfile_accum(t)) then tape(t)%num_files = 1 - call getfil (cpath(t,1), locfn) + call getfil (cpath(t,accumulated_file_index), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) else if (hfile_inst(t)) then tape(t)%num_files = 1 - call getfil (cpath(t,2), locfn) + call getfil (cpath(t,instantaneous_file_index), locfn) call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) end if call h_inquire (t) @@ -2422,7 +2426,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 ) ! !----------------------------------------------------------------------- ! @@ -2433,8 +2437,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, 1 ) + 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 !####################################################################### @@ -4029,7 +4039,7 @@ subroutine h_inquire (t) do fld=1,nflds(t) if (tape(t)%num_files > 1) then ! we have two files - instantaneous and accumulated - if (f == 1) then + if (f == accumulated_file_index) then ! this is the accumulated file - skip instantaneous fields if (tape(t)%hlist(fld)%avgflag == 'I') then cycle @@ -4291,11 +4301,12 @@ subroutine h_define (t, restart) tape => history_tape if(masterproc) then if (hfile_accum(t) .and. hfile_inst(t)) then - write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,1)), trim(nhfil(t,2)) + write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,accumulated_file_index)), & + trim(nhfil(t,instantaneous_file_index)) else if (hfile_accum(t)) then - write(iulog,*)'Opening accumulated netcdf history file ', trim(nhfil(t,1)) + write(iulog,*)'Opening accumulated netcdf history file ', trim(nhfil(t,accumulated_file_index)) else if (hfile_inst(t)) then - write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,2)) + write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,instantaneous_file_index)) end if end if end if @@ -4307,19 +4318,19 @@ subroutine h_define (t, restart) call cam_pio_createfile (tape(t)%Files(1), hrestpath(t), amode) else if (is_initfile(file_index=t) .or. is_satfile(t)) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) else ! figure out how many history files to generate for this tape if (hfile_accum(t) .and. hfile_inst(t)) then tape(t)%num_files = 2 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) - call cam_pio_createfile (tape(t)%Files(2), nhfil(t,2), amode) + call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) + call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) else if (hfile_accum(t)) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,1), amode) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), amode) else if (hfile_inst(t)) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,2), amode) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) end if end if if(is_satfile(t)) then @@ -4635,7 +4646,7 @@ subroutine h_define (t, restart) do fld = 1, nflds(t) if (tape(t)%num_files > 1) then ! we have two files - instantaneous and accumulated - if (f == 1) then + if (f == accumulated_file_index) then ! this is the accumulated file - skip instantaneous fields if (tape(t)%hlist(fld)%avgflag == 'I') then cycle @@ -5617,10 +5628,10 @@ subroutine wshist (rgnht_in) 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,1)) .and. trim(fname_acc) /= '') then + 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,2)) .and. trim(fname_inst) /= '') then + 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 @@ -5642,15 +5653,14 @@ subroutine wshist (rgnht_in) write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,1)) end if else - nhfil(t,1) = fname_acc - nhfil(t,2) = fname_inst + 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,1)) - write(iulog,*)'WSHIST: instantaneous nhfil(',t,')=',trim(nhfil(t,2)) + 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,1) = nhfil(t,1) - cpath(t,2) = nhfil(t,2) + cpath(t,:) = nhfil(t,:) if ( len_trim(nfpath(t)) == 0 ) nfpath(t) = cpath(t, 1) end if call h_define (t, restart) @@ -5740,7 +5750,7 @@ subroutine wshist (rgnht_in) do f = 1, tape(t)%num_files if (tape(t)%num_files > 1) then ! We have two files - one for accumulated and one for instantaneous fields - if (f == 1) then + if (f == accumulated_file_index) 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 @@ -5795,9 +5805,10 @@ subroutine wshist (rgnht_in) do fld=1,nflds(t) do f = 1, tape(t)%num_files if (tape(t)%num_files > 1) then - if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. f == 1) then + ! we 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) then cycle - else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == 2) then + else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == instantaneous_file_index) then cycle end if else @@ -6437,7 +6448,9 @@ subroutine wrapup (rstwr, nlend) ! If so, just close primary unit do not dispose. ! if (masterproc) then - write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,1)) + do f = 1, tape(t)%num_files + write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,f)) + end do end if if(pio_file_is_open(tape(t)%Files(1))) then if (nlend .or. lfill(t)) then @@ -6475,12 +6488,12 @@ subroutine wrapup (rstwr, nlend) ! if (.not.nlend .and. .not.lfill(t)) then if (hfile_accum(t) .and. hfile_inst(t)) then - call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) - call cam_PIO_openfile (tape(t)%Files(2), nhfil(t,2), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) else if (hfile_accum(t)) then - call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,1), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), PIO_WRITE) else if (hfile_inst(t)) then - call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,2), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), PIO_WRITE) end if call h_inquire(t) end if From f3c8a30e104b011b27e3d30c53a34fd5153b6b8e Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 12:04:18 -0600 Subject: [PATCH 13/28] better logging --- src/control/cam_history.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 17bc3c8e7f..24ca08be83 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -2400,7 +2400,9 @@ subroutine read_restart_history (File) ! if (nfils(t) >= mfilt(t)) then if (masterproc) then - write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,1), mfilt(t) + do f = 1, tape(t)%num_files + write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,f), mfilt(t) + end do end if do fld=1,nflds(t) deallocate(tape(t)%hlist(fld)%varid) From e05302cd4d4c2e40b960790e6ed50160cd553e6c Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 13:28:05 -0600 Subject: [PATCH 14/28] remove unnecessary loop --- src/control/cam_history.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 24ca08be83..7d7c071ab7 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5840,9 +5840,7 @@ subroutine wshist (rgnht_in) nullify(tape(t)%hlist(fld)%varid) end if end do - do f = 1, tape(t)%num_files - call cam_pio_closefile(tape(t)%Files(f)) - end do + call cam_pio_closefile(tape(t)%Files(1)) else !$OMP PARALLEL DO PRIVATE (FLD) do fld=1,nflds(t) From 157639d5ada0928c21c0a0d4506cc549c09787e0 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Thu, 19 Oct 2023 17:06:50 -0600 Subject: [PATCH 15/28] fix indices --- src/control/cam_history.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 7d7c071ab7..1d8f730e44 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -4329,10 +4329,10 @@ subroutine h_define (t, restart) call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) else if (hfile_accum(t)) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), amode) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) else if (hfile_inst(t)) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) + call cam_pio_createfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), amode) end if end if if(is_satfile(t)) then From 356af85705872d0b26f819ce1b76ff45f89121df Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 20 Oct 2023 13:58:42 -0600 Subject: [PATCH 16/28] add parameters for sat, restart, and init file indices --- src/control/cam_history.F90 | 65 +++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 31 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 1d8f730e44..88af7febf4 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -145,6 +145,10 @@ module cam_history ! Indices for split history files; must be 1 and 2, but could be swapped if desired integer, parameter :: accumulated_file_index = 1 integer, parameter :: instantaneous_file_index = 2 + ! Indices for non-split history files; must all be 1 + 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 @@ -2246,7 +2250,7 @@ subroutine read_restart_history (File) ! Open history restart file ! call getfil (hrestpath(t), locfn) - call cam_pio_openfile(tape(t)%Files(1), locfn, 0) + call cam_pio_openfile(tape(t)%Files(restart_file_index), locfn, 0) ! ! Read history restart file ! @@ -2254,13 +2258,13 @@ subroutine read_restart_history (File) 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)%Files(1), fname_tmp, vdesc) - call cam_pio_var_info(tape(t)%Files(1), vdesc, ndims, dimids, dimlens) + 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) if(.not. associated(tape(t)%hlist(fld)%field%mdims)) then dimcnt = 0 do i=1,ndims - ierr = pio_inq_dimname(tape(t)%Files(1), 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 @@ -2292,27 +2296,27 @@ subroutine read_restart_history (File) end if fdecomp = tape(t)%hlist(fld)%field%decomp_type if (nfdims > 2) then - call cam_grid_read_dist_array(tape(t)%Files(1), fdecomp, & + 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)%Files(1), fdecomp, & + 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(fld)%sbuf) ) then ! read in variance for standard deviation - ierr = pio_inq_varid(tape(t)%Files(1), 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)%Files(1), fdecomp, & + 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)%Files(1), fdecomp, & + 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)%Files(1), trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%Files(1), 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 @@ -2321,22 +2325,22 @@ subroutine read_restart_history (File) end if 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(1), fdecomp, fdims(1:2), & + 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(fld)%nacs(1,begdim3:enddim3)) - ierr = pio_get_var(tape(t)%Files(1), vdesc, nacsval) + 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)%Files(1), trim(fname_tmp)//'_nacs', vdesc) - call cam_pio_var_info(tape(t)%Files(1), 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)%Files(1)) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) end if ! rgnht(t) @@ -2392,7 +2396,7 @@ subroutine read_restart_history (File) if(is_satfile(t)) then ! Initialize the sat following history subsystem call sat_hist_init() - call sat_hist_define(tape(t)%Files(1)) + call sat_hist_define(tape(t)%Files(sat_file_index)) end if end if ! @@ -4317,10 +4321,10 @@ subroutine h_define (t, restart) if(restart) then tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), 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 tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) + call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else ! figure out how many history files to generate for this tape if (hfile_accum(t) .and. hfile_inst(t)) then @@ -4338,20 +4342,20 @@ subroutine h_define (t, restart) 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)%Files(1), 'ncol', pio_unlimited, timdim) - call cam_pio_def_dim(tape(t)%Files(1), '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)%Files(1), '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)%Files(1), latvar(1)%vd, 'long_name', 'latitude') - ierr=pio_put_att (tape(t)%Files(1), 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)%Files(1), '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)%Files(1), lonvar(1)%vd,'long_name','longitude') - ierr=pio_put_att (tape(t)%Files(1), 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 @@ -5649,10 +5653,9 @@ subroutine wshist (rgnht_in) end do if(.not. restart) then if (is_initfile(file_index=t)) then - nhfil(t,1) = fname - nhfil(t,2) = fname + nhfil(t,:) = fname if(masterproc) then - write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,1)) + write(iulog,*)'WSHIST: initfile nhfil(',t,')=',trim(nhfil(t,init_file_index)) end if else nhfil(t,accumulated_file_index) = fname_acc @@ -5840,7 +5843,7 @@ subroutine wshist (rgnht_in) nullify(tape(t)%hlist(fld)%varid) end if end do - call cam_pio_closefile(tape(t)%Files(1)) + call cam_pio_closefile(tape(t)%Files(restart_file_index)) else !$OMP PARALLEL DO PRIVATE (FLD) do fld=1,nflds(t) From cd4cece872b6fb46aa03846657a3372fe2d3a51e Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Fri, 20 Oct 2023 17:22:06 -0600 Subject: [PATCH 17/28] clean up File indexing logic --- src/control/cam_history.F90 | 286 +++++++++++++++------------- src/control/cam_history_support.F90 | 1 - 2 files changed, 157 insertions(+), 130 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 88af7febf4..949cb53082 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 @@ -145,7 +146,7 @@ module cam_history ! Indices for split history files; must be 1 and 2, but could be swapped if desired integer, parameter :: accumulated_file_index = 1 integer, parameter :: instantaneous_file_index = 2 - ! Indices for non-split history files; must all be 1 + ! 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 @@ -2378,19 +2379,16 @@ subroutine read_restart_history (File) else if (nfils(t) > 0) then if (hfile_accum(t) .and. hfile_inst(t)) then - tape(t)%num_files = 2 call getfil (cpath(t,accumulated_file_index), locfn) call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) call getfil (cpath(t,instantaneous_file_index), locfn) call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) else if (hfile_accum(t)) then - tape(t)%num_files = 1 call getfil (cpath(t,accumulated_file_index), locfn) - call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) else if (hfile_inst(t)) then - tape(t)%num_files = 1 call getfil (cpath(t,instantaneous_file_index), locfn) - call cam_pio_openfile(tape(t)%Files(1), locfn, PIO_WRITE) + call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) end if call h_inquire (t) if(is_satfile(t)) then @@ -2404,16 +2402,20 @@ subroutine read_restart_history (File) ! if (nfils(t) >= mfilt(t)) then if (masterproc) then - do f = 1, tape(t)%num_files - write(iulog,*)'READ_RESTART_HISTORY: nf_close(',t,')=',nhfil(t,f), mfilt(t) + do f = 1, size(tape(t)%Files) + 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 fld=1,nflds(t) deallocate(tape(t)%hlist(fld)%varid) nullify(tape(t)%hlist(fld)%varid) end do - do f = 1, tape(t)%num_files - call cam_pio_closefile(tape(t)%Files(f)) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) then + call cam_pio_closefile(tape(t)%Files(f)) + end if end do nfils(t) = 0 end if @@ -3994,7 +3996,10 @@ subroutine h_inquire (t) ! ! Create variables for model timing and header information ! - do f = 1, tape(t)%num_files + do f = 1, size(tape(t)%Files) + if (.not. pio_file_is_open(tape(t)%Files(f))) then + cycle + end if if(.not. is_satfile(t)) 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) @@ -4043,18 +4048,15 @@ subroutine h_inquire (t) ! Obtain variable name from ID which was read from restart file ! do fld=1,nflds(t) - if (tape(t)%num_files > 1) then - ! we have two files - instantaneous and accumulated - 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 + 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 @@ -4219,7 +4221,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 @@ -4320,23 +4322,18 @@ subroutine h_define (t, restart) amode = PIO_CLOBBER if(restart) then - tape(t)%num_files = 1 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 - tape(t)%num_files = 1 call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else ! figure out how many history files to generate for this tape if (hfile_accum(t) .and. hfile_inst(t)) then - tape(t)%num_files = 2 call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) else if (hfile_accum(t)) then - tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), amode) + call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) else if (hfile_inst(t)) then - tape(t)%num_files = 1 - call cam_pio_createfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), amode) + call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) end if end if if(is_satfile(t)) then @@ -4368,8 +4365,10 @@ subroutine h_define (t, restart) ! Interpolation is special in that we ignore the native grids if(interpolate) then allocate(header_info(1)) - do f = 1, tape(t)%num_files - call cam_grid_write_attr(tape(t)%Files(f), interpolate_info(t)%grid_id, header_info(1), file_index=f) + do f = 1, size(tape(t)%Files) + 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 @@ -4378,23 +4377,29 @@ 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) - do f = 1, tape(t)%num_files - call tape(t)%patches(i)%write_attrs(tape(t)%Files(f)) + do f = 1, size(tape(t)%Files) + 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) - do f = 1, tape(t)%num_files - call cam_grid_write_attr(tape(t)%Files(f), tape(t)%grid_ids(i), header_info(i), file_index=f) + do f = 1, size(tape(t)%Files) + 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 - do f = 1, tape(t)%num_files - 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) + do f = 1, size(tape(t)%Files) + 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 @@ -4421,7 +4426,10 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) - do f = 1, tape(t)%num_files + do f = 1, size(tape(t)%Files) + 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', & @@ -4650,15 +4658,14 @@ subroutine h_define (t, restart) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do fld = 1, nflds(t) - if (tape(t)%num_files > 1) then - ! we have two files - instantaneous and accumulated + 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 - skip instantaneous fields + ! 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 - skip accumulated fields + ! 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 @@ -4895,20 +4902,26 @@ subroutine h_define (t, restart) ! if(.not. is_satfile(t)) then if(interpolate) then - do f = 1, tape(t)%num_files - call cam_grid_write_var(tape(t)%Files(f), interpolate_info(t)%grid_id, file_index=f) + do f = 1, size(tape(t)%Files) + 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) - do f = 1, tape(t)%num_files - call cam_grid_write_var(tape(t)%Files(f), tape(t)%grid_ids(i), file_index=f) + do f = 1, size(tape(t)%Files) + 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) - do f = 1, tape(t)%num_files - call tape(t)%patches(i)%write_vals(tape(t)%Files(f)) + do f = 1, size(tape(t)%Files) + 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 @@ -4920,7 +4933,10 @@ subroutine h_define (t, restart) end if dtime = get_step_size() - do f = 1, tape(t)%num_files + do f = 1, size(tape(t)%Files) + 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') ! @@ -4953,8 +4969,10 @@ subroutine h_define (t, restart) end if ! Write the mdim variable data - do f = 1, tape(t)%num_files - call write_hist_coord_vars(tape(t)%Files(f), restart) + do f = 1, size(tape(t)%Files) + 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 @@ -5685,60 +5703,76 @@ subroutine wshist (rgnht_in) if (interpolate_output(t) .and. (.not. restart)) then call set_interp_hfile(t, interpolate_info) end if - do f = 1, tape(t)%num_files - ierr = pio_put_var (tape(t)%Files(f), tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) - ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) - ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) + end if end do if (.not. is_initfile(file_index=t)) then ! Don't write the GHG/Solar forcing data to the IC file. - do f = 1, tape(t)%num_files - 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/)) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) then + 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/)) + end if end do if (solar_parms_on) then - do f = 1, tape(t)%num_files - 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 /) ) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) + end if end do endif if (solar_wind_on) then - do f = 1, tape(t)%num_files - 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 /) ) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) + end if end do endif if (epot_active) then - do f = 1, tape(t)%num_files - 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) /) ) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) 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) /) ) + end if end do endif end if - do f = 1, tape(t)%num_files - ierr = pio_put_var (tape(t)%Files(f), tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) + end if end do #if ( defined BFB_CAM_SCAM_IOP ) dtime = get_step_size() tsec=dtime*nstep - do f = 1, tape(t)%num_files - ierr = pio_put_var (tape(t)%Files(f), tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) + do f = 1, size(tape(t)%Files) + 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 - do f = 1, tape(t)%num_files - ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) + do f = 1, size(tape(t)%Files) + if (pio_file_is_open(tape(t)%Files(f))) then + ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) + end if end do time = ndcur + nscur/86400._r8 @@ -5752,24 +5786,17 @@ subroutine wshist (rgnht_in) tdata(1) = beg_time(t) tdata(2) = time end if - do f = 1, tape(t)%num_files - if (tape(t)%num_files > 1) then - ! We have two files - one for accumulated and one for instantaneous fields - if (f == accumulated_file_index) 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 - ! instantaneous tape - time is current time - ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) - end if + do f = 1, size(tape(t)%Files) + 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) .and. .not. is_satfile(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 - if (hfile_accum(t) .and. .not. restart) 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 - ! instantaneous tape - time is current time - ierr=pio_put_var (tape(t)%Files(f), tape(t)%timeid, (/start/),(/count1/),(/time/)) - end if + ! 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 @@ -5779,9 +5806,11 @@ subroutine wshist (rgnht_in) countc(1) = 8 countc(2) = 1 call datetime (cdate, ctime) - do f = 1, tape(t)%num_files - 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/)) + do f = 1, size(tape(t)%Files) + 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 @@ -5808,20 +5837,15 @@ subroutine wshist (rgnht_in) ! call t_startf ('dump_field') do fld=1,nflds(t) - do f = 1, tape(t)%num_files - if (tape(t)%num_files > 1) then - ! we 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) then - cycle - else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. f == instantaneous_file_index) then - cycle - end if - else - if ((tape(t)%hlist(fld)%avgflag .eq. 'I') .and. hfile_accum(t) .and. .not. restart) then - cycle - else if ((tape(t)%hlist(fld)%avgflag .ne. 'I') .and. hfile_inst(t) .and. .not. restart) then - cycle - end if + do f = 1, size(tape(t)%Files) + 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 @@ -6382,7 +6406,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 @@ -6451,11 +6474,14 @@ subroutine wrapup (rstwr, nlend) ! If so, just close primary unit do not dispose. ! if (masterproc) then - do f = 1, tape(t)%num_files - write(iulog,*)'WRAPUP: nf_close(',t,')=',trim(nhfil(t,f)) + do f = 1, size(tape(t)%Files) + 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(1))) then + 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 fld=1,nflds(t) if (associated(tape(t)%hlist(fld)%varid)) then @@ -6465,8 +6491,10 @@ subroutine wrapup (rstwr, nlend) end do end if end if - do f = 1, tape(t)%num_files - call cam_pio_closefile(tape(t)%Files(f)) + do f = 1, size(tape(t)%Files) + 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 @@ -6494,9 +6522,9 @@ subroutine wrapup (rstwr, nlend) call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) else if (hfile_accum(t)) then - call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,accumulated_file_index), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) else if (hfile_inst(t)) then - call cam_PIO_openfile (tape(t)%Files(1), nhfil(t,instantaneous_file_index), PIO_WRITE) + call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) end if call h_inquire(t) end if diff --git a/src/control/cam_history_support.F90 b/src/control/cam_history_support.F90 index 4d6040d5fc..07ab2dd81a 100644 --- a/src/control/cam_history_support.F90 +++ b/src/control/cam_history_support.F90 @@ -198,7 +198,6 @@ module cam_history_support ! type(file_desc_t) :: Files(maxsplitfiles) ! PIO file ids - integer :: num_files ! number of files to use type(var_desc_t) :: mdtid ! var id for timestep type(var_desc_t) :: ndbaseid ! var id for base day From ed5dbe26989accdb0a1dc7486fa07581f1ce4ca6 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 1 Nov 2023 16:34:50 -0600 Subject: [PATCH 18/28] address reviewer comments --- src/control/cam_history.F90 | 121 +++++++++++++-------------------- src/utils/cam_grid_support.F90 | 6 +- 2 files changed, 51 insertions(+), 76 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 949cb53082..4dba76b444 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -806,8 +806,7 @@ subroutine history_readnl(nlfile) else ! Append file type - instantaneous or accumulated - to filename ! specifier provided - temp_spec = trim(hfilename_spec(t)) // '%f' - hfilename_spec(t) = temp_spec + hfilename_spec(t) = trim(hfilename_spec(t)) // '%f' end if ! ! Only one time sample allowed per monthly average file @@ -1779,7 +1778,6 @@ subroutine write_restart_history ( File, & end do deallocate(xyfill, allmdims, is_subcol, interp_output, restarthistory_tape) - return end subroutine write_restart_history @@ -2318,7 +2316,7 @@ subroutine read_restart_history (File) 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) @@ -2378,15 +2376,11 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then - if (hfile_accum(t) .and. hfile_inst(t)) then - call getfil (cpath(t,accumulated_file_index), locfn) - call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) - call getfil (cpath(t,instantaneous_file_index), locfn) - call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) - else if (hfile_accum(t)) then + if (hfile_accum(t)) then call getfil (cpath(t,accumulated_file_index), locfn) call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) - else if (hfile_inst(t)) then + end if + if (hfile_inst(t)) then call getfil (cpath(t,instantaneous_file_index), locfn) call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) end if @@ -2402,7 +2396,7 @@ subroutine read_restart_history (File) ! if (nfils(t) >= mfilt(t)) then if (masterproc) then - do f = 1, size(tape(t)%Files) + 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 @@ -2412,7 +2406,7 @@ subroutine read_restart_history (File) deallocate(tape(t)%hlist(fld)%varid) nullify(tape(t)%hlist(fld)%varid) end do - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) then call cam_pio_closefile(tape(t)%Files(f)) end if @@ -3996,7 +3990,7 @@ subroutine h_inquire (t) ! ! Create variables for model timing and header information ! - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle end if @@ -4327,12 +4321,10 @@ subroutine h_define (t, restart) call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else ! figure out how many history files to generate for this tape - if (hfile_accum(t) .and. hfile_inst(t)) then + if (hfile_accum(t)) then call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) - call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) - else if (hfile_accum(t)) then - call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) - else if (hfile_inst(t)) then + end if + if (hfile_inst(t)) then call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) end if end if @@ -4365,7 +4357,7 @@ subroutine h_define (t, restart) ! Interpolation is special in that we ignore the native grids if(interpolate) then allocate(header_info(1)) - do f = 1, size(tape(t)%Files) + 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 @@ -4377,7 +4369,7 @@ 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) - do f = 1, size(tape(t)%Files) + 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 @@ -4386,7 +4378,7 @@ subroutine h_define (t, restart) else allocate(header_info(size(tape(t)%grid_ids))) do i = 1, size(tape(t)%grid_ids) - do f = 1, size(tape(t)%Files) + 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 @@ -4394,7 +4386,7 @@ subroutine h_define (t, restart) end do end if ! interpolate ! Define the unlimited time dim - do f = 1, size(tape(t)%Files) + 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.) @@ -4426,7 +4418,7 @@ subroutine h_define (t, restart) write(time_per_freq,999) 'second_',sec_nhtfrq*dtime end if 999 format(a,i0) - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle end if @@ -4475,13 +4467,6 @@ subroutine h_define (t, restart) ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'logname',logname) ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'host', host) -! Put these back in when they are filled properly -! ierr=pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'title',ctitle) -! ierr= pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'Version', & -! '$Name$') -! ierr= pio_put_att (tape(t)%Files(f), PIO_GLOBAL, 'revision_Id', & -! '$Id$') - 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 @@ -4577,7 +4562,7 @@ subroutine h_define (t, restart) ierr=pio_put_att (tape(t)%Files(f), tape(t)%sol_tsiid, 'units', trim(str)) if (solar_parms_on) then - ! solar / geomagetic activity indices... + ! 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)) @@ -4845,11 +4830,7 @@ subroutine h_define (t, restart) else str = tape(t)%hlist(fld)%time_op end if - if (len_trim(cell_methods) > 0) then - cell_methods = trim(cell_methods)//' '//'time: '//str - else - cell_methods = trim(cell_methods)//'time: '//str - 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, & @@ -4892,6 +4873,9 @@ subroutine h_define (t, restart) ! 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 ' @@ -4902,15 +4886,15 @@ subroutine h_define (t, restart) ! if(.not. is_satfile(t)) then if(interpolate) then - do f = 1, size(tape(t)%Files) + 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) - do f = 1, size(tape(t)%Files) - if (pio_file_is_open(tape(t)%Files(F))) then + 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 @@ -4918,7 +4902,7 @@ subroutine h_define (t, restart) else ! Patch output do i = 1, size(tape(t)%patches) - do f = 1, size(tape(t)%Files) + 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 @@ -4933,7 +4917,7 @@ subroutine h_define (t, restart) end if dtime = get_step_size() - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle end if @@ -4969,7 +4953,7 @@ subroutine h_define (t, restart) end if ! Write the mdim variable data - do f = 1, size(tape(t)%Files) + 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 @@ -5269,9 +5253,9 @@ subroutine dump_field (fld, t, f, restart) use interp_mod, only : write_interpolated ! Dummy arguments - integer, intent(in) :: fld - integer, intent(in) :: t - integer, intent(in) :: f + integer, intent(in) :: fld ! Field index + integer, intent(in) :: t ! Tape index + integer, intent(in) :: f ! File index logical, intent(in) :: restart ! !----------------------------------------------------------------------- @@ -5371,14 +5355,7 @@ subroutine dump_field (fld, t, f, restart) 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(fld)%field%zonal_complement > 0) then - ! We don't want to double write so do nothing here -! compind = tape(t)%hlist(fld)%field%zonal_complement -! compid => tape(t)%hlist(compind)%varid(index) -! call write_interpolated(tape(t)%Files(f), compid, varid, & -! tape(t)%hlist(compind)%hbuf, tape(t)%hlist(fld)%hbuf, & -! mdimsize, PIO_DOUBLE, fdecomp) - else + else if (tape(t)%hlist(fld)%field%zonal_complement <= 0) then ! Scalar field call write_interpolated(tape(t)%Files(f), varid, & tape(t)%hlist(fld)%hbuf, mdimsize, ncreal, fdecomp) @@ -5665,7 +5642,7 @@ subroutine wshist (rgnht_in) if ( t /= f )then write(iulog,*)'hfilename_spec(', f, ') = ', trim(hfilename_spec(f)) end if - call endrun + call endrun('WSHIST: ERROR - see atm log file for information') end if end if end do @@ -5703,7 +5680,7 @@ subroutine wshist (rgnht_in) if (interpolate_output(t) .and. (.not. restart)) then call set_interp_hfile(t, interpolate_info) end if - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) then ierr = pio_put_var (tape(t)%Files(f), tape(t)%ndcurid,(/start/), (/count1/),(/ndcur/)) ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) @@ -5713,7 +5690,7 @@ subroutine wshist (rgnht_in) if (.not. is_initfile(file_index=t)) then ! Don't write the GHG/Solar forcing data to the IC file. - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) then 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')/)) @@ -5725,7 +5702,7 @@ subroutine wshist (rgnht_in) end do if (solar_parms_on) then - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) @@ -5736,7 +5713,7 @@ subroutine wshist (rgnht_in) end do endif if (solar_wind_on) then - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) @@ -5746,7 +5723,7 @@ subroutine wshist (rgnht_in) end do endif if (epot_active) then - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) 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) /) ) @@ -5755,7 +5732,7 @@ subroutine wshist (rgnht_in) endif end if - do f = 1, size(tape(t)%Files) + 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/)) end if @@ -5763,13 +5740,13 @@ subroutine wshist (rgnht_in) #if ( defined BFB_CAM_SCAM_IOP ) dtime = get_step_size() tsec=dtime*nstep - do f = 1, size(tape(t)%Files) + 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 - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) then ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) end if @@ -5786,7 +5763,7 @@ subroutine wshist (rgnht_in) tdata(1) = beg_time(t) tdata(2) = time end if - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle end if @@ -5806,7 +5783,7 @@ subroutine wshist (rgnht_in) countc(1) = 8 countc(2) = 1 call datetime (cdate, ctime) - do f = 1, size(tape(t)%Files) + 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/)) @@ -5837,7 +5814,7 @@ subroutine wshist (rgnht_in) ! call t_startf ('dump_field') do fld=1,nflds(t) - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle end if @@ -6474,7 +6451,7 @@ subroutine wrapup (rstwr, nlend) ! If so, just close primary unit do not dispose. ! if (masterproc) then - do f = 1, size(tape(t)%Files) + 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 @@ -6491,7 +6468,7 @@ subroutine wrapup (rstwr, nlend) end do end if end if - do f = 1, size(tape(t)%Files) + do f = 1, maxsplitfiles if (pio_file_is_open(tape(t)%Files(f))) then call cam_pio_closefile(tape(t)%Files(f)) end if @@ -6518,12 +6495,10 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - if (hfile_accum(t) .and. hfile_inst(t)) then + if (hfile_accum(t)) then call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) - call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) - else if (hfile_accum(t)) then - call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) - else if (hfile_inst(t)) then + end if + if (hfile_inst(t)) then call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) end if call h_inquire(t) diff --git a/src/utils/cam_grid_support.F90 b/src/utils/cam_grid_support.F90 index d5ae61c4d0..de3cbb210b 100644 --- a/src/utils/cam_grid_support.F90 +++ b/src/utils/cam_grid_support.F90 @@ -37,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(vardesc_ptr_t) :: vardesc(2) ! If we are to write coord - type(vardesc_ptr_t) :: bndsvdesc(2) ! 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 @@ -59,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(vardesc_ptr_t) :: vardesc(2) + 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 From 5149a481a3d6c34f64ffb14868681630271d6685 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 1 Nov 2023 16:36:20 -0600 Subject: [PATCH 19/28] remove unused variable --- src/control/cam_history.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 4dba76b444..5db15ce217 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -573,7 +573,6 @@ subroutine history_readnl(nlfile) integer :: dtime ! Step time in seconds integer :: unitn, ierr, f, t character(len=8) :: ctemp ! Temporary character string - character(len=max_string_len) :: temp_spec character(len=fieldname_lenp2) :: fincl1(pflds) character(len=fieldname_lenp2) :: fincl2(pflds) From 9da259093ce4cfa2b13e2decffa515f4153ee04a Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 1 Nov 2023 16:42:10 -0600 Subject: [PATCH 20/28] fix looping range --- src/control/cam_history.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 5db15ce217..7f8d83b889 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5623,7 +5623,7 @@ subroutine wshist (rgnht_in) ! Check that this new filename isn't the same as a previous or current filename ! duplicate = .false. - do f = 1, t + do f = 1, ptapes 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) From 7a0e5282e7dd573455301bf4db753cccc4c4f8a5 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 8 Nov 2023 15:51:45 -0700 Subject: [PATCH 21/28] logic to add file type flag to right part of hfilename_spec, updates to treat nhtfrq = 1 as instantaneous --- src/control/cam_history.F90 | 41 ++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 278a3213d8..57b06f89c2 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -573,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) @@ -805,7 +806,15 @@ subroutine history_readnl(nlfile) else ! Append file type - instantaneous or accumulated - to filename ! specifier provided - hfilename_spec(t) = trim(hfilename_spec(t)) // '%f' + filename_len = len(trim(hfilename_spec(t))) + if (hfilename_spec(t)(filename_len-2:) == '.nc') then + ! File template ends in '.nc', place file type flag appropriately + hfilename_spec(t) = hfilename_spec(t)(1:filename_len-3) // '%f.nc' + else + ! File template does not end in '.nc', place file type flag at end + ! and append '.nc' + hfilename_spec(t) = trim(hfilename_spec(t)) // '%f.nc' + end if end if ! ! Only one time sample allowed per monthly average file @@ -2375,11 +2384,11 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then - if (hfile_accum(t)) then + if (hfile_accum(t) .and. nhtfrq(t) /= 1) then call getfil (cpath(t,accumulated_file_index), locfn) call cam_pio_openfile(tape(t)%Files(accumulated_file_index), locfn, PIO_WRITE) end if - if (hfile_inst(t)) then + if (hfile_inst(t) .or. nhtfrq(t) == 1) then call getfil (cpath(t,instantaneous_file_index), locfn) call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) end if @@ -4043,7 +4052,7 @@ subroutine h_inquire (t) 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 + if (tape(t)%hlist(fld)%avgflag == 'I' .or. nhtfrq(t) == 1) then cycle end if else @@ -4301,12 +4310,12 @@ subroutine h_define (t, restart) else tape => history_tape if(masterproc) then - if (hfile_accum(t) .and. hfile_inst(t)) then + if (hfile_accum(t) .and. nhtfrq(t) /= 1 .and. hfile_inst(t)) then write(iulog,*)'Opening netcdf history files ', trim(nhfil(t,accumulated_file_index)), & trim(nhfil(t,instantaneous_file_index)) - else if (hfile_accum(t)) then + else if (hfile_accum(t) .and. nhtfrq(t) /= 1) then write(iulog,*)'Opening accumulated netcdf history file ', trim(nhfil(t,accumulated_file_index)) - else if (hfile_inst(t)) then + else if (hfile_inst(t) .or. nhtfrq(t) == 1) then write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,instantaneous_file_index)) end if end if @@ -4320,10 +4329,10 @@ subroutine h_define (t, restart) call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else ! figure out how many history files to generate for this tape - if (hfile_accum(t)) then + if (hfile_accum(t) .and. nhtfrq(t) /= 1) then call cam_pio_createfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), amode) end if - if (hfile_inst(t)) then + if (hfile_inst(t) .or. nhtfrq(t) == 1) then call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) end if end if @@ -4645,7 +4654,7 @@ subroutine h_define (t, restart) 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 + if (tape(t)%hlist(fld)%avgflag == 'I' .or. nhtfrq(t) == 1) then cycle end if else @@ -4824,8 +4833,8 @@ subroutine h_define (t, restart) ! 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 = 'instantaneous' + if (tape(t)%hlist(fld)%avgflag == 'I' .or. nhtfrq(t) == 1) then + str = 'point' else str = tape(t)%hlist(fld)%time_op end if @@ -5623,7 +5632,7 @@ subroutine wshist (rgnht_in) ! Check that this new filename isn't the same as a previous or current filename ! duplicate = .false. - do f = 1, ptapes + 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) @@ -5767,7 +5776,7 @@ subroutine wshist (rgnht_in) 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) .and. .not. is_satfile(t)) then + if (f == accumulated_file_index .and. .not. restart .and. .not. is_initfile(t) .and.nhtfrq(t) /= 1) 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 @@ -6494,10 +6503,10 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - if (hfile_accum(t)) then + if (hfile_accum(t) .and. nhtfrq(t) /= 1) then call cam_PIO_openfile (tape(t)%Files(accumulated_file_index), nhfil(t,accumulated_file_index), PIO_WRITE) end if - if (hfile_inst(t)) then + if (hfile_inst(t) .or. nhtfrq(t) == 1) then call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) end if call h_inquire(t) From f955d7f879dbbcacc1c108b2f53563c8f56565f6 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 8 Nov 2023 15:55:58 -0700 Subject: [PATCH 22/28] change time_op value to "point" for instantaneous fields --- src/control/cam_history.F90 | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 57b06f89c2..473a81896c 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -805,16 +805,9 @@ subroutine history_readnl(nlfile) end if else ! Append file type - instantaneous or accumulated - to filename - ! specifier provided - filename_len = len(trim(hfilename_spec(t))) - if (hfilename_spec(t)(filename_len-2:) == '.nc') then - ! File template ends in '.nc', place file type flag appropriately - hfilename_spec(t) = hfilename_spec(t)(1:filename_len-3) // '%f.nc' - else - ! File template does not end in '.nc', place file type flag at end - ! and append '.nc' - hfilename_spec(t) = trim(hfilename_spec(t)) // '%f.nc' - end if + ! 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 @@ -2525,7 +2518,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') From d37e8c40eb87928848b73d36909da287be5f0b2f Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 29 Nov 2023 13:32:30 -0700 Subject: [PATCH 23/28] always create instantaneous file; write time-dependent fields to inst. file only --- src/control/cam_history.F90 | 220 ++++++++++++++++++------------------ 1 file changed, 107 insertions(+), 113 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 473a81896c..f5c1875b35 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -143,9 +143,9 @@ module cam_history 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, but could be swapped if desired - integer, parameter :: accumulated_file_index = 1 - integer, parameter :: instantaneous_file_index = 2 + ! 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 @@ -309,8 +309,6 @@ module cam_history 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. - ! Flag for if there are instantaneous fields specified for a given tape - logical :: hfile_inst(ptapes) = .false. interface addfld @@ -485,9 +483,11 @@ subroutine intht (model_doi_url_in) ! do t=1,ptapes do fld=1,nflds(t) - if (tape(t)%hlist(fld)%avgflag .eq. 'I') then - hfile_inst(t) = .true. - else + 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 @@ -789,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: @@ -2148,9 +2155,7 @@ subroutine read_restart_history (File) gridsontape = -1 do t = 1, ptapes do fld = 1, nflds(t) - if (tape(t)%hlist(fld)%avgflag .eq. 'I') then - hfile_inst(t) = .true. - else + if (tape(t)%hlist(fld)%avgflag .ne. 'I') then hfile_accum(t) = .true. end if call set_field_dimensions(tape(t)%hlist(fld)%field) @@ -2377,14 +2382,14 @@ subroutine read_restart_history (File) nfils(t) = 0 else if (nfils(t) > 0) then - if (hfile_accum(t) .and. nhtfrq(t) /= 1) then + ! 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 - if (hfile_inst(t) .or. nhtfrq(t) == 1) then - call getfil (cpath(t,instantaneous_file_index), locfn) - call cam_pio_openfile(tape(t)%Files(instantaneous_file_index), locfn, PIO_WRITE) - end if call h_inquire (t) if(is_satfile(t)) then ! Initialize the sat following history subsystem @@ -2953,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)' @@ -3996,20 +4001,22 @@ subroutine h_inquire (t) cycle end if if(.not. is_satfile(t)) 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) - + 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) + 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)%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 + 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) @@ -4045,7 +4052,7 @@ subroutine h_inquire (t) 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' .or. nhtfrq(t) == 1) then + if (tape(t)%hlist(fld)%avgflag == 'I') then cycle end if else @@ -4292,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, & @@ -4303,12 +4311,12 @@ subroutine h_define (t, restart) else tape => history_tape if(masterproc) then - if (hfile_accum(t) .and. nhtfrq(t) /= 1 .and. hfile_inst(t)) 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 if (hfile_accum(t) .and. nhtfrq(t) /= 1) then - write(iulog,*)'Opening accumulated netcdf history file ', trim(nhfil(t,accumulated_file_index)) - else if (hfile_inst(t) .or. nhtfrq(t) == 1) then + else + ! We just have the instantaneous file write(iulog,*)'Opening instantaneous netcdf history file ', trim(nhfil(t,instantaneous_file_index)) end if end if @@ -4322,12 +4330,12 @@ subroutine h_define (t, restart) call cam_pio_createfile (tape(t)%Files(sat_file_index), nhfil(t,sat_file_index), amode) else ! figure out how many history files to generate for this tape - if (hfile_accum(t) .and. nhtfrq(t) /= 1) then + ! 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 - if (hfile_inst(t) .or. nhtfrq(t) == 1) then - call cam_pio_createfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), amode) - end if end if if(is_satfile(t)) then interpolate = .false. ! !!XXgoldyXX: Do we ever want to support this? @@ -4445,12 +4453,10 @@ subroutine h_define (t, restart) ierr=pio_put_att (tape(t)%Files(f), tape(t)%timeid, 'calendar', trim(calendar)) - 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)%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)) @@ -4524,18 +4530,19 @@ subroutine h_define (t, restart) ! ! Create variables for model timing and header information ! - - 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)) + 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 - if (.not. is_initfile(file_index=t)) then + 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)) @@ -4626,15 +4633,16 @@ subroutine h_define (t, restart) endif end if - + 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)) + 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)) + 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -4647,7 +4655,7 @@ subroutine h_define (t, restart) 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' .or. nhtfrq(t) == 1) then + if (tape(t)%hlist(fld)%avgflag == 'I') then cycle end if else @@ -4826,7 +4834,7 @@ subroutine h_define (t, restart) ! 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' .or. nhtfrq(t) == 1) then + if (tape(t)%hlist(fld)%avgflag == 'I') then str = 'point' else str = tape(t)%hlist(fld)%time_op @@ -5542,7 +5550,6 @@ subroutine wshist (rgnht_in) 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. @@ -5681,61 +5688,47 @@ 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)%ndcurid,(/start/), (/count1/),(/ndcur/)) - ierr = pio_put_var (tape(t)%Files(f), tape(t)%nscurid,(/start/), (/count1/),(/nscur/)) - ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/), (/count1/),(/ncdate/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/),(/count1/),(/ncdate/)) end if end do - if (.not. is_initfile(file_index=t)) then - ! Don't write the GHG/Solar forcing data to the IC file. - do f = 1, maxsplitfiles - if (pio_file_is_open(tape(t)%Files(f))) then - 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/)) - end if - end do - - if (solar_parms_on) then - do f = 1, maxsplitfiles - if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) - end if - end do - endif - if (solar_wind_on) then - do f = 1, maxsplitfiles - if (pio_file_is_open(tape(t)%Files(f))) 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 /) ) - end if - end do - endif - if (epot_active) then - do f = 1, maxsplitfiles - if (pio_file_is_open(tape(t)%Files(f))) 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) /) ) - end if - end do - endif - end if - + 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/)) + ierr = pio_put_var (tape(t)%Files(f),tape(t)%datesecid,(/start/),(/count1/),(/ncsec/)) end if end do #if ( defined BFB_CAM_SCAM_IOP ) @@ -5743,15 +5736,16 @@ subroutine wshist (rgnht_in) tsec=dtime*nstep 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/)) + ierr = pio_put_var (tape(t)%Files(f),tape(t)%tsecid,(/start/),(/count1/),(/tsec/)) end if end do #endif - do f = 1, maxsplitfiles - if (pio_file_is_open(tape(t)%Files(f))) then - ierr = pio_put_var (tape(t)%Files(f), tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) - end if - end do +! do f = 1, maxsplitfiles +! if (f == instantaneous_file_index .and. pio_file_is_open(tape(t)%Files(f))) then +! ierr = pio_put_var (tape(t)%Files(f),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) +! end if +! end do + ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) time = ndcur + nscur/86400._r8 startc(1) = 1 @@ -5769,7 +5763,7 @@ subroutine wshist (rgnht_in) 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) .and.nhtfrq(t) /= 1) then + 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 @@ -6496,12 +6490,12 @@ subroutine wrapup (rstwr, nlend) ! Must position auxiliary files if not full ! if (.not.nlend .and. .not.lfill(t)) then - if (hfile_accum(t) .and. nhtfrq(t) /= 1) then + ! 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 - if (hfile_inst(t) .or. nhtfrq(t) == 1) then - call cam_PIO_openfile (tape(t)%Files(instantaneous_file_index), nhfil(t,instantaneous_file_index), PIO_WRITE) - end if call h_inquire(t) end if endif ! if 0 timestep of montly run**** From 13dd76d1e19df61ce25c948795df94d3a87fb354 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 29 Nov 2023 13:35:38 -0700 Subject: [PATCH 24/28] address reviewer comments --- src/control/cam_history.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index f5c1875b35..c5c296e56f 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -2655,7 +2655,7 @@ 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. + ! 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 @@ -4314,7 +4314,7 @@ subroutine h_define (t, restart) 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)) + ' ', 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)) From 39ca24763f42c213c4e92417a3e07d1a6d5e5278 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 5 Dec 2023 10:57:58 -0700 Subject: [PATCH 25/28] calculate midpoint date and datesec for accumulated file --- src/control/cam_history.F90 | 60 ++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 27 deletions(-) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index c5c296e56f..83821f6849 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -5507,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 @@ -5534,11 +5535,11 @@ 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 @@ -5546,6 +5547,7 @@ subroutine wshist (rgnht_in) 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 @@ -5561,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 @@ -5580,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 @@ -5588,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 @@ -5692,7 +5711,7 @@ subroutine wshist (rgnht_in) 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/)) + ierr = pio_put_var (tape(t)%Files(f), tape(t)%dateid,(/start/),(/count1/),(/ncdate(f)/)) end if end do @@ -5728,7 +5747,7 @@ subroutine wshist (rgnht_in) 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/)) + 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 ) @@ -5740,24 +5759,11 @@ subroutine wshist (rgnht_in) end if end do #endif -! do f = 1, maxsplitfiles -! if (f == instantaneous_file_index .and. pio_file_is_open(tape(t)%Files(f))) then -! ierr = pio_put_var (tape(t)%Files(f),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) -! end if -! end do ierr = pio_put_var (tape(t)%Files(instantaneous_file_index),tape(t)%nstephid,(/start/),(/count1/),(/nstep/)) - time = ndcur + nscur/86400._r8 - 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 do f = 1, maxsplitfiles if (.not. pio_file_is_open(tape(t)%Files(f))) then cycle From de6c33aaa737b26dd9232d3c52181699d1b58a60 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 5 Dec 2023 15:12:55 -0700 Subject: [PATCH 26/28] fix sct tests --- cime_config/SystemTests/sct.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/SystemTests/sct.py b/cime_config/SystemTests/sct.py index 7abcbc74bf..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.h1a."+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/*h1a*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]) From b32b71e117c38f6155a36fe67af5f4f75ec3d7a3 Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Tue, 5 Dec 2023 16:53:57 -0700 Subject: [PATCH 27/28] initial changelog --- doc/ChangeLog | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index dcfaa48b18..d06b920813 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,83 @@ =============================================================== +Tag name: +Originator(s): peverwhee +Date: +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 VMRs, 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: + +derecho/intel/aux_cam: + +izumi/nag/aux_cam: + +izumi/gnu/aux_cam: + +Summarize any changes to answers: No answer changes except midpoint time, +date, datesec for accumulated files/fields + +=============================================================== + Tag name: cam6_3_139 Originator(s): fvitt, tilmes Date: 1 Dec 2023 From 6c59437f1c5290c55ff545a96e132cb301f622cd Mon Sep 17 00:00:00 2001 From: Courtney Peverley Date: Wed, 6 Dec 2023 17:34:27 -0700 Subject: [PATCH 28/28] updated changelog --- doc/ChangeLog | 205 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 201 insertions(+), 4 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index d06b920813..8395fd0031 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,8 +1,8 @@ =============================================================== -Tag name: +Tag name: cam6_3_140 Originator(s): peverwhee -Date: +Date: 6 December 2023 One-line Summary: Separate history tapes into hXi and hXa Github PR URL: https://github.com/ESCOMP/CAM/pull/903 @@ -41,7 +41,7 @@ M src/control/cam_history.F90 are always written) and 'time', 'date', and 'datesec' fields are the end time - instantaneous file is always generated (with, at minimum, those - scalars like VMRs, current timestep, etc + 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 @@ -66,15 +66,212 @@ 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/fields +date, datesec for accumulated files ===============================================================