From e0aa6ba379091f2c52ca829cb1a976d40f658924 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 18 Nov 2021 10:15:44 -0500 Subject: [PATCH 1/4] introduce optional atm history files on tiles * for inst and avg atm history files, allow the fields to be written on cubed sphere tiles instead of mesh --- mediator/med_io_mod.F90 | 66 ++++++++++++++++++++++------- mediator/med_phases_history_mod.F90 | 40 +++++++++++++---- 2 files changed, 81 insertions(+), 25 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index dd65622e4..9e6b06431 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -746,13 +746,13 @@ end function med_io_sec2hms !=============================================================================== subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, rc) + fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) !--------------- ! Write FB to netcdf file !--------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet @@ -775,6 +775,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double integer, optional , intent(in) :: file_ind + integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc ! local variables @@ -789,6 +790,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer :: ndims, nelements integer ,target :: dimid2(2) integer ,target :: dimid3(3) + integer ,target :: dimid4(4) integer ,pointer :: dimid(:) type(var_desc_t) :: varid type(io_desc_t) :: iodesc @@ -817,6 +819,8 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields logical :: isPresent + logical :: atmtiles + integer :: ntiles = 1 character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- @@ -831,6 +835,8 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(use_float)) luse_float = use_float lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. + if (present(tilesize) .and. tilesize > 0) atmtiles = .true. ! Error check if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then @@ -900,15 +906,28 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! all the global grid values in the distgrid - e.g. CTSM ng = maxval(maxIndexPTile) - lnx = ng - lny = 1 + if (atmtiles) then + lnx = tilesize + lny = tilesize + ntiles = ng/(lnx*lny) + write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (ntiles /= 6) then + write(tmpstr,*) subname,' ERROR: only cubed sphere atm tiles valid ' + call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + else + lnx = ng + lny = 1 + if (nx > 0) lnx = nx + if (ny > 0) lny = ny + if (lnx*lny /= ng) then + write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + endif + end if deallocate(minIndexPTile, maxIndexPTile) - if (nx > 0) lnx = nx - if (ny > 0) lny = ny - if (lnx*lny /= ng) then - write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - endif if (present(nt)) then frame = nt @@ -918,6 +937,18 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then + if (atmtiles) then + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + if (present(nt)) then + dimid4(1:3) = dimid3 + rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + dimid => dimid4 + else + dimid => dimid3 + endif + else rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then @@ -927,8 +958,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & else dimid => dimid2 endif - write(tmpstr,*) subname,' dimid = ',dimid - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + endif do k = 1,nf ! Determine field name @@ -1034,8 +1064,12 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + if (atmtiles) then + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc) + else + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + end if deallocate(dof) do k = 1,nf @@ -1356,7 +1390,7 @@ end subroutine med_io_write_char !=============================================================================== subroutine med_io_define_time(time_units, calendar, file_ind, rc) - use ESMF, only : operator(==), operator(/=) + use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated use ESMF, only : ESMF_CALKIND_360DAY, ESMF_CALKIND_GREGORIAN use ESMF, only : ESMF_CALKIND_JULIAN, ESMF_CALKIND_JULIANDAY, ESMF_CALKIND_MODJULIANDAY @@ -1913,7 +1947,7 @@ subroutine med_io_read_r81d(filename, vm, rdata, dname, rc) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 - integer :: iam + integer :: iam character(*),parameter :: subName = '(med_io_read_r81d) ' !------------------------------------------------------------------------------- diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index d90d2c7f9..7d060515d 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -619,7 +619,7 @@ end subroutine med_phases_history_write_lnd2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) - ! Write mediator history file for atm variables + ! Write mediator history file for compid variables ! input/output variables type(ESMF_GridComp), intent(inout) :: gcomp @@ -658,6 +658,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in + integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm @@ -680,10 +681,20 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine if tiled output to history file is requested + call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_tilesize + else + hist_tilesize = 0 + end if ! alarm is not set determine hist_option and hist_n if (.not. instfile%is_clockset) then - ! Determine attribute prefix + ! Determine attribute name write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_inst' write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_inst' @@ -753,19 +764,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre='Med_frac_'//trim(compname(compid)), rc=rc) + nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -805,6 +816,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in + integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm @@ -829,10 +841,20 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Determine if tiled output to history file is requested + call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hist_tilesize + else + hist_tilesize = 0 + end if ! alarm is not set determine hist_option and hist_n if (.not. avgfile%is_clockset) then - ! Determine attribute prefix + ! Determine attribute name write(hist_option_in,'(a)') 'history_option_'//trim(compname(compid))//'_avg' write(hist_n_in,'(a)') 'history_n_'//trim(compname(compid))//'_avg' @@ -948,7 +970,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) @@ -957,7 +979,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) @@ -1053,7 +1075,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (isPresent .and. isSet) then call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,'(l7)') enable_auxfile + read(cvalue,'(l)') enable_auxfile else enable_auxfile = .false. end if From 65a0652d88641192086d01999e621e155cf85587 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 18 Nov 2021 09:00:32 -0700 Subject: [PATCH 2/4] tidy up * revert two unintended changes --- mediator/med_io_mod.F90 | 2 ++ mediator/med_phases_history_mod.F90 | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9e6b06431..c501f8c1f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -959,6 +959,8 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & dimid => dimid2 endif endif + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf ! Determine field name diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7d060515d..5bf3c3a53 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -658,7 +658,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize + integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm @@ -1075,7 +1075,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (isPresent .and. isSet) then call NUOPC_CompAttributeGet(gcomp, name=trim(prefix)//'_enabled', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,'(l)') enable_auxfile + read(cvalue,'(l7)') enable_auxfile else enable_auxfile = .false. end if From 77b92373aef5791c26302fc8eff857179828017e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 18 Nov 2021 12:05:02 -0700 Subject: [PATCH 3/4] remove unnecessary message line --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index c501f8c1f..13482d22a 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -913,7 +913,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (ntiles /= 6) then - write(tmpstr,*) subname,' ERROR: only cubed sphere atm tiles valid ' call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif From a98c0e4284c3d9bc6ea3e247d8da22d4f7a3aca1 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 20 Nov 2021 04:34:03 -0700 Subject: [PATCH 4/4] fix debug GNU fault --- mediator/med_io_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 13482d22a..90fb0eb3f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -836,7 +836,9 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind atmtiles = .false. - if (present(tilesize) .and. tilesize > 0) atmtiles = .true. + if (present(tilesize)) then + if (tilesize > 0) atmtiles = .true. + end if ! Error check if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then