Skip to content

add statediagnose feature #31

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

Merged
DeniseWorthen merged 7 commits into from
Aug 6, 2020
Merged

add statediagnose feature #31

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
379831a
add state_diagnose to mom cap
DeniseWorthen Aug 1, 2020
03307a1
set restartfile for non-cesm
DeniseWorthen Aug 2, 2020
4d420c5
move clock prints inside do_advance
DeniseWorthen Aug 2, 2020
7ed5a90
move log messages and add mesh get in state diagnose
DeniseWorthen Aug 2, 2020
4f0c67f
more print fixing
DeniseWorthen Aug 2, 2020
ada747b
add ability to read debug flag from nems.configure
DeniseWorthen Aug 6, 2020
065f1d5
move text to match current develop branch
DeniseWorthen Aug 6, 2020
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
35 changes: 29 additions & 6 deletions config_src/nuopc_driver/mom_cap.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ module MOM_cap_mod
use time_manager_mod, only: fms_get_calendar_type => get_calendar_type
use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here
use MOM_file_parser, only: get_param, log_version, param_file_type, close_param_file
use MOM_get_input, only: Get_MOM_Input, directories
use MOM_get_input, only: get_MOM_input, directories
use MOM_domains, only: pass_var
use MOM_error_handler, only: MOM_error, FATAL, is_root_pe
use MOM_ocean_model_nuopc, only: ice_ocean_boundary_type
Expand All @@ -36,7 +36,7 @@ module MOM_cap_mod
use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end
use MOM_ocean_model_nuopc, only: get_ocean_grid, get_eps_omesh
use MOM_cap_time, only: AlarmInit
use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype
use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, state_diagnose
#ifdef CESMCOUPLED
use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit
#endif
Expand Down Expand Up @@ -124,7 +124,7 @@ module MOM_cap_mod
integer :: fldsFrOcn_num = 0
type (fld_list_type) :: fldsFrOcn(fldsMax)

integer :: debug = 0
integer :: dbug = 0
integer :: import_slice = 1
integer :: export_slice = 1
character(len=256) :: tmpstr
Expand Down Expand Up @@ -273,6 +273,14 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc)
write(logmsg,*) grid_attach_area
call ESMF_LogWrite('MOM_cap:GridAttachArea = '//trim(logmsg), ESMF_LOGMSG_INFO)

call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=value, isPresent=isPresent, isSet=isSet, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
if (isPresent .and. isSet) then
read(value,*) dbug
end if
write(logmsg,'(i6)') dbug
call ESMF_LogWrite('MOM_cap:dbug = '//trim(logmsg), ESMF_LOGMSG_INFO)

scalar_field_name = ""
call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=value, &
isPresent=isPresent, isSet=isSet, rc=rc)
Expand Down Expand Up @@ -358,6 +366,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
type(ice_ocean_boundary_type), pointer :: Ice_ocean_boundary => NULL()
type(ocean_internalstate_wrapper) :: ocean_internalstate
type(ocean_grid_type), pointer :: ocean_grid => NULL()
type(directories) :: dirs
type(time_type) :: Run_len !< length of experiment
type(time_type) :: time0 !< Start time of coupled model's calendar.
type(time_type) :: time_start !< The time at which to initialize the ocean model
Expand Down Expand Up @@ -520,8 +529,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)

restartfile = ""
if (runtype == "initial") then

