Skip to content

fix dof3d creation for unstructured grid with multiple levels and other cleanup refactoring #367

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.

Sign up for GitHub

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

Closed
mvertens wants to merge 19 commits into from
Closed

fix dof3d creation for unstructured grid with multiple levels and other cleanup refactoring #367

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
19 commits
Select commit Hold shift + click to select a range
a717ad6
bugfix for handling unstructured input data with multiple levels
mvertens Dec 18, 2025
bb392dd
fixed additional problem in creating an iodesc for unstructured data …
mvertens Dec 20, 2025
80e1f8d
added rc return code to all shr_log_error calls
mvertens Dec 21, 2025
d476c03
fix compiler problem
mvertens Dec 22, 2025
ccca77f
cleaned up logunit and mainproc references
mvertens Dec 22, 2025
f7d77f9
refactored stdout formatting and calls
mvertens Dec 23, 2025
69ca579
refactored shr_strdata_get_stream_pointer_1d and shr_strdata_get_stre…
mvertens Dec 23, 2025
bc34f04
fixed compiler issue
mvertens Dec 24, 2025
36bce68
preset state pointer fields to nans
mvertens Dec 24, 2025
bdd4317
fix for drof to account for present values of nans for stream and exp…
mvertens Dec 24, 2025
354b57c
refactor dlnd to fix aborts to due presence of NaN's with new default…
mvertens Dec 25, 2025
0693214
addressed issues in PR review
mvertens Dec 29, 2025
e49446e
udpates to back out module variable settings of mainproc and logunit
mvertens Dec 30, 2025
f387187
reintroduced rc=rcode before calls to shr_log_error for pio errors
mvertens Dec 30, 2025
edd2176
more reformatting of output data
mvertens Dec 30, 2025
b6ffcbb
determine time dimname for multi-level dof3d calculation
mvertens Dec 30, 2025
12b2a86
addressed more issues raised in PR
mvertens Dec 31, 2025
4e56bf5
removed istat check for allocate on maintask
mvertens Dec 31, 2025
ea91ddb
Merge pull request #26 from mvertens/feature/fix_unstructured_multile…
mvertens Dec 31, 2025
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
6 changes: 0 additions & 6 deletions datm/datm_datamode_cplhist_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,8 +24,6 @@ module datm_datamode_cplhist_mod
real(r8), pointer :: Sa_tbot(:) => null()
real(r8), pointer :: Sa_ptem(:) => null()
real(r8), pointer :: Sa_shum(:) => null()
! TODO: water isotope support
! real(r8), pointer :: Sa_shum_wiso(:,:) => null() ! water isotopes
real(r8), pointer :: Sa_dens(:) => null()
real(r8), pointer :: Sa_pbot(:) => null()
real(r8), pointer :: Sa_pslv(:) => null()
Expand All @@ -38,7 +36,6 @@ module datm_datamode_cplhist_mod
real(r8), pointer :: Faxa_swndf(:) => null()
real(r8), pointer :: Faxa_swvdr(:) => null()
real(r8), pointer :: Faxa_swvdf(:) => null()
real(r8), pointer :: Faxa_swnet(:) => null()
real(r8), pointer :: Faxa_ndep(:,:) => null()

