Skip to content

Commit

Permalink
Merge remote-tracking branch 'upstream/dev/emc' into dev/emc
Browse files Browse the repository at this point in the history
  • Loading branch information
@DeniseWorthen
DeniseWorthen committed Aug 6, 2020
2 parents 40bfb4b + 7e1188c commit e4ca1dc
Show file tree
Hide file tree
Showing 2 changed files with 210 additions and 8 deletions.
35 changes: 29 additions & 6 deletions config_src/nuopc_driver/mom_cap.F90
View file
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
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

0 comments on commit e4ca1dc

Please sign in to comment.