restartfile = "n"
if (cesm_coupled) then
restartfile = "n"
else
call get_MOM_input(dirs=dirs)
restartfile = dirs%input_filename(1:1)
endif
call ESMF_LogWrite('MOM_cap:restartfile = '//trim(restartfile), ESMF_LOGMSG_INFO)

else if (runtype == "continue") then ! hybrid or branch or continuos runs

Expand Down Expand Up @@ -821,7 +835,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
allocate(xb(ntiles),xe(ntiles),yb(ntiles),ye(ntiles),pe(ntiles))
call mpp_get_compute_domains(ocean_public%domain, xbegin=xb, xend=xe, ybegin=yb, yend=ye)
call mpp_get_pelist(ocean_public%domain, pe)
if (debug > 0) then
if (dbug > 1) then
do n = 1,ntiles
write(tmpstr,'(a,6i6)') subname//' tiles ',n,pe(n),xb(n),xe(n),yb(n),ye(n)
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
Expand Down Expand Up @@ -1431,6 +1445,11 @@ subroutine ModelAdvance(gcomp, rc)
enddo
endif

if (dbug > 0) then
call state_diagnose(importState,subname//':IS ',rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if

!---------------
! Get ocean grid
!---------------
Expand Down Expand Up @@ -1459,6 +1478,10 @@ subroutine ModelAdvance(gcomp, rc)
call mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

if (dbug > 0) then
call state_diagnose(exportState,subname//':ES ',rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if
endif

!---------------
Expand Down
183 changes: 181 additions & 2 deletions config_src/nuopc_driver/mom_cap_methods.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,16 @@ module MOM_cap_methods
use ESMF, only: ESMF_TimeInterval, ESMF_TimeIntervalGet
use ESMF, only: ESMF_State, ESMF_StateGet
use ESMF, only: ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate
use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_Grid, ESMF_GridCreate
use ESMF, only: ESMF_GridComp, ESMF_Mesh, ESMF_MeshGet, ESMF_Grid, ESMF_GridCreate
use ESMF, only: ESMF_DistGrid, ESMF_DistGridCreate
use ESMF, only: ESMF_KIND_R8, ESMF_SUCCESS, ESMF_LogFoundError
use ESMF, only: ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO, ESMF_LOGWRITE
use ESMF, only: ESMF_LogSetError, ESMF_RC_MEM_ALLOCATE
use ESMF, only: ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND
use ESMF, only: ESMF_GEOMTYPE_FLAG, ESMF_GEOMTYPE_GRID, ESMF_GEOMTYPE_MESH
use ESMF, only: ESMF_RC_VAL_OUTOFRANGE, ESMF_INDEX_DELOCAL, ESMF_MESHLOC_ELEMENT
use ESMF, only: ESMF_TYPEKIND_R8
use ESMF, only: ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_COMPLETE
use ESMF, only: ESMF_FieldStatus_Flag, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR
use ESMF, only: operator(/=), operator(==)
use MOM_ocean_model_nuopc, only: ocean_public_type, ocean_state_type
use MOM_surface_forcing_nuopc, only: ice_ocean_boundary_type
Expand All @@ -28,6 +29,7 @@ module MOM_cap_methods
public :: mom_set_geomtype
public :: mom_import
public :: mom_export
public :: state_diagnose

private :: State_getImport
private :: State_setExport
Expand Down Expand Up @@ -763,6 +765,183 @@ subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid

end subroutine State_SetExport

subroutine state_diagnose(State, string, rc)

! ----------------------------------------------
! Diagnose status of State
! ----------------------------------------------

type(ESMF_State), intent(in) :: state
character(len=*), intent(in) :: string
integer , intent(out) :: rc

! local variables
integer :: i,j,n
type(ESMf_Field) :: lfield
integer :: fieldCount, lrank
character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:)
real(ESMF_KIND_R8), pointer :: dataPtr1d(:)
real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:)
character(len=*),parameter :: subname='(state_diagnose)'
character(len=ESMF_MAXSTR) :: msgString
! ----------------------------------------------

call ESMF_StateGet(state, itemCount=fieldCount, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
allocate(lfieldnamelist(fieldCount))

call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

do n = 1, fieldCount

call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (lrank == 0) then
! no local data
elseif (lrank == 1) then
if (size(dataPtr1d) > 0) then
write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), &
minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d)
else
write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data"
endif
elseif (lrank == 2) then
if (size(dataPtr2d) > 0) then
write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), &
minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d)
else
write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data"
endif
else
call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR)
rc = ESMF_FAILURE
return
endif
call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
enddo

deallocate(lfieldnamelist)

end subroutine state_diagnose

!===============================================================================

subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc)

! ----------------------------------------------
! for a field, determine rank and return fldptr1 or fldptr2
! abort is true by default and will abort if fldptr is not yet allocated in field
! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false
! ----------------------------------------------

! input/output variables
type(ESMF_Field) , intent(in) :: field
real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr1(:)
real(ESMF_KIND_R8), pointer , intent(inout), optional :: fldptr2(:,:)
integer , intent(out) , optional :: rank
logical , intent(in) , optional :: abort
integer , intent(out) , optional :: rc

! local variables
type(ESMF_GeomType_Flag) :: geomtype
type(ESMF_FieldStatus_Flag) :: status
type(ESMF_Mesh) :: lmesh
integer :: lrank, nnodes, nelements
logical :: labort
character(len=*), parameter :: subname='(field_getfldptr)'
! ----------------------------------------------

if (.not.present(rc)) then
call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", &
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif

rc = ESMF_SUCCESS

labort = .true.
if (present(abort)) then
labort = abort
endif
lrank = -99

call ESMF_FieldGet(field, status=status, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (status /= ESMF_FIELDSTATUS_COMPLETE) then
lrank = 0
if (labort) then
call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc)
rc = ESMF_FAILURE
return
else
call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc)
endif
else

call ESMF_FieldGet(field, geomtype=geomtype, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return

if (geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(field, rank=lrank, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
elseif (geomtype == ESMF_GEOMTYPE_MESH) then
call ESMF_FieldGet(field, rank=lrank, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_FieldGet(field, mesh=lmesh, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
if (nnodes == 0 .and. nelements == 0) lrank = 0
else
call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", &
ESMF_LOGMSG_INFO, rc=rc)
rc = ESMF_FAILURE
return
endif ! geomtype

if (lrank == 0) then
call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", &
ESMF_LOGMSG_INFO)
elseif (lrank == 1) then
if (.not.present(fldptr1)) then
call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", &
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
elseif (lrank == 2) then
if (.not.present(fldptr2)) then
call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", &
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif
call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc)
if (chkerr(rc,__LINE__,u_FILE_u)) return
else
call ESMF_LogWrite(trim(subname)//": ERROR in rank ", &
ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u)
rc = ESMF_FAILURE
return
endif

endif ! status

if (present(rank)) then
rank = lrank
endif

end subroutine field_getfldptr

logical function chkerr(rc, line, file)
integer, intent(in) :: rc
integer, intent(in) :: line
Expand Down