diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index dd65622e4..90fb0eb3f 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,10 @@ 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)) then + if (tilesize > 0) atmtiles = .true. + end if ! Error check if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then @@ -900,15 +908,27 @@ 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 + 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 +938,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 +959,9 @@ 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 + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf ! Determine field name @@ -1034,8 +1067,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 +1393,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 +1950,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..5bf3c3a53 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)