character(*), parameter :: nullstr = 'null'
Expand Down Expand Up @@ -87,7 +84,6 @@ subroutine datm_datamode_cplhist_advertise(exportState, fldsexport, flds_scalar_
call dshr_fldList_add(fldsExport, 'Faxa_swvdr' )
call dshr_fldList_add(fldsExport, 'Faxa_swndf' )
call dshr_fldList_add(fldsExport, 'Faxa_swvdf' )
call dshr_fldList_add(fldsExport, 'Faxa_swnet' )
call dshr_fldList_add(fldsExport, 'Faxa_lwdn' )
call dshr_fldList_add(fldsExport, 'Faxa_swdn' )
if (flds_co2) then
Expand Down Expand Up @@ -172,8 +168,6 @@ subroutine datm_datamode_cplhist_init_pointers(importState, exportState, sdat, r
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call dshr_state_getfldptr(exportState, 'Faxa_swndf' , fldptr1=Faxa_swndf , rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call dshr_state_getfldptr(exportState, 'Faxa_swnet' , fldptr1=Faxa_swnet , rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call dshr_state_getfldptr(exportState, 'Faxa_lwdn' , fldptr1=Faxa_lwdn , rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

Expand Down
160 changes: 84 additions & 76 deletions dlnd/dlnd_datamode_glc_forcing_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,11 @@ module dlnd_datamode_glc_forcing_mod
use ESMF , only : ESMF_StateItem_Flag, ESMF_GridComp
use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise
use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs
use shr_log_mod , only : shr_log_error
use shr_const_mod , only : SHR_CONST_SPVAL
use dshr_methods_mod , only : dshr_state_getfldptr, chkerr
use dshr_strdata_mod , only : shr_strdata_type
use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_get_stream_pointer
use dshr_fldlist_mod , only : fldlist_type, dshr_fldlist_add
use dshr_dfield_mod , only : dfield_type, dshr_dfield_add
use glc_elevclass_mod, only : glc_elevclass_as_string, glc_elevclass_init

implicit none
Expand All @@ -17,8 +18,19 @@ module dlnd_datamode_glc_forcing_mod
public :: dlnd_datamode_glc_forcing_init_pointers
public :: dlnd_datamode_glc_forcing_advance

! module pointer arrays
real(r8), pointer :: lfrac(:)
! export state pointer
real(r8), pointer :: lfrac(:) => null()
real(r8), pointer :: Sl_tsrf_elev(:,:) => null()
real(r8), pointer :: Sl_topo_elev(:,:) => null()
real(r8), pointer :: Flgl_qice_elev(:,:) => null()

! stream pointers (1d)
type, public :: stream_pointer_type
real(r8), pointer :: strm_ptr(:) => null()
end type stream_pointer_type
type(stream_pointer_type), allocatable :: strm_Sl_tsrf_elev(:)
type(stream_pointer_type), allocatable :: strm_Sl_topo_elev(:)
type(stream_pointer_type), allocatable :: strm_Flgl_qice_elev(:)

integer :: glc_nec

Expand All @@ -30,7 +42,8 @@ module dlnd_datamode_glc_forcing_mod
contains
!===============================================================================

subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, flds_scalar_name, logunit, mainproc, rc)
subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, flds_scalar_name, &
logunit, mainproc, rc)

! determine export state to advertise to mediator

Expand Down Expand Up @@ -86,24 +99,20 @@ subroutine dlnd_datamode_glc_forcing_advertise(gcomp, exportState, fldsExport, f
end subroutine dlnd_datamode_glc_forcing_advertise

!===============================================================================
subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, model_frac, datamode, logunit, mainproc, rc)
subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, model_frac, datamode, rc)

! input/output variables
type(ESMF_State) , intent(inout) :: exportState
type(shr_strdata_type), intent(in) :: sdat
type(dfield_type) , pointer :: dfields
real(r8) , intent(in) :: model_frac(:)
character(len=*) , intent(in) :: datamode
integer , intent(in) :: logunit
logical , intent(in) :: mainproc
integer , intent(out) :: rc

! local variables
integer :: n
character(len=2) :: nec_str
character(CS), allocatable :: strm_flds_topo(:)
character(CS), allocatable :: strm_flds_tsrf(:)
character(CS), allocatable :: strm_flds_qice(:)
integer :: ng
character(len=2) :: nec_str
character(CS) :: strm_fld
integer :: istat
character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_init_pointers): '
!-------------------------------------------------------------------------------

Expand All @@ -113,85 +122,84 @@ subroutine dlnd_datamode_glc_forcing_init_pointers(exportState, sdat, dfields, m
call dshr_state_getfldptr(exportState, fldname='Sl_lfrin', fldptr1=lfrac, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
lfrac(:) = model_frac(:)
call dshr_state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2=Sl_tsrf_elev, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call dshr_state_getfldptr(exportState, 'Sl_topo_elev', fldptr2=Sl_topo_elev, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call dshr_state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2=Flgl_qice_elev, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

! Create stream-> export state mapping
! Note that strm_flds is the model name for the stream field
! Note that state_fld is the model name for the export field

if (trim(datamode) == 'glc_forcing_mct') then
allocate(strm_flds_tsrf(0:glc_nec))
allocate(strm_flds_topo(0:glc_nec))
allocate(strm_flds_qice(0:glc_nec))
do n = 0,glc_nec
write(nec_str, '(i2.2)') n
strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str)
strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str)
strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str)
end do

else if (trim(datamode) == 'glc_forcing' ) then
allocate(strm_flds_tsrf(1:glc_nec+1))
allocate(strm_flds_topo(1:glc_nec+1))
allocate(strm_flds_qice(1:glc_nec+1))
do n = 1,glc_nec+1
write(nec_str, '(i0)') n
strm_flds_tsrf(n) = 'Sl_tsrf_elev' // trim(nec_str)
strm_flds_topo(n) = 'Sl_topo_elev' // trim(nec_str)
strm_flds_qice(n) = 'Flgl_qice_elev' // trim(nec_str)
end do
! Obtain pointers to stream fields

allocate(strm_Sl_tsrf_elev(glc_nec+1), &
strm_Sl_topo_elev(glc_nec+1), &
strm_Flgl_qice_elev(glc_nec+1), stat=istat)
if ( istat /= 0 ) then
call shr_log_error(subName//&
': allocation error for strm_Sl_tsrf_elev, Strm_Sl_topo_elev and strm_Flgl_qice_elev',rc=rc)
return
end if

! The following maps stream input fields to export fields that have an ungridded dimension
call dshr_dfield_add(dfields, sdat, state_fld='Sl_tsrf_elev', strm_flds=strm_flds_tsrf, state=exportState, &
logunit=logunit, mainproc=mainproc, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call dshr_dfield_add(dfields, sdat, state_fld='Sl_topo_elev', strm_flds=strm_flds_topo, state=exportState, &
logunit=logunit, mainproc=mainproc, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
call dshr_dfield_add(dfields, sdat, state_fld='Flgl_qice_elev', strm_flds=strm_flds_qice, state=exportState, &
logunit=logunit, mainproc=mainproc, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
do ng = 1,glc_nec+1
if (trim(datamode) == 'glc_forcing_mct') then
write(nec_str,'(i2.2)') ng-1
else
write(nec_str,'(i0)') ng
end if
strm_fld = 'Sl_tsrf_elev'//trim(nec_str)
call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_tsrf_elev(ng)%strm_ptr, requirePointer=.true., &
errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

deallocate(strm_flds_tsrf)
deallocate(strm_flds_topo)
deallocate(strm_flds_qice)
strm_fld = 'Sl_topo_elev'//trim(nec_str)
call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Sl_topo_elev(ng)%strm_ptr, requirePointer=.true., &
errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

strm_fld = 'Flgl_qice_elev'//trim(nec_str)
call shr_strdata_get_stream_pointer( sdat, trim(strm_fld), strm_Flgl_qice_elev(ng)%strm_ptr, requirePointer=.true., &
errmsg=trim(subname)//'ERROR: '//trim(strm_fld)//' must be associated for dlnd glc_forcing datamode', rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end do

end subroutine dlnd_datamode_glc_forcing_init_pointers

!===============================================================================
subroutine dlnd_datamode_glc_forcing_advance(exportState, rc)

! input/output variables
type(ESMF_State) , intent(inout) :: exportState
integer , intent(out) :: rc
subroutine dlnd_datamode_glc_forcing_advance()

! local variables
integer :: n
real(r8), pointer :: fldptr2(:,:)
integer :: ni,ng
character(len=*), parameter :: subname='(dlnd_datamode_glc_forcing_advance): '
!-------------------------------------------------------------------------------

rc = ESMF_SUCCESS

! Set special value over masked points
call dshr_state_getfldptr(exportState, 'Sl_tsrf_elev', fldptr2=fldptr2, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
do n = 1,size(fldptr2,dim=2)
if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8
end do
! Note that the inner dimension is the elevation class

elev_class_loop: do ng = 1,glc_nec+1
do ni = 1,size(Sl_tsrf_elev,dim=2)
if (lfrac(ni) == 0._r8) then
Sl_tsrf_elev(ng,ni) = SHR_CONST_SPVAL
else
Sl_tsrf_elev(ng,ni) = strm_Sl_tsrf_elev(ng)%strm_ptr(ni)
end if
end do

call dshr_state_getfldptr(exportState, 'Sl_topo_elev', fldptr2=fldptr2, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
do n = 1,size(fldptr2,dim=2)
if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8
end do
do ni = 1,size(Sl_topo_elev,dim=2)
if (lfrac(ni) == 0._r8) then
Sl_topo_elev(ng,ni) = SHR_CONST_SPVAL
else
Sl_topo_elev(ng,ni) = strm_Sl_topo_elev(ng)%strm_ptr(ni)
end if
end do

call dshr_state_getfldptr(exportState, 'Flgl_qice_elev', fldptr2=fldptr2, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
do n = 1,size(fldptr2,dim=2)
if (lfrac(n) == 0._r8) fldptr2(:,n) = 1.e30_r8
end do
do ni = 1,size(Flgl_qice_elev,dim=2)
if (lfrac(ni) == 0._r8) then
Flgl_qice_elev(ng,ni) = SHR_CONST_SPVAL
else
Flgl_qice_elev(ng,ni) = strm_Flgl_qice_elev(ng)%strm_ptr(ni)
end if
end do
end do elev_class_loop

end subroutine dlnd_datamode_glc_forcing_advance

Expand Down
Loading