Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Optional tiled history files for ATM #257

Merged
merged 4 commits into from
Nov 23, 2021
Merged
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
67 changes: 51 additions & 16 deletions mediator/med_io_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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) '
!-------------------------------------------------------------------------------
Expand All @@ -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
Expand Down Expand Up @@ -900,15 +906,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
Expand All @@ -918,6 +936,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
Expand All @@ -927,8 +957,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
Expand Down Expand Up @@ -1034,8 +1065,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
Expand Down Expand Up @@ -1356,7 +1391,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
Expand Down Expand Up @@ -1913,7 +1948,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) '
!-------------------------------------------------------------------------------

Expand Down
38 changes: 30 additions & 8 deletions mediator/med_phases_history_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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'

Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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'

Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down