From cd42232cac80286f9a7cbac7b4200836ca3c14c3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 29 Nov 2018 16:51:15 -0700 Subject: [PATCH 1/8] removing mpicom from nuopc code --- .../xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 | 44 +- .../xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 | 60 +- .../xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 | 42 +- .../xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 | 57 +- .../xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 | 39 +- .../xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 | 57 +- .../xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 | 51 +- src/drivers/nuopc/mediator/med_io_mod.F90 | 214 +++-- .../nuopc/mediator/med_phases_ocnalb_mod.F90 | 76 +- src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 | 885 +----------------- .../nuopc/shr/shr_nuopc_methods_mod.F90 | 572 +++++------ 11 files changed, 607 insertions(+), 1490 deletions(-) diff --git a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 index f6939a9e633..7c6f19ea12b 100644 --- a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 @@ -56,14 +56,12 @@ module atm_comp_nuopc character(CXX) :: flds_x2a = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator - integer :: my_task ! my task in mpi communicator mpicom + integer :: my_task ! my task in mpi communicator integer :: inst_index ! number of current instance (ie. 1) character(len=12) :: inst_name ! fullname of current instance (ie. "lnd_0001") character(len=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number logical :: mastertask - integer :: dbrc logical :: atm_prognostic !----- formats ----- @@ -81,7 +79,8 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -113,7 +112,8 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -130,7 +130,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -145,19 +144,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task==0 !---------------------------------------------------------------------------- ! determine instance information @@ -279,7 +273,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeAdvertise @@ -303,7 +297,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -318,7 +312,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -360,11 +354,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -375,7 +369,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -408,7 +402,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -432,7 +426,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -484,7 +478,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & - mpicom, flds_scalar_name, flds_scalar_num, rc) + flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -502,7 +496,7 @@ subroutine ModelAdvance(gcomp, rc) if(mastertask) then call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) endif - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -521,11 +515,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('atm', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index 9b87d0a03e0..183ee569a8e 100644 --- a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -30,7 +30,6 @@ module glc_comp_nuopc use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type use dead_nuopc_mod , only : state_getimport, state_setexport use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo - implicit none private ! except @@ -54,7 +53,6 @@ module glc_comp_nuopc character(CXX) :: flds_x2g = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "glc_0001") @@ -64,7 +62,6 @@ module glc_comp_nuopc logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh integer, parameter :: dbug = 10 - integer :: dbrc character(*),parameter :: modName = "(xglc_comp_nuopc)" character(*),parameter :: u_FILE_u = __FILE__ @@ -78,42 +75,41 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & + userRoutine=InitializeAdvertise, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & + userRoutine=InitializeRealize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & - specRoutine=ModelAdvance, rc=rc) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & - specRoutine=ModelSetRunClock, rc=rc) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & - specRoutine=ModelFinalize, rc=rc) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -131,7 +127,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname character(CS) :: nec_str @@ -150,19 +145,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == master_task !---------------------------------------------------------------------------- @@ -200,7 +190,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) if (nxg /= 0 .and. nyg /= 0) then @@ -240,7 +230,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(x2d(FldsToGlc_num,lsize)); x2d(:,:) = 0._r8 end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -269,7 +259,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -284,7 +274,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -326,11 +316,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -363,7 +353,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -384,7 +374,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -450,7 +440,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -469,11 +459,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('glc', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 index 0d8d7401d82..7724c472b70 100644 --- a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 @@ -56,7 +56,6 @@ module ice_comp_nuopc character(CXX) :: flds_x2i = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "ice_0001") @@ -65,7 +64,6 @@ module ice_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer :: dbrc character(*),parameter :: modName = "(xice_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -73,14 +71,14 @@ module ice_comp_nuopc !=============================================================================== contains !=============================================================================== - subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -106,19 +104,19 @@ subroutine SetServices(gcomp, rc) call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices - !=============================================================================== + !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -130,7 +128,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -145,19 +142,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == master_task !---------------------------------------------------------------------------- @@ -276,7 +268,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -305,7 +297,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -320,7 +312,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -362,11 +354,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -399,7 +391,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -420,7 +412,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -485,7 +477,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -504,11 +496,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('ice', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 index 15a2f4281a5..12cf57d18a3 100644 --- a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 @@ -56,7 +56,6 @@ module lnd_comp_nuopc character(CXX) :: flds_x2l = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") @@ -65,22 +64,21 @@ module lnd_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer :: dbrc character(*),parameter :: modName = "(xlnd_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains -!=============================================================================== - + !=============================================================================== subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -92,12 +90,12 @@ subroutine SetServices(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p1"/), userRoutine=InitializeAdvertise, rc=rc) + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & + userRoutine=InitializeAdvertise, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv01p3"/), userRoutine=InitializeRealize, rc=rc) + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & + userRoutine=InitializeRealize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) @@ -112,12 +110,11 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -129,7 +126,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -144,19 +140,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == master_task !---------------------------------------------------------------------------- @@ -170,7 +161,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) !---------------------------------------------------------------------------- ! Initialize xlnd @@ -305,7 +296,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -320,7 +311,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -362,11 +353,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -375,7 +366,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then + if (mastertask) then call Print_FieldExchInfo(values=d2x, logunit=logunit, & fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="InitializeRealize: lnd->mediator") end if @@ -399,7 +390,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -420,7 +411,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -473,21 +464,21 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then + if (mastertask) then call Print_FieldExchInfo(values=d2x, logunit=logunit, & fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="ModelAdvance: lnd->mediator") end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - if(my_task == master_task) then + if(mastertask) then call shr_nuopc_log_clock_advance(clock, 'LND', logunit) endif call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -506,11 +497,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('lnd', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 index 7a9c109632f..7406eb0ae36 100644 --- a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 @@ -55,7 +55,6 @@ module ocn_comp_nuopc character(CXX) :: flds_x2o = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "ocn_0001") @@ -64,21 +63,20 @@ module ocn_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer :: dbrc character(*),parameter :: modName = "(xocn_comp_nuopc)" character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains -!=============================================================================== - + !=============================================================================== subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -99,20 +97,19 @@ subroutine SetServices(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -129,7 +126,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -144,7 +140,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -153,10 +149,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == master_task !---------------------------------------------------------------------------- @@ -242,7 +237,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(x2d(FldsToOcn_num,lsize)); x2d(:,:) = 0._r8 end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -271,7 +266,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -286,7 +281,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -328,11 +323,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -365,7 +360,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -386,7 +381,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -452,7 +447,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -471,11 +466,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('ocn', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 index a6c879e695a..3289be047e5 100644 --- a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 @@ -55,8 +55,7 @@ module rof_comp_nuopc character(CXX) :: flds_x2r = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator - integer :: my_task ! my task in mpi communicator mpicom + integer :: my_task ! my task in mpi integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "rof_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") @@ -64,7 +63,6 @@ module rof_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer :: dbrc character(*),parameter :: modName = "(xrof_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -72,21 +70,21 @@ module rof_comp_nuopc !=============================================================================== contains !=============================================================================== - subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -100,25 +98,22 @@ subroutine SetServices(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices - - !=============================================================================== - +!=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -129,7 +124,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -144,19 +138,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == master_task !---------------------------------------------------------------------------- @@ -170,7 +159,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) !---------------------------------------------------------------------------- ! Initialize xrof @@ -226,7 +215,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(x2d(FldsToRof_num,lsize)); x2d(:,:) = 0._r8 end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -255,7 +244,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -270,7 +259,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -312,11 +301,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -325,7 +314,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then + if (mastertask) then call Print_FieldExchInfo(values=d2x, logunit=logunit, & fldlist=fldsFrRof, nflds=fldsFrRof_num, istr="InitializeRealize: rof->mediator") end if @@ -349,7 +338,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -370,7 +359,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -421,21 +410,21 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then + if (mastertask) then call Print_FieldExchInfo(values=d2x, logunit=logunit, & fldlist=fldsFrRof, nflds=fldsFrRof_num, istr="ModelAdvance: rof->mediator") end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - if(my_task == master_task) then + if(mastertask) then call shr_nuopc_log_clock_advance(clock, 'ROF', logunit) endif call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -454,11 +443,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('rof', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 index b0cbe9cfdf4..888279f2969 100644 --- a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 @@ -54,7 +54,6 @@ module wav_comp_nuopc character(CXX) :: flds_x2w = '' integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "wav_0001") @@ -63,22 +62,21 @@ module wav_comp_nuopc integer, parameter :: master_task = 0 logical :: mastertask character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer :: dbrc character(*),parameter :: modName = "(xwav_comp_nuopc)" character(*),parameter :: u_FILE_u = __FILE__ integer, parameter :: dbug = 10 !=============================================================================== contains -!=============================================================================== - + !=============================================================================== subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -99,23 +97,23 @@ subroutine SetServices(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices + !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) @@ -128,7 +126,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom character(CL) :: cvalue character(CS) :: stdname integer :: n @@ -143,20 +140,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - endif - !---------------------------------------------------------------------------- - ! generate local mpi comm - !---------------------------------------------------------------------------- + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) + call ESMF_VMGet(vm, localpet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) mastertask = my_task == 0 !---------------------------------------------------------------------------- @@ -226,8 +218,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(x2d(FldsToWav_num,lsize)); x2d(:,:) = 0._r8 end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) - + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- @@ -256,9 +248,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + !---------------------------------------------------------------------------- ! Reset shr logging to my log file !---------------------------------------------------------------------------- @@ -273,7 +264,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, mpicom, gindex, lon, lat, Emesh, rc) + call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return !-------------------------------- @@ -315,11 +306,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if end do - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -352,7 +343,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine InitializeRealize @@ -373,7 +364,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_getLogLevel(shrloglev) @@ -438,7 +429,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelAdvance @@ -457,11 +448,11 @@ subroutine ModelFinalize(gcomp, rc) !-------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call dead_final_nuopc('wav', logunit) - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end subroutine ModelFinalize diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index 5c88ff636cb..e07128d2c09 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -2,9 +2,10 @@ module med_io_mod ! !DESCRIPTION: Writes attribute vectors to netcdf ! !USES: + use ESMF, only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VM use med_constants_mod , only : CL use pio, only : file_desc_t, iosystem_desc_t - + use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr implicit none private @@ -59,6 +60,19 @@ module med_io_mod !================================================================================= contains !================================================================================= + subroutine broadcast_logical(vm, exists) + use ESMF, only : ESMF_VM, ESMF_VMBroadCast + type(ESMF_VM) :: vm + logical, intent(inout) :: exists + integer :: tmp(1) + integer :: rc + + if (exists) tmp(1) = 1 + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if(tmp(1) == 1) exists = .true. + + end subroutine broadcast_logical subroutine med_io_init() use seq_comm_mct , only : CPLID @@ -70,9 +84,8 @@ subroutine med_io_init() end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, mpicom, iam, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, clobber, file_ind, model_doi_url) ! !DESCRIPTION: open netcdf file - use shr_mpi_mod, only : shr_mpi_bcast use pio, only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR use pio, only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef, pio_put_att, pio_redef, pio_get_att use pio, only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber @@ -80,22 +93,28 @@ subroutine med_io_wopen(filename, mpicom, iam, clobber, file_ind, model_doi_url) use med_internalstate_mod, only : logunit ! input/output arguments character(*), intent(in) :: filename - integer, intent(in) :: mpicom - integer, intent(in) :: iam logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url ! local variables + type(ESMF_VM) :: vm logical :: exists logical :: lclobber + integer :: tmp(1) integer :: rcode integer :: nmode integer :: lfile_ind + integer :: rc + integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url character(*),parameter :: subName = '(med_io_wopen) ' !------------------------------------------------------------------------------- + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lversion=trim(version) @@ -112,10 +131,8 @@ subroutine med_io_wopen(filename, mpicom, iam, clobber, file_ind, model_doi_url) ! filename not open wfilename = filename - if (iam==0) then - inquire(file=trim(filename),exist=exists) - end if - call shr_mpi_bcast(exists, mpicom, 'med_io_wopen exists') + if (iam==0) inquire(file=trim(filename),exist=exists) + call broadcast_logical(vm, exists) if (exists) then if (lclobber) then @@ -291,7 +308,6 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getNameN - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr use shr_nuopc_fldList_mod , only : shr_nuopc_fldList_GetMetadata use pio, only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double use pio, only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp @@ -346,7 +362,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & !------------------------------------------------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) endif rc = ESMF_Success @@ -361,9 +377,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & endif if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) endif rc = ESMF_Success return @@ -377,7 +393,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (.not.lwhead .and. .not.lwdata) then ! should we write a warning? if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) endif return endif @@ -390,34 +406,34 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) endif rc = ESMF_Success return endif call shr_nuopc_methods_FB_getFieldN(FB, 1, field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, mesh=mesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ! TODO: this is not getting the global size correct for a FB coming in that does not have ! all the global grid values in the distgrid - e.g. CTSM @@ -439,7 +455,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & endif if (lnx*lny /= ng) then write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) !TODO: this should not be an error for say CTSM which does not send a global grid !rc = ESMF_FAILURE @@ -459,17 +475,17 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & endif write(tmpstr,*) subname,' tcx dimid = ',dimid - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !-------tcraig, this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then name1 = trim(lpre)//'_'//trim(itemc) call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) - call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO, rc=rc) if (luse_float) then rcode = pio_def_var(io_file(lfile_ind),trim(name1),PIO_REAL,dimid,varid) rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",real(lfillvalue,r4)) @@ -494,19 +510,19 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (lwdata) then ! use distgrid extracted from field 1 above call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(dof(ns)) 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, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) deallocate(dof) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !-------tcraig, this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then @@ -523,7 +539,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end if if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) endif end subroutine med_io_write_FB @@ -920,7 +936,7 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& end subroutine med_io_write_time !=============================================================================== - subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) + subroutine med_io_read_FB(filename, FB, pre, rc) use med_constants_mod, only : R8, CL use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid @@ -933,9 +949,8 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) use pio, only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid use pio, only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile use pio, only : pio_read_darray, pio_initdecomp - use shr_mpi_mod, only : shr_mpi_bcast + use med_constants_mod, only : dbug_flag=>med_constants_dbug_flag - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getNameN use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFieldN @@ -943,13 +958,12 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) ! !input/output arguments character(len=*) ,intent(in) :: filename ! file - integer ,intent(in) :: mpicom - integer ,intent(in) :: iam type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be written character(len=*),optional ,intent(in) :: pre ! prefix to variable name integer ,intent(out) :: rc ! local variables + type(ESMF_VM) :: vm type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid @@ -966,20 +980,25 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) integer :: lnx,lny real(r8) :: lfillvalue logical :: exists + integer :: tmp(1) integer, pointer :: minIndexPTile(:,:) integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) + integer :: iam real(r8), pointer :: fldptr1(:) character(CL) :: tmpstr - integer :: dbrc + character(*),parameter :: subName = '(med_io_read_FB) ' !------------------------------------------------------------------------------- - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif rc = ESMF_Success + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lpre = ' ' if (present(pre)) then @@ -987,46 +1006,52 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) endif if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif - rc = ESMF_Success return endif call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif - rc = ESMF_Success return endif - if (iam==0) inquire(file=trim(filename),exist=exists) - call shr_mpi_bcast(exists,mpicom,'med_io_read_fb exists') + call broadcast_logical(vm, exists) + if (exists) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) - call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) rc = ESMF_FAILURE return endif do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return name1 = trim(lpre)//'_'//trim(itemc) - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) rcode = pio_inq_varid(pioid,trim(name1),varid) if (rcode == pio_noerr) then @@ -1034,12 +1059,12 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) if (k == 1) then rcode = pio_inq_varndims(pioid, varid, ndims) write(tmpstr,*) trim(subname),' ndims = ',ndims,k - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) allocate(dimid(ndims)) rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) rcode = pio_inq_dimlen(pioid, dimid(1), lnx) write(tmpstr,*) trim(subname),' lnx = ',lnx - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ndims>=2) then rcode = pio_inq_dimlen(pioid, dimid(2), lny) else @@ -1047,28 +1072,28 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) end if deallocate(dimid) write(tmpstr,*) trim(subname),' lny = ',lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) ng = lnx * lny call shr_nuopc_methods_FB_getFieldN(FB, k, field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, mesh=mesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(minIndexPTile(dimCount, tileCount), & maxIndexPTile(dimCount, tileCount)) call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) if (ng > maxval(maxIndexPTile)) then write(tmpstr,*) subname,' ERROR: dimensions do not match', lnx, lny, maxval(maxIndexPTile) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) !TODO: this should not be an error for say CTSM which does not send a global grid !rc = ESMF_Failure @@ -1076,11 +1101,11 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) endif call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(dof(ns)) 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, rc=dbrc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) deallocate(dof) endif @@ -1104,20 +1129,18 @@ subroutine med_io_read_FB(filename, mpicom, iam, FB, pre, rc) call pio_closefile(pioid) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) endif end subroutine med_io_read_FB !=============================================================================== - subroutine med_io_read_int(filename, mpicom, iam, idata, dname) + subroutine med_io_read_int(filename, idata, dname) ! !DESCRIPTION: Read scalar integer from netcdf file ! input/output arguments character(len=*) , intent(in) :: filename ! file - integer , intent(in) :: mpicom - integer , intent(in) :: iam integer , intent(inout) :: idata ! integer data character(len=*) , intent(in) :: dname ! name of data @@ -1126,16 +1149,15 @@ subroutine med_io_read_int(filename, mpicom, iam, idata, dname) character(*),parameter :: subName = '(med_io_read_int) ' !------------------------------------------------------------------------------- - call med_io_read_int1d(filename, mpicom, iam, i1d, dname) + call med_io_read_int1d(filename, i1d, dname) idata = i1d(1) end subroutine med_io_read_int !=============================================================================== - subroutine med_io_read_int1d(filename, mpicom, iam, idata, dname) + subroutine med_io_read_int1d(filename, idata, dname) ! !DESCRIPTION: Read 1d integer array from netcdf file use shr_sys_mod, only : shr_sys_abort - use shr_mpi_mod, only : shr_mpi_bcast use med_constants_mod, only : R8 use pio, only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling use pio, only : pio_get_var, pio_inq_varid, pio_get_att, pio_openfile, pio_nowrite, pio_openfile, pio_global @@ -1144,25 +1166,27 @@ subroutine med_io_read_int1d(filename, mpicom, iam, idata, dname) ! input/output arguments character(len=*), intent(in) :: filename ! file - integer, intent(in) :: mpicom - integer, intent(in) :: iam integer , intent(inout) :: idata(:) ! integer data character(len=*), intent(in) :: dname ! name of data ! local variables + type(ESMF_VM) :: vm integer :: rcode type(file_desc_t) :: pioid type(var_desc_t) :: varid logical :: exists character(CL) :: lversion character(CL) :: name1 + integer :: iam + integer :: rc character(*),parameter :: subName = '(med_io_read_int1d) ' !------------------------------------------------------------------------------- lversion=trim(version) - + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (iam==0) inquire(file=trim(filename),exist=exists) - call shr_mpi_bcast(exists,mpicom,'med_io_read_int1d exists') + call broadcast_logical(vm, exists) if (exists) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) @@ -1186,15 +1210,13 @@ subroutine med_io_read_int1d(filename, mpicom, iam, idata, dname) end subroutine med_io_read_int1d !=============================================================================== - subroutine med_io_read_r8(filename, mpicom, iam, rdata, dname) + subroutine med_io_read_r8(filename, rdata, dname) use med_constants_mod, only : R8 ! !DESCRIPTION: Read scalar double from netcdf file ! input/output arguments character(len=*) , intent(in) :: filename ! file - integer , intent(in) :: mpicom - integer , intent(in) :: iam real(r8) , intent(inout) :: rdata ! real data character(len=*) , intent(in) :: dname ! name of data @@ -1203,42 +1225,43 @@ subroutine med_io_read_r8(filename, mpicom, iam, rdata, dname) character(*),parameter :: subName = '(med_io_read_r8) ' !------------------------------------------------------------------------------- - call med_io_read_r81d(filename, mpicom, iam, r1d,dname) + call med_io_read_r81d(filename, r1d,dname) rdata = r1d(1) end subroutine med_io_read_r8 !=============================================================================== - subroutine med_io_read_r81d(filename, mpicom, iam, rdata, dname) + subroutine med_io_read_r81d(filename, rdata, dname) use med_constants_mod, only : R8 use pio, only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling use pio, only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var use pio, only : pio_nowrite, pio_openfile, pio_global, pio_get_att use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort - use shr_mpi_mod, only : shr_mpi_bcast ! !DESCRIPTION: Read 1d double array from netcdf file ! input/output arguments character(len=*), intent(in) :: filename ! file - integer, intent(in) :: mpicom - integer, intent(in) :: iam real(r8) , intent(inout) :: rdata(:) ! real data character(len=*), intent(in) :: dname ! name of data ! local variables + type(ESMF_VM) :: vm integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid logical :: exists + integer :: iam + integer :: rc character(CL) :: lversion character(CL) :: name1 character(*),parameter :: subName = '(med_io_read_r81d) ' !------------------------------------------------------------------------------- lversion=trim(version) - + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (iam==0) inquire(file=trim(filename),exist=exists) - call shr_mpi_bcast(exists,mpicom,'med_io_read_r81d exists') + call broadcast_logical(vm, exists) if (exists) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) @@ -1262,27 +1285,27 @@ subroutine med_io_read_r81d(filename, mpicom, iam, rdata, dname) end subroutine med_io_read_r81d !=============================================================================== - subroutine med_io_read_char(filename, mpicom, iam, rdata, dname) + subroutine med_io_read_char(filename, rdata, dname) use pio, only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR use pio, only : pio_closefile, pio_inq_varid, pio_get_var use pio, only : pio_openfile, pio_global, pio_get_att, pio_nowrite - use shr_mpi_mod, only : shr_mpi_bcast use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort ! !DESCRIPTION: Read char string from netcdf file ! input/output arguments character(len=*), intent(in) :: filename ! file - integer, intent(in) :: mpicom - integer, intent(in) :: iam character(len=*), intent(inout) :: rdata ! character data character(len=*), intent(in) :: dname ! name of data ! local variables + type(ESMF_VM) :: vm integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid logical :: exists + integer :: iam + integer :: rc character(CL) :: lversion character(CL) :: name1 character(CL) :: charvar ! buffer for string read/write @@ -1290,9 +1313,10 @@ subroutine med_io_read_char(filename, mpicom, iam, rdata, dname) !------------------------------------------------------------------------------- lversion=trim(version) - + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (iam==0) inquire(file=trim(filename),exist=exists) - call shr_mpi_bcast(exists,mpicom,'med_io_read_char exists') + call broadcast_logical(vm, exists) if (exists) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) diff --git a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 index 06670256733..910a1ebc468 100644 --- a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 @@ -55,7 +55,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) use ESMF , only : operator(==) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_internalstate_mod , only : InternalState use med_constants_mod , only : CL, R8 use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag @@ -91,15 +91,15 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following is for debugging call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from gcomp nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! Set pointers to fields needed for albedo calculations @@ -109,13 +109,13 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following sets pointers to the module arrays call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdr', fldptr1=ocnalb%avsdr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdf', fldptr1=ocnalb%avsdf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidr', fldptr1=ocnalb%anidr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidf', fldptr1=ocnalb%anidf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! Get lat, lon, which are time-invariant @@ -124,18 +124,18 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following assumes that all fields in FBMed_ocnalb_o have the same grid - so ! only need to query field 1 call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBMed_ocnalb_o, fieldnum=1, field=lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Determine if first field is on a grid or a mesh - default will be mesh call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_LogWrite(trim(subname)//" : FBAtm is on a mesh ", ESMF_LOGMSG_INFO, rc=rc) call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return lsize = size(ocnalb%anidr) if (numOwnedElements /= lsize) then write(tempc1,'(i10)') numOwnedElements @@ -149,7 +149,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) allocate(ocnalb%lons(numOwnedElements)) allocate(ocnalb%lats(numOwnedElements)) call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize ocnalb%lons(n) = ownedElemCoords(2*n-1) ocnalb%lats(n) = ownedElemCoords(2*n) @@ -189,7 +189,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_constants_mod , only : CS, CL, R8 use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag use med_internalstate_mod , only : InternalState, logunit @@ -247,7 +247,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Get the internal state from Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Note that in the mct version the atm was initialized first so ! that nextsw_cday could be passed to the other components - this @@ -259,10 +259,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Initialize ocean albedo calculation call med_phases_ocnalb_init(gcomp, ocnalb, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) starttype if (trim(starttype) == trim('startup')) then @@ -276,47 +276,47 @@ subroutine med_phases_ocnalb_run(gcomp, rc) end if call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return if (trim(runtype) == 'initial') then call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return else call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, mpicom=is_local%wrap%mpicom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if first_call = .false. else - ! Note that shr_nuopc_methods_State_GetScalar includes a broadcast to all other pets im mpicom + ! Note that shr_nuopc_methods_State_GetScalar includes a broadcast to all other pets call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, mpicom=is_local%wrap%mpicom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_albav call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) eccen call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) obliqr call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) lambm0 call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) mvelpp ! Calculate ocean albedos on the ocean grid @@ -366,20 +366,20 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Update current ifrad/ofrad values if albedo was updated in field bundle if (update_alb) then call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrac', fldptr1=ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrad', fldptr1=ifrad, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrac', fldptr1=ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrad', fldptr1=ofrad, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ifrad(:) = ifrac(:) ofrad(:) = ofrac(:) endif if (dbug_flag > 1) then call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -395,7 +395,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState use med_constants_mod , only : R8 @@ -422,7 +422,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) ! Get the internal state from gcomp nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Map the field bundle from the ocean to the atm grid call med_map_FB_Regrid_Norm( & @@ -433,7 +433,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_ocnalb_o_To_FBMed_ocnalb_a', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_mapo2a diff --git a/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 index 0f0828ca86f..af369e3b8d2 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 @@ -1,361 +1,20 @@ !================================================================================ module shr_nuopc_grid_mod - + use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr implicit none private - public :: shr_nuopc_grid_ArbInit - public :: shr_nuopc_grid_DEInit - public :: shr_nuopc_grid_RegInit public :: shr_nuopc_grid_MeshInit public :: shr_nuopc_grid_ArrayToState public :: shr_nuopc_grid_StateToArray - public :: shr_nuopc_grid_CreateCoords - public :: shr_nuopc_grid_CopyCoord - public :: shr_nuopc_grid_CopyItem - - !integer :: dbug_flag = 6 - integer :: dbug_flag = 0 - character(len=1024) :: tmpstr - character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & __FILE__ !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_ArbInit(nx_global, ny_global, mpicom, gindex, EGrid, rc) - - !----------------------------------------- - ! create a Egrid object for Fields - !----------------------------------------- - use ESMF, only : ESMF_Grid, ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_GridAddItem - use ESMF, only : ESMF_GridCreate1PeriDim, ESMF_GridAddCoord, ESMF_LogFoundError - use ESMF, only : ESMF_GRIDITEM_AREA, ESMF_GRIDITEM_MASK, ESMF_COORDSYS_SPH_DEG - use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_GridCreate1PeriDim - use ESMF, only : ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4 - use mpi, only : mpi_comm_rank - integer , intent(in) :: nx_global - integer , intent(in) :: ny_global - integer , intent(in) :: mpicom - integer , intent(in) :: gindex(:) - type(ESMF_Grid) , intent(inout) :: Egrid - integer , intent(inout) :: rc - - !--- local --- - integer :: n - integer :: iam,ierr - integer :: lsize - integer, pointer :: localArbIndex(:,:) - integer :: dbrc - character(len=*),parameter :: subname='(shr_nuopc_grid_ArbInit)' - !-------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call MPI_COMM_RANK(mpicom, iam, ierr) - call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=dbrc) - - lsize = size(gindex) - allocate(localArbIndex(lsize,2)) - do n = 1,lsize - localArbIndex(n,1) = mod(gindex(n)-1,nx_global) + 1 - localArbIndex(n,2) = (gindex(n)-1)/nx_global + 1 - enddo - - Egrid=ESMF_GridCreate1PeriDim(& - minIndex = (/1,1/), & - maxIndex = (/nx_global,ny_global/), & - arbIndexCount = lsize, & - arbIndexList = localArbIndex, & - periodicDim = 1, & - coordSys = ESMF_COORDSYS_SPH_DEG, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - deallocate(localArbIndex) - - call ESMF_GridAddCoord(Egrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! call ESMF_GridAddCoord(Egrid, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_GridAddItem(Egrid, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_GridAddItem(Egrid, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - end subroutine shr_nuopc_grid_ArbInit - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_DEInit(gcomp, nx_global, ny_global, mpicom, gindex, Egrid, rc) - - !----------------------------------------- - ! create a Egrid object for Fields - !----------------------------------------- - use shr_kind_mod, only : R8=>shr_kind_r8 - use ESMF, only : ESMF_GridComp, ESMF_Grid, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridGetCoord, ESMF_GRIDITEM_MASK, ESMF_GridGet, ESMF_GridGetItem - use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite - use ESMF, only : ESMF_VMAllReduce, ESMF_DistGridConnectionSet, ESMF_DistGrid, ESMF_DELayout - use ESMF, only : ESMF_DistGridGet, ESMF_DistGridPrint, ESMF_GridAddCoord, ESMF_GridAddItem - use ESMF, only : ESMF_GRIDITEM_AREA, ESMF_TYPEKIND_R8, ESMF_TYPEKIND_I4 - use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_DELayoutCreate, ESMF_VMAllReduce - use ESMF, only : ESMF_REDUCE_SUM, ESMF_LOGMSG_INFO, ESMF_DistGridConnection, ESMF_Grid - use ESMF, only : ESMF_GridCreate, ESMF_COORDSYS_SPH_DEG - use ESMF, only : ESMF_DistGridCreate - use mpi, only : mpi_comm_rank - use shr_sys_mod, only : shr_sys_abort - - type(ESMF_GridComp) :: gcomp - integer , intent(in) :: nx_global - integer , intent(in) :: ny_global - integer , intent(in) :: mpicom - integer , intent(in) :: gindex(:) - type(ESMF_Grid) , intent(inout) :: Egrid - integer , intent(inout) :: rc - - !--- local --- - integer :: n,n1,n2,ig,jg,cnt - integer :: de,decount,dimcount - integer :: iam,ierr - integer :: lsize,gsize,nblocks_tot,ngseg - integer :: lbnd(2),ubnd(2) - integer :: global_index - integer, pointer :: indexList(:) - integer, pointer :: deBlockList(:,:,:) - integer, pointer :: petMap(:) - real(r8),pointer :: falon(:),falat(:) - real(r8),pointer :: famask(:),faarea(:) - integer, pointer :: iarray2(:,:) - real(r8),pointer :: farray2(:,:) - type(ESMF_DELayout) :: delayout - type(ESMF_DistGrid) :: distgrid - integer ,pointer :: pes_local(:) - integer ,pointer :: pes_global(:) - type(ESMF_VM) :: vm - integer :: petCount - type(ESMF_DistGridConnection), allocatable :: connectionList(:) - integer :: dbrc - character(len=*),parameter :: subname='(shr_nuopc_grid_DEInit)' - !-------------------------------------------------------------- - - call MPI_COMM_RANK(mpicom, iam, ierr) - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out - - call ESMF_VMGet(vm, petCount=petCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out - - ! 1 gridcell per DE - - lsize = size(gindex) - gsize = nx_global * ny_global - - write(tmpstr,'(a,4i8)') subname//' nx,ny,lsize = ',nx_global,ny_global,lsize,gsize - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - nblocks_tot = gsize - - allocate(deBlockList(2,2,nblocks_tot)) - allocate(petMap(nblocks_tot)) - - write(tmpstr,'(a,1i8)') subname//' nblocks = ',nblocks_tot - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - allocate(pes_local(gsize)) - allocate(pes_global(gsize)) - - pes_local(:) = 0 - do n = 1,lsize - pes_local(gindex(n)) = iam - end do - - call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out - - ! Note that below this is a global search overall all the points - not just the ones - ! passed in my gindex(:) - n = 0 - do global_index = 1,gsize - ig = mod(global_index-1,nx_global) + 1 - jg = (global_index-1)/nx_global + 1 - deBlockList(1,1,n) = ig - deBlockList(1,2,n) = ig - deBlockList(2,1,n) = jg - deBlockList(2,2,n) = jg - petMap(global_index) = pes_global(global_index) - ! write(tmpstr,'(a,2i8)') subname//' IDs = ',n,petMap(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,n),deBlockList(1,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,n),deBlockList(2,2,n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - - deallocate(pes_local) - deallocate(pes_global) - - delayout = ESMF_DELayoutCreate(petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - allocate(connectionList(1)) - call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & - tileIndexB=1, positionVector=(/nx_global, 0/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=u_FILE_u)) & - return ! bail out - - distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nx_global,ny_global/), & - ! indexflag = ESMF_INDEX_DELOCAL, & - deBlockList=deBlockList, & - delayout=delayout, & - connectionList=connectionList, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - deallocate(deBlockList) - deallocate(petMap) - deallocate(connectionList) - - call ESMF_DistGridPrint(distgrid=distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=u_FILE_u)) & - return ! bail out - - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - allocate(indexList(cnt)) - ! write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - ! write(tmpstr,'(a,4i8)') subname//' distgrid list= ',indexList(1),indexList(cnt),minval(indexList), maxval(indexList) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - deallocate(IndexList) - - Egrid = ESMF_GridCreate(distgrid=distgrid, & - coordSys = ESMF_COORDSYS_SPH_DEG, & - gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & - rc = rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call ESMF_GridGet(Egrid, localDEcount=DEcount, dimCount=dimCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! write(tmpstr,'(a,2i8)') subname//' localDEcount = ',DEcount,lsize - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,2i8)') subname//' dimCount = ',dimCount - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - if (DEcount /= lsize) then - call shr_sys_abort(subname//' DEcount /= lsize') - endif - - call ESMF_GridAddCoord(Egrid, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - ! call ESMF_GridAddCoord(Egrid, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_GridAddItem(Egrid, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - call ESMF_GridAddItem(Egrid, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - allocate(falon(lsize),falat(lsize),famask(lsize),faarea(lsize)) - - do n = 1,lsize - DE = n-1 - - ! write(tmpstr,'(a,3i8)') subname//' n,DE,lsize ',n,DE,lsize - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(a,i8,4g13.6)') subname//' grid values ',DE,falon(n),falat(n),famask(n),faarea(n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_GridGetCoord(Egrid, coordDim=1, localDE=DE, staggerLoc=ESMF_STAGGERLOC_CENTER, & - computationalLBound=lbnd, computationalUBound=ubnd, & - farrayPtr=farray2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - farray2(1,1) = falon(n) - - ! write(tmpstr,'(a,5i8)') subname//' lbnd ubnd ',DE,lbnd,ubnd - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_GridGetCoord(Egrid, coordDim=2, localDE=DE, staggerLoc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=farray2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - farray2(1,1) = falat(n) - - call ESMF_GridGetItem(Egrid, itemflag=ESMF_GRIDITEM_MASK, localDE=DE, staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=iarray2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - iarray2(1,1) = nint(famask(n)) - - call ESMF_GridGetItem(Egrid, itemflag=ESMF_GRIDITEM_AREA, localDE=DE, staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=farray2, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - farray2(1,1) = faarea(n) - - enddo - deallocate(falon,falat,famask,faarea) - - end subroutine shr_nuopc_grid_DEInit - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_RegInit(nx_global, ny_global, mpicom, EGrid, rc) - - !----------------------------------------- - ! create a Grid object for Fields - !----------------------------------------- - use shr_kind_mod, only : R8=>shr_kind_r8 - use mpi, only : mpi_comm_rank - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_GridCreateNoPeriDimUfrm, ESMF_COORDSYS_SPH_DEG, ESMF_STAGGERLOC_CENTER - use ESMF, only : ESMF_Grid, ESMF_SUCCESS - integer , intent(in) :: nx_global - integer , intent(in) :: ny_global - integer , intent(in) :: mpicom - type(ESMF_Grid) ,intent(inout) :: Egrid - integer , intent(inout) :: rc - - !--- local --- - integer :: iam,ierr - integer :: dbrc - character(len=*),parameter :: subname='(shr_nuopc_grid_RegInit)' - !-------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call MPI_COMM_RANK(mpicom, iam, ierr) - call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=dbrc) - - Egrid = ESMF_GridCreateNoPeriDimUfrm(maxIndex=(/nx_global, ny_global/), & - minCornerCoord=(/0._R8, -180._R8/), & - maxCornerCoord=(/360._R8, 180._R8/), & - coordSys=ESMF_COORDSYS_SPH_DEG, staggerLocList=(/ESMF_STAGGERLOC_CENTER/), & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=u_FILE_u)) & - return ! bail out - - end subroutine shr_nuopc_grid_RegInit - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, lon, lat, Emesh, rc) + subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, rc) !----------------------------------------- ! create an Emesh object for Fields @@ -367,12 +26,10 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, use ESMF, only : ESMF_VMGather, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF, only : ESMF_MeshCreate, ESMF_COORDSYS_SPH_DEG, ESMF_REDUCE_SUM use ESMF, only : ESMF_VMAllReduce, ESMF_MESHELEMTYPE_QUAD - use mpi, only : mpi_comm_rank type(ESMF_GridComp) :: gcomp integer , intent(in) :: nx_global integer , intent(in) :: ny_global - integer , intent(in) :: mpicom integer , intent(in) :: gindex(:) real(r8), pointer , intent(in) :: lon(:) real(r8), pointer , intent(in) :: lat(:) @@ -381,7 +38,7 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, !--- local --- integer :: n,n1,n2,de - integer :: iam,ierr + integer :: iam integer :: lsize integer :: numTotElems, numNodes, numConn, nodeindx integer :: iur,iul,ill,ilr @@ -404,22 +61,21 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, integer :: sendData(1) type(ESMF_VM) :: vm integer :: petCount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' !-------------------------------------------------------------- rc = ESMF_SUCCESS - call MPI_COMM_RANK(mpicom, iam, ierr) - call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lsize = size(gindex) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, petCount=petCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + call ESMF_VMGet(vm, petCount=petCount, localpet=iam, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(latG(nx_global*ny_global)) allocate(lonG(nx_global*ny_global)) @@ -429,10 +85,10 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, sendData(1) = lsize call ESMF_VMGather(vm, sendData=sendData, recvData=recvCounts, count=1, rootPet=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMBroadCast(vm, bcstData=recvCounts, count=petCount, rootPet=0, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return recvoffsets(1) = 0 do n = 2,petCount @@ -440,10 +96,10 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, end do call ESMF_VMAllGatherV(vm, lat, lsize, latG, recvCounts, recvOffsets, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMAllGatherV(vm, lon, lsize, lonG, recvCounts, recvOffsets, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(recvoffsets) deallocate(recvCounts) @@ -560,7 +216,7 @@ subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, mpicom, gindex, call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return ! bail out + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,numNodes nodeOwners(n) = pes_global(iurpts(n)) @@ -610,7 +266,7 @@ subroutine shr_nuopc_grid_ArrayToState(array, rList, state, grid_option, rc) use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_cs, IN=>shr_kind_in use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_reset - + use med_constants_mod, only : CL !----- arguments ----- real(r8) , intent(inout) :: array(:,:) character(len=*) , intent(in) :: rList @@ -624,6 +280,7 @@ subroutine shr_nuopc_grid_ArrayToState(array, rList, state, grid_option, rc) type(ESMF_Field) :: lfield real(R8), pointer :: farray1(:) integer :: dbrc + character(len=CL) :: tmpstr character(*),parameter :: subName = "(shr_nuopc_grid_ArrayToState)" !---------------------------------------------------------- @@ -663,6 +320,7 @@ subroutine shr_nuopc_grid_StateToArray(state, array, rList, grid_option, rc) use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS, ESMF_LOGMSG_INFO use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_CS, IN=>shr_kind_in use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum + use med_constants_mod, only : CL !----- arguments ----- type(ESMF_State) , intent(in) :: state @@ -677,6 +335,7 @@ subroutine shr_nuopc_grid_StateToArray(state, array, rList, grid_option, rc) type(ESMF_Field) :: lfield real(R8), pointer :: farray1(:) integer :: dbrc + character(len=CL) :: tmpstr character(*),parameter :: subName = "(shr_nuopc_grid_StateToArray)" !---------------------------------------------------------- @@ -709,512 +368,4 @@ subroutine shr_nuopc_grid_StateToArray(state, array, rList, grid_option, rc) end subroutine shr_nuopc_grid_StateToArray - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_CreateCoords(gridNew, gridOld, rc) - use ESMF , only : ESMF_Grid, ESMF_DistGrid, ESMF_CoordSys_Flag, ESMF_Index_Flag - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_GridGet, ESMF_GridAddCoord - use ESMF , only : ESMF_GridGetCoord, ESMF_GridAddCoord, ESMF_STAGGERLOC_CENTER - use ESMF , only : ESMF_GridCreate, ESMF_SUCCESS, ESMF_STAGGERLOC_CORNER - use shr_kind_mod , only : R8=>shr_kind_r8 - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - - type(ESMF_Grid), intent(inout) :: gridNew - type(ESMF_Grid), intent(inout) :: gridOld - integer , intent(out) :: rc - - ! local variables - integer :: localDE, localDECount - type(ESMF_DistGrid) :: distgrid - type(ESMF_CoordSys_Flag) :: coordSys - type(ESMF_Index_Flag) :: indexflag - real(R8),pointer :: dataPtr1(:,:), dataPtr2(:,:) - integer :: dimCount - integer, pointer :: gridEdgeLWidth(:), gridEdgeUWidth(:) - character(len=*),parameter :: subname='(shr_nuopc_methods_grid_createcoords)' - integer :: dbrc - ! ---------------------------------------------- - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_LogWrite(trim(subname)//": tcxA", ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_GridGet(gridold, dimCount=dimCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(gridEdgeLWidth(dimCount),gridEdgeUWidth(dimCount)) - call ESMF_GridGet(gridold,distgrid=distgrid, coordSys=coordSys, indexflag=indexflag, dimCount=dimCount, & - gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, localDECount=localDECount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": tcxB", ESMF_LOGMSG_INFO, rc=dbrc) - - write(msgString,*) trim(subname)//' localDECount = ',localDECount - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' dimCount = ',dimCount - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' size(gELW) = ',size(gridEdgeLWidth) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' gridEdgeLWidth = ',gridEdgeLWidth - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - write(msgString,*) trim(subname)//' gridEdgeUWidth = ',gridEdgeUWidth - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - - call ESMF_LogWrite(trim(subname)//": tcxC", ESMF_LOGMSG_INFO, rc=dbrc) - - gridnew = ESMF_GridCreate(distgrid=distgrid, coordSys=coordSys, indexflag=indexflag, & - gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gridEdgeLWidth, gridEdgeUWidth) - - call ESMF_GridAddCoord(gridnew, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridAddCoord(gridnew, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - do localDE = 0,localDeCount-1 - - call ESMF_GridGetCoord(gridold, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(gridnew, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(gridnew, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=dataPtr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(gridnew, coordDim=1, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataPtr2 = dataPtr1 - - call ESMF_GridGetCoord(gridold, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(gridnew, coordDim=2, localDE=localDE, & - staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=dataPtr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataPtr2 = dataPtr1 - - enddo - - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine shr_nuopc_grid_CreateCoords - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_CopyCoord(gridcomp, gridSrc, gridDst, staggerloc, & - tolerance, compare, invert, rc) - use shr_kind_mod, only : I8=>shr_kind_i8, I4=> shr_kind_in - use ESMF, only : ESMF_GridComp, ESMF_Grid, ESMF_StaggerLoc, ESMF_VM, ESMF_DistGrid, ESMF_Array - use ESMF, only : ESMF_TypeKind_Flag, ESMF_CoordSys_Flag, ESMF_RouteHandle - use ESMF, only : ESMF_GridGet, ESMF_LogSetError, ESMF_VMGet, ESMF_GridAddCoord, ESMF_GridGetCoord - use ESMF, only : ESMF_RC_ARG_BAD, ESMF_ArrayGet, ESMF_DistGridGet - use ESMF, only : ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO - use ESMF, only : ESMF_ArraySMMStore, ESMF_GridCompGet - use ESMF, only : ESMF_ArraySMM, ESMF_ArraySMMRelease - use ESMF, only : ESMF_ArrayRedist, ESMF_ArrayRedistStore, ESMF_ArrayRedistRelease - use ESMF, only : ESMF_RC_NOT_IMPL, ESMF_LogSetError - use ESMF, only : operator(/=) - use shr_nuopc_methods_mod, only : shr_nuopc_methods_Distgrid_Match, shr_nuopc_methods_ChkErr - - ! Arguments - type(ESMF_GridComp) , intent(in) :: gridcomp - type(ESMF_Grid), intent(in) :: gridSrc - type(ESMF_Grid), intent(in) :: gridDst - type(ESMF_StaggerLoc), intent(in) :: staggerloc(:) - real, intent(in), optional :: tolerance - logical, intent(in), optional :: compare - integer, intent(in), optional :: invert(:) - integer, intent(out),optional :: rc - - ! Local Variables - real :: l_tolerance - logical :: l_compare - integer, allocatable :: l_invert(:) - integer :: i - type(ESMF_VM) :: vm - type(ESMF_DistGrid) :: distGridSrc, distGridDst - type(ESMF_Array) :: coordArraySrc, coordArrayDst - integer(I4),allocatable :: factorList(:) - integer, allocatable :: factorIndexList(:,:) - type(ESMF_RouteHandle) :: routehandle - integer :: dimCountSrc, dimCountDst - integer :: deCountDst - integer, allocatable :: elementCountPDeDst(:) - integer(I8) :: sumElementCountPDeDst - type(ESMF_TypeKind_Flag) :: coordTypeKindSrc, coordTypeKindDst - type(ESMF_CoordSys_Flag) :: coordSysSrc, coordSysDst - logical :: isPresentSrc, isPresentDst - integer :: dimIndex, staggerlocIndex - integer :: localPet - character(len=10) :: numString - integer :: dbrc - character(len=*), parameter :: subname='(shr_nuopc_methods_Grid_CopyCoord)' - ! ---------------------------------------------- - - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - l_tolerance = 0.0 - if (present(tolerance)) l_tolerance = tolerance - l_compare = .FALSE. - if (present(compare)) l_compare = compare - if (present(invert)) then - allocate(l_invert(size(invert))) - l_invert = invert - else - allocate(l_invert(1)) - l_invert = -1 - endif - - call ESMF_GridGet(gridSrc, distGrid=distGridSrc, & - dimCount=dimCountSrc, coordTypeKind=coordTypeKindSrc, & - coordSys=coordSysSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridGet(gridDst, distGrid=distGridDst, & - dimCount=dimCountDst, coordTypeKind=coordTypeKindDst, & - coordSys=coordSysDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (.NOT. shr_nuopc_methods_Distgrid_Match(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( dimCountSrc /= dimCountDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": DIMCOUNT MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( coordTypeKindSrc /= coordTypeKindDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": COORDTYPEKIND MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( coordSysSrc /= coordSysDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": COORDSYS MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - do dimIndex=1, dimCountDst - do staggerlocIndex=1, size(staggerloc) - call ESMF_GridGetCoord(gridSrc, staggerloc=staggerloc(staggerlocIndex), & - isPresent=isPresentSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresentSrc) then - call ESMF_GridGetCoord(gridSrc, coordDim=dimIndex, & - staggerloc=staggerloc(staggerlocIndex), & - array=coordArraySrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetCoord(gridDst, & - staggerloc=staggerloc(staggerlocIndex), & - isPresent=isPresentDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if(.NOT.isPresentDst) then - call ESMF_GridAddCoord(gridDst, & - staggerLoc=staggerloc(staggerlocIndex), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - if(l_compare .EQV. .TRUE.) then - ! TODO: Compare existing coordinates - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=subname//": Cannot compare existing coordinates.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - end if - endif - call ESMF_GridGetCoord(gridDst, coordDim=dimIndex, & - staggerloc=staggerloc(staggerlocIndex), & - array=coordArrayDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayGet(coordArraySrc, distGrid=distGridSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayGet(coordArrayDst, distGrid=distGridDst, & - dimCount=dimCountDst, deCount=deCountDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (.NOT. shr_nuopc_methods_Distgrid_Match(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( ANY( l_invert == dimIndex )) then - call ESMF_GridCompGet(gridcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (localPet == 0) then - call ESMF_DistGridGet(distGridDst, deCount=deCountDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(elementCountPDeDst(deCountDst)) - call ESMF_DistGridGet(distGridDst, & - elementCountPDe=elementCountPDeDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - sumElementCountPDeDst = SUM(elementCountPDeDst) - if (dbug_flag >= 2) then - write (numString, "(I10)") sumElementCountPDeDst - call ESMF_LogWrite(subname//": sumElementCountPDeDst: "//trim(adjustl(numString)), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - allocate(factorList(sumElementCountPDeDst)) - allocate(factorIndexList(2,sumElementCountPDeDst)) - - factorList(:) = 1 - factorIndexList(1,:) = (/(i, i=1, sumElementCountPDeDst, 1)/) - factorIndexList(2,:) = (/(i, i=sumElementCountPDeDst, 1, -1)/) - - if (dbug_flag >= 2) then - write (numString, "(I10)") factorIndexList(1,1) - write (msgString, "(A)") "Src=>Dst: "//trim(adjustl(numString))//"=>" - write (numString, "(I10)") factorIndexList(2,1) - write (msgString, "(A)") trim(msgString)//trim(adjustl(numString)) - write (numString, "(I10)") factorIndexList(1,sumElementCountPDeDst) - write (msgString, "(A)") trim(msgString)//" "//trim(adjustl(numString))//"=>" - write (numString, "(I10)") factorIndexList(2,sumElementCountPDEDst) - write (msgString, "(A)") trim(msgString)//trim(adjustl(numString)) - call ESMF_LogWrite(subname//": Invert Mapping: "//msgString, ESMF_LOGMSG_INFO, rc=dbrc) - endif - - call ESMF_ArraySMMStore(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, factorList=factorList, & - factorIndexList=factorIndexList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(elementCountPDeDst) - deallocate(factorList) - deallocate(factorIndexList) - else - call ESMF_ArraySMMStore(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - call ESMF_ArraySMM(srcArray=coordArraySrc, dstArray=coordArrayDst, & - routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArraySMMRelease(routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - else - call ESMF_ArrayRedistStore(coordArraySrc, coordArrayDst, routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayRedist(coordArraySrc, coordArrayDst, routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayRedistRelease(routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": SOURCE GRID MISSING STAGGER LOCATION", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - enddo - enddo - - deallocate(l_invert) - - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine shr_nuopc_grid_CopyCoord - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_CopyItem(gridcomp, gridSrc, gridDst, item, & - tolerance, compare, invert, rc) - - use ESMF, only : ESMF_GridComp, ESMF_Grid, ESMF_GridItem_Flag, ESMF_StaggerLoc - use ESMF, only : ESMF_GridGetItem, ESMF_GridAddItem - use ESMF, only : ESMF_DistGrid, ESMF_Array, ESMF_RouteHandle, ESMF_TypeKind_Flag - use ESMF, only : ESMF_CoordSys_Flag, ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF, only : ESMF_LogSetError, ESMF_GridGet, ESMF_ArrayRedist, ESMF_ArrayRedistStore - use ESMF, only : ESMF_ArrayRedistRelease, ESMF_GridGetItem, ESMF_STAGGERLOC_CENTER - use ESMF, only : ESMF_RC_ARG_BAD, ESMF_RC_NOT_IMPL, ESMF_ArrayGet - use ESMF, only : operator(/=) - use shr_nuopc_methods_mod, only : shr_nuopc_methods_Distgrid_Match, shr_nuopc_methods_ChkErr - - ! ---------------------------------------------- - type(ESMF_GridComp), intent(in) :: gridcomp - type(ESMF_Grid), intent(in) :: gridSrc - type(ESMF_Grid), intent(in) :: gridDst - type(ESMF_GridItem_Flag), intent(in) :: item(:) - real, intent(in), optional :: tolerance - logical, intent(in), optional :: compare - integer, intent(in), optional :: invert(:) - integer, intent(out),optional :: rc - - ! Local Variables - real :: l_tolerance - logical :: l_compare - integer, allocatable :: l_invert(:) - type(ESMF_StaggerLoc) :: l_staggerloc - type(ESMF_DistGrid) :: distGridSrc, distGridDst - type(ESMF_Array) :: itemArraySrc, itemArrayDst - type(ESMF_RouteHandle) :: routehandle - integer :: dimCountSrc, dimCountDst - type(ESMF_TypeKind_Flag) :: coordTypeKindSrc, coordTypeKindDst - type(ESMF_CoordSys_Flag) :: coordSysSrc, coordSysDst - logical :: isPresentSrc, isPresentDst - integer :: itemIndex - integer :: localPet - character(len=10) :: numString - integer :: dbrc - character(len=*), parameter :: subname='(shr_nuopc_methods_Grid_CopyItem)' - ! ---------------------------------------------- - - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - l_tolerance = 0.0 - if (present(tolerance)) l_tolerance = tolerance - l_compare = .FALSE. - if (present(compare)) l_compare = compare - if (present(invert)) then - allocate(l_invert(size(invert))) - l_invert = invert - else - allocate(l_invert(1)) - l_invert = -1 - endif - l_staggerloc = ESMF_STAGGERLOC_CENTER - - call ESMF_GridGet(gridSrc, distGrid=distGridSrc, & - dimCount=dimCountSrc, coordTypeKind=coordTypeKindSrc, & - coordSys=coordSysSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridGet(gridDst, distGrid=distGridDst, & - dimCount=dimCountDst, coordTypeKind=coordTypeKindDst, & - coordSys=coordSysDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (.NOT. shr_nuopc_methods_Distgrid_Match(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( dimCountSrc /= dimCountDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": DIMCOUNT MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( coordTypeKindSrc /= coordTypeKindDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": COORDTYPEKIND MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( coordSysSrc /= coordSysDst) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": COORDSYS MISMATCH", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - do itemIndex=1, size(item) - call ESMF_GridGetItem(gridSrc, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, isPresent=isPresentSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresentSrc) then - call ESMF_GridGetItem(gridSrc, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, array=itemArraySrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridGetItem(gridDst, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, isPresent=isPresentDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if(.NOT.isPresentDst) then - call ESMF_GridAddItem(gridDst, itemflag=item(itemIndex), & - staggerLoc=l_staggerloc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - if(l_compare .EQV. .TRUE.) then - ! TODO: Compare existing coordinates - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=subname//": Cannot compare existing coordinates.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - end if - endif - call ESMF_GridGetItem(gridDst, itemflag=item(itemIndex), & - staggerloc=l_staggerloc, array=itemArrayDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayGet(itemArraySrc, distGrid=distGridSrc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayGet(itemArrayDst, distGrid=distGridDst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (.NOT. shr_nuopc_methods_Distgrid_Match(distGrid1=distGridSrc, distGrid2=distGridDst, rc=rc)) then - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": Unable to redistribute coordinates. DistGrids do not match.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - - if ( ANY( l_invert > 0 )) then - ! TODO: Invert Item - call ESMF_LogSetError(ESMF_RC_NOT_IMPL, & - msg=subname//": Cannot invert item.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - else - call ESMF_ArrayRedistStore(itemArraySrc, itemArrayDst, routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayRedist(itemArraySrc, itemArrayDst, routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ArrayRedistRelease(routehandle=routehandle, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg=subname//": SOURCE GRID MISSING ITEM", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) - return ! bail out - endif - enddo - - deallocate(l_invert) - - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif - - end subroutine shr_nuopc_grid_CopyItem - end module shr_nuopc_grid_mod diff --git a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 index 515401c1c36..c3e3b44b7cc 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 @@ -12,7 +12,7 @@ module shr_nuopc_methods_mod use ESMF , only : ESMF_MAXSTR, ESMF_LOGMSG_WARNING, ESMF_POLEMETHOD_ALLAVG use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use shr_nuopc_utils_mod, only : shr_nuopc_methods_ChkErr => shr_nuopc_utils_ChkErr + use shr_nuopc_utils_mod, only : shr_nuopc_methods_ChkErr => shr_nuopc_utils_ChkErr, shr_nuopc_utils_ChkErr implicit none private @@ -152,7 +152,7 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) end if call ESMF_FieldBundleWrite(FB, fname, & singleFile=.true., status=ESMF_FILESTATUS_REPLACE, iofmt=ESMF_IOFMT_NETCDF, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_diagnose(FB, 'write '//trim(fname), rc) elseif (mode == 'read') then @@ -166,13 +166,13 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) ! ignore that field and read the rest, so instead read each field one at a time through ESMF_FieldRead ! call ESMF_FieldBundleRead (FB, fname, & ! singleFile=.true., iofmt=ESMF_IOFMT_NETCDF, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return !----------------------------------------------------------------------------------------------------- call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,fieldCount call shr_nuopc_methods_FB_getFieldByName(FB, name, field, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRead (field, fname, iofmt=ESMF_IOFMT_NETCDF, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//' WARNING missing field '//trim(name),rc=dbrc) @@ -270,10 +270,10 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (present(FBgeom)) then call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCountGeom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (present(STgeom)) then call ESMF_StateGet(STgeom, itemCount=fieldCountGeom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE @@ -293,37 +293,37 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg end if elseif (present(FBflds)) then call ESMF_FieldBundleGet(FBflds, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldNameList(fieldCount)) call ESMF_FieldBundleGet(FBflds, fieldNameList=lfieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBflds", ESMF_LOGMSG_INFO, rc=rc) end if elseif (present(STflds)) then call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldNameList(fieldCount)) call ESMF_StateGet(STflds, itemNameList=lfieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) end if elseif (present(FBgeom)) then call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldNameList(fieldCount)) call ESMF_FieldBundleGet(FBgeom, fieldNameList=lfieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBgeom", ESMF_LOGMSG_INFO, rc=rc) end if elseif (present(STgeom)) then call ESMF_StateGet(STgeom, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldNameList(fieldCount)) call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) end if @@ -358,13 +358,13 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg ! Look at only the first field in either the FBgeom and STgeom to get the grid if (present(FBgeom)) then call shr_nuopc_methods_FB_getFieldN(FBgeom, 1, lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from FBgeom", ESMF_LOGMSG_INFO, rc=rc) end if elseif (present(STgeom)) then call shr_nuopc_methods_State_getFieldN(STgeom, 1, lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from STgeom", ESMF_LOGMSG_INFO, rc=rc) end if @@ -376,7 +376,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg ! Make sure the field is not empty - if it is return with an error call ESMF_FieldGet(lfield, status=status, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//": ERROR field does not have a geom yet ", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) @@ -386,17 +386,17 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg ! Determine if first field in either FBgeom or STgeom is on a grid or a mesh call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(lfield, grid=lgrid, staggerloc=staggerloc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use grid", ESMF_LOGMSG_INFO, rc=rc) end if elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO, rc=rc) end if @@ -413,7 +413,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg !--------------------------------- FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldcountgeom > 0) then @@ -423,10 +423,10 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg ! Create the field on either lgrid or lmesh if (geomtype == ESMF_GEOMTYPE_GRID) then field = ESMF_FieldCreate(lgrid, ESMF_TYPEKIND_R8, staggerloc=staggerloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (geomtype == ESMF_GEOMTYPE_MESH) then field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else ! geomtype call ESMF_LogWrite(trim(subname)//": ERROR no grid/mesh for field ", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE @@ -435,7 +435,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg ! Add the created field bundle FBout call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & ESMF_LOGMSG_INFO, rc=dbrc) @@ -448,7 +448,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg deallocate(lfieldNameList) call shr_nuopc_methods_FB_reset(FBout, value=spval_init, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -483,7 +483,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) fieldname = ' ' call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) @@ -493,7 +493,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return fieldname = lfieldnamelist(fieldnum) @@ -530,10 +530,10 @@ subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_getNameN(FB, fieldnum, name, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldBundleGet(FB, fieldName=name, field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -564,7 +564,7 @@ subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -599,7 +599,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) fieldname = ' ' call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) @@ -609,7 +609,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) allocate(lfieldnamelist(fieldCount)) call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return fieldname = lfieldnamelist(fieldnum) @@ -652,7 +652,7 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) nullify(fieldList) call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return fieldnum = 0 if (associated(fieldList)) then fieldnum = size(fieldList) @@ -663,12 +663,12 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) fieldnum = 0 call ESMF_StateGet(State, itemCount=itemCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (itemCount > 0) then allocate(itemTypeList(itemCount)) call ESMF_StateGet(State, itemTypeList=itemTypeList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,itemCount if (itemTypeList(n) == ESMF_STATEITEM_FIELD) fieldnum=fieldnum+1 @@ -708,10 +708,10 @@ subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_State_getNameN(State, fieldnum, name, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_StateGet(State, itemName=name, field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -743,7 +743,7 @@ subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) rc = ESMF_SUCCESS call ESMF_StateGet(State, itemName=fieldname, field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -779,18 +779,18 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldDestroy(field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo call ESMF_FieldBundleDestroy(FB, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lfieldnamelist) if (dbug_flag > 10) then @@ -834,14 +834,14 @@ subroutine shr_nuopc_methods_FB_reset(FB, value, rc) endif call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call shr_nuopc_methods_FB_SetFldPtr(FB, lfieldnamelist(n), lvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(lfieldnamelist) @@ -885,9 +885,9 @@ subroutine shr_nuopc_methods_FB_FieldCopy(FBin,fldin,FBout,fldout,rc) shr_nuopc_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then call shr_nuopc_methods_FB_GetFldPtr(FBin, trim(fldin), dataPtrIn1, dataPtrIn2, lrankIn, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fldout), dataPtrOut1, dataPtrOut2, lrankOut, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrankIn /= lrankOut) then call ESMF_LogWrite(trim(subname)//": ERROR FBin and FBout different rank", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) @@ -1033,7 +1033,7 @@ subroutine shr_nuopc_methods_FB_Regrid(shortnames, flds_scalar_name, mappings, & return endif call shr_nuopc_methods_FB_FieldRegrid(FBin, shortnames(n), FBout, shortnames(n), bilnrmap,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (mappings(n) == "conservefrac") then if (.not. okconsf) then @@ -1043,7 +1043,7 @@ subroutine shr_nuopc_methods_FB_Regrid(shortnames, flds_scalar_name, mappings, & return endif call shr_nuopc_methods_FB_FieldRegrid(FBin, shortnames(n), FBout,shortnames(n), consfmap, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (mappings(n) == "conservedst") then if (.not. okconsd) then @@ -1053,7 +1053,7 @@ subroutine shr_nuopc_methods_FB_Regrid(shortnames, flds_scalar_name, mappings, & return endif call shr_nuopc_methods_FB_FieldRegrid(FBin, shortnames(n), FBout,shortnames(n), consdmap, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (mappings(n) == 'patch') then if (.not. okpatch) then @@ -1063,7 +1063,7 @@ subroutine shr_nuopc_methods_FB_Regrid(shortnames, flds_scalar_name, mappings, & return endif call shr_nuopc_methods_FB_FieldRegrid(FBin, shortnames(n), FBout,shortnames(n), patchmap,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (mappings(n) == 'copy') then !------------------------------------------- @@ -1082,11 +1082,11 @@ subroutine shr_nuopc_methods_FB_Regrid(shortnames, flds_scalar_name, mappings, & " fld="//trim(shortnames(n)), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) end if call shr_nuopc_methods_FB_FieldRegrid(FBin ,shortnames(n), FBout, shortnames(n), consfmap,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif else call shr_nuopc_methods_FB_FieldRegrid(FBin ,shortnames(n), FBout,shortnames(n), fcopymap,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif else @@ -1119,7 +1119,6 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,debug) use ESMF, only : ESMF_FieldBundle, ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_Field use ESMF, only : ESMF_TERMORDER_SRCSEQ, ESMF_FieldRegridStore, ESMF_SparseMatrixWrite use med_constants_mod, only : R8 - use mpi, only : mpi_comm_rank, MPI_COMM_WORLD type(ESMF_FieldBundle), intent(inout) :: FBin character(len=*) , intent(in) :: fldin type(ESMF_FieldBundle), intent(inout) :: FBout @@ -1146,14 +1145,14 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,debug) shr_nuopc_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then call shr_nuopc_methods_FB_getFieldByName(FBin, trim(fldin), field1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFieldByName(FBout, trim(fldout), field2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegrid(field1, field2, routehandle=RH, & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else if (dbug_flag > 1) then @@ -1225,7 +1224,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & endif call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr2=dataOut, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lb1 = lbound(dataOut,1) ub1 = ubound(dataOut,1) lb2 = lbound(dataOut,2) @@ -1277,7 +1276,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & if (n == 1 .and. present(FBinA)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr2=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtA)) then wgtfound = .true. wgt => wgtA @@ -1286,7 +1285,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & elseif (n == 2 .and. present(FBinB)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr2=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtB)) then wgtfound = .true. wgt => wgtB @@ -1295,7 +1294,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & elseif (n == 3 .and. present(FBinC)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr2=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtC)) then wgtfound = .true. wgt => wgtC @@ -1304,7 +1303,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & elseif (n == 4 .and. present(FBinD)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr2=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtD)) then wgtfound = .true. wgt => wgtD @@ -1313,7 +1312,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_2D(FBout, fnameout, & elseif (n == 5 .and. present(FBinE)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr2=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtE)) then wgtfound = .true. wgt => wgtE @@ -1414,7 +1413,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & endif call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr1=dataOut, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lb1 = lbound(dataOut,1) ub1 = ubound(dataOut,1) allocate(wgt(lb1:ub1)) @@ -1464,7 +1463,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & if (n == 1 .and. present(FBinA)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtA)) then wgtfound = .true. wgt => wgtA @@ -1473,7 +1472,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & elseif (n == 2 .and. present(FBinB)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtB)) then wgtfound = .true. wgt => wgtB @@ -1482,7 +1481,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & elseif (n == 3 .and. present(FBinC)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtC)) then wgtfound = .true. wgt => wgtC @@ -1491,7 +1490,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & elseif (n == 4 .and. present(FBinD)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtD)) then wgtfound = .true. wgt => wgtD @@ -1500,7 +1499,7 @@ subroutine shr_nuopc_methods_FB_FieldMerge_1D(FBout, fnameout, & elseif (n == 5 .and. present(FBinE)) then FBinfound = .true. call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtE)) then wgtfound = .true. wgt => wgtE @@ -1577,14 +1576,14 @@ subroutine shr_nuopc_methods_State_reset(State, value, rc) endif call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call shr_nuopc_methods_State_SetFldPtr(State, lfieldnamelist(n), lvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(lfieldnamelist) @@ -1630,18 +1629,18 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) end if !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO, rc=dbrc) !call shr_nuopc_methods_FB_reset(FB, value=spval, rc=rc) - !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), dataPtr1, dataPtr2, lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -1708,18 +1707,18 @@ subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) ! Determine number of fields in field bundle and allocate memory for lfieldnamelist call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) ! Get the fields in the field bundle call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! For each field in the bundle, get its memory location and print out the field do n = 1, fieldCount call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), & fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -1796,7 +1795,7 @@ subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) endif call ESMF_ArrayGet(Array, farrayPtr=dataPtr3d, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring), & minval(dataPtr3d), maxval(dataPtr3d), sum(dataPtr3d) @@ -1845,16 +1844,16 @@ subroutine shr_nuopc_methods_State_diagnose(State, string, rc) endif call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call shr_nuopc_methods_State_GetFldPtr(State, lfieldnamelist(n), & fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then if (lrank == 0) then ! no local data @@ -1930,7 +1929,7 @@ subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) endif call shr_nuopc_methods_FB_GetFldPtr(FB, fieldname, dataPtr1d, dataPtr2d, lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -1987,7 +1986,7 @@ subroutine shr_nuopc_methods_FB_copyFB2FB(FBout, FBin, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -2016,7 +2015,7 @@ subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_accum(STout, FBin, copy=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -2044,7 +2043,7 @@ subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_accum(FBout, STin, copy=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -2090,19 +2089,19 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) endif call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(lfieldnamelist(fieldCount)) call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount call ESMF_FieldBundleGet(FBin, fieldName=lfieldnamelist(n), isPresent=exists, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (exists) then call shr_nuopc_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtri1, dataPtri2, lranki, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtro1, dataPtro2, lranko, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lranki == 1 .and. lranko == 1) then @@ -2210,13 +2209,13 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) do n = 1, fieldCount call ESMF_StateGet(STin, itemName=lfieldnamelist(n), itemType=itemType, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (itemType /= ESMF_STATEITEM_NOTFOUND) then call shr_nuopc_methods_State_GetFldPtr(STin, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrankB == 0 .and. lrankS == 0) then @@ -2329,13 +2328,13 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) call ESMF_FieldBundleGet(FBin, fieldNameList=lfieldnamelist, rc=rc) do n = 1, fieldCount call ESMF_StateGet(STout, itemName=lfieldnamelist(n), itemType=itemType, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (itemType /= ESMF_STATEITEM_NOTFOUND) then call shr_nuopc_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_GetFldPtr(STout, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrankB == 0 .and. lrankS == 0) then @@ -2426,7 +2425,7 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) shr_nuopc_methods_FB_FldChk = .false. call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then shr_nuopc_methods_FB_FldChk = .true. endif @@ -2484,7 +2483,7 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor lrank = -99 call ESMF_FieldGet(field, status=status, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status /= ESMF_FIELDSTATUS_COMPLETE) then lrank = 0 @@ -2498,17 +2497,17 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor else call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (geomtype == ESMF_GEOMTYPE_MESH) then lrank = 1 call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nnodes == 0 .and. nelements == 0) lrank = 0 else ! geomtype call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & @@ -2528,7 +2527,7 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor return endif call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_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 ", & @@ -2537,7 +2536,7 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor return endif call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_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=dbrc) @@ -2601,11 +2600,11 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, r endif call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Field_GetFldPtr(lfield, & fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(rank)) then rank = lrank @@ -2642,7 +2641,7 @@ subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -2700,11 +2699,11 @@ subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank rc = ESMF_SUCCESS call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Field_GetFldPtr(lfield, & fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (present(rank)) then rank = lrank @@ -2741,7 +2740,7 @@ subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) rc = ESMF_SUCCESS call shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, lrank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data @@ -2784,7 +2783,7 @@ logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & ubound(fldptr2,1) /= ubound(fldptr1,1)) then call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) @@ -2823,7 +2822,7 @@ logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & ubound(fldptr2,1) /= ubound(fldptr1,1)) then call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) @@ -2857,13 +2856,13 @@ subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) rc = ESMF_SUCCESS call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then call shr_nuopc_methods_State_GetFieldN(state, 1, lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) endif ! fieldCount > 0 @@ -2894,12 +2893,12 @@ subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) endif ! fieldCount > 0 @@ -2935,7 +2934,7 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) rc = ESMF_SUCCESS call ESMF_FieldGet(field, status=status, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) @@ -2944,37 +2943,37 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) endif call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field, grid=lgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Grid_Print(lgrid, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Mesh_Print(lmesh, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif call shr_nuopc_methods_Field_GetFldPtr(field, & fldptr1=dataPtr1, fldptr2=dataPtr2, rank=lrank, abort=.false., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (lrank == 0) then ! no local data elseif (lrank == 1) then write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr1,1),ubound(dataptr1,1) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (lrank == 2) then write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr2,1),ubound(dataptr2,1) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=2 ",lbound(dataptr2,2),ubound(dataptr2,2) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (lrank == 0) then ! means data allocation does not exist yet continue @@ -3020,129 +3019,129 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) call ESMF_MeshGet(mesh, elementDistGridIsPresent=elemDGPresent, & nodalDistgridIsPresent=nodeDGPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, status=meshStatus, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! first get the distgrid, which should be available if (elemDGPresent) then call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=element" call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & tileCount=tileCount, deCount=deCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount allocate(minIndexPTile(dimCount, tileCount), & maxIndexPTile(dimCount, tileCount)) - + ! get minIndex and maxIndex arrays call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(minIndexPTile, maxIndexPTile) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) endif if (nodeDGPresent) then call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=nodal" call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & tileCount=tileCount, deCount=deCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount allocate(minIndexPTile(dimCount, tileCount), & maxIndexPTile(dimCount, tileCount)) - + ! get minIndex and maxIndex arrays call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(minIndexPTile, maxIndexPTile) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) endif if (.not. elemDGPresent .and. .not. nodeDGPresent) then - call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & + call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & ESMF_LOGMSG_WARNING, rc=rc) return endif ! if mesh is complete, also get additional parameters - if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then + if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then ! access localDeCount to show this is a real Grid call ESMF_MeshGet(mesh, parametricDim=pdim, spatialDim=sdim, & numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": parametricDim=", pdim call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) write (msgString,*) trim(subname)//":"//trim(string)//": spatialDim=", sdim @@ -3151,9 +3150,9 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedElements=", nelements call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif - + if (dbug_flag > 10) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) endif @@ -3192,27 +3191,27 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) ! access localDeCount to show this is a real Grid call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get dimCount and tileCount call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, deCount=deCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount allocate(minIndexPTile(dimCount, tileCount), & @@ -3221,40 +3220,40 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) ! get minIndex and maxIndex arrays call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(minIndexPTile, maxIndexPTile) ! get staggerlocCount, arbDimCount ! call ESMF_GridGet(grid, staggerlocCount=staggerlocCount, rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! write (msgString,*) trim(subname)//":"//trim(string)//": staggerlocCount=", staggerlocCount ! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! call ESMF_GridGet(grid, arbDimCount=arbDimCount, rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! write (msgString,*) trim(subname)//":"//trim(string)//": arbDimCount=", arbDimCount ! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get rank call ESMF_GridGet(grid, rank=rank, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(string)//": rank=", rank call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n1 = 1,2 if (n1 == 1) then @@ -3266,28 +3265,28 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) else rc = ESMF_FAILURE call ESMF_LogWrite(trim(subname)//":staggerloc failure", ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif call ESMF_GridGetCoord(grid, staggerloc=staggerloc, isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,*) trim(subname)//":"//trim(staggerstr)//" present=",isPresent call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then do n3 = 0,localDECount-1 do n2 = 1,dimCount if (rank == 1) then call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr1,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr1),maxval(fldptr1) endif if (rank == 2) then call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr2,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr2),maxval(fldptr2) endif call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo enddo endif @@ -3328,27 +3327,27 @@ subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) endif call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) call ESMF_ClockGet(clock,starttime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) call ESMF_ClockGet(clock,stoptime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) call ESMF_ClockGet(clock,timestep=timestep,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) if (dbug_flag > 5) then @@ -3386,12 +3385,12 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) !--- elements --- call ESMF_MeshGet(mesh, spatialDim=ndims, numownedElements=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(rawdata(ndims*lsize)) allocate(coord(lsize)) call ESMF_MeshGet(mesh, elementDistgrid=distgrid, ownedElemCoords=rawdata, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ndims name = "unknown" @@ -3401,13 +3400,13 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) i = 2*(l-1) + n coord(l) = rawdata(i) array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo enddo @@ -3416,12 +3415,12 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) !--- nodes --- call ESMF_MeshGet(mesh, spatialDim=ndims, numownedNodes=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return allocate(rawdata(ndims*lsize)) allocate(coord(lsize)) call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, ownedNodeCoords=rawdata, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ndims name = "unknown" @@ -3431,13 +3430,13 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) i = 2*(l-1) + n coord(l) = rawdata(i) array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo enddo @@ -3471,13 +3470,13 @@ subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) rc = ESMF_SUCCESS call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then call shr_nuopc_methods_State_getFieldN(state, 1, lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) endif ! fieldCount > 0 @@ -3508,13 +3507,13 @@ subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then call shr_nuopc_methods_FB_getFieldN(FB, 1, lfield, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) endif ! fieldCount > 0 @@ -3546,7 +3545,7 @@ subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) rc = ESMF_SUCCESS call ESMF_FieldGet(field, status=status, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE @@ -3554,18 +3553,18 @@ subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) endif call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field, grid=lgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Grid_Write(lgrid, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Mesh_Write(lmesh, string, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif if (dbug_flag > 10) then @@ -3601,64 +3600,64 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) ! -- centers -- call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then name = "lon_center" call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return name = "lat_center" call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif ! -- corners -- call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then name = "lon_corner" call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif name = "lat_corner" call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -3666,38 +3665,38 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) name = "mask" call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif ! -- area -- name = "area" call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent) then call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArraySet(array, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//trim(name), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif if (dbug_flag > 10) then @@ -3733,11 +3732,11 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) call ESMF_DistGridGet(distGrid1, & dimCount=dimCount1, tileCount=tileCount1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distGrid2, & dimCount=dimCount2, tileCount=tileCount2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if ( dimCount1 /= dimCount2) then shr_nuopc_methods_Distgrid_Match = .false. @@ -3766,13 +3765,13 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) elementCountPTile=elementCountPTile1, & minIndexPTile=minIndexPTile1, & maxIndexPTile=maxIndexPTile1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_DistGridGet(distGrid2, & elementCountPTile=elementCountPTile2, & minIndexPTile=minIndexPTile2, & maxIndexPTile=maxIndexPTile2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if ( ANY((elementCountPTile1 - elementCountPTile2) .NE. 0) ) then shr_nuopc_methods_Distgrid_Match = .false. @@ -3816,29 +3815,26 @@ end function shr_nuopc_methods_Distgrid_Match !================================================================================ - subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, mpicom, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scalar_name, flds_scalar_num, rc) use med_constants_mod , only : R8 - !use mpi , only : mpi_comm_rank, MPI_REAL8, mpi_bcast !TODO: mpi_bcast use does not seem to work on hobart - use mpi use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FAILURE, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite - use ESMF , only : ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_VM, ESMF_VMBroadCast, ESMF_VMGetCurrent ! ---------------------------------------------- ! Get scalar data from State for a particular name and broadcast it to all other pets - ! in mpicom ! ---------------------------------------------- type(ESMF_State), intent(in) :: State integer, intent(in) :: scalar_id real(R8), intent(out) :: value - integer, intent(in) :: mpicom character(len=*), intent(in) :: flds_scalar_name integer, intent(in) :: flds_scalar_num integer, intent(inout) :: rc ! local variables integer :: mytask, ierr, len + type(ESMF_VM) :: vm type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) integer :: dbrc @@ -3846,41 +3842,40 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, mpicom, fl rc = ESMF_SUCCESS - call MPI_COMM_RANK(mpicom, mytask, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u, mpierr=.true.)) return + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif - value = farrayptr(1,scalar_id) endif + call ESMF_VMBroadCast(vm, farrayptr(:,scalar_id), 1, 0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + value = farrayptr(1,scalar_id) - call MPI_BCAST(value, 1, MPI_REAL8, 0, mpicom, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u, mpierr=.true.)) return end subroutine shr_nuopc_methods_State_GetScalar !================================================================================ - subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, mpicom, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- use med_constants_mod , only : R8 use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet, ESMF_FieldGet - use mpi , only : MPI_COMM_RANK - + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet real(R8), intent(in) :: value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State - integer, intent(in) :: mpicom character(len=*), intent(in) :: flds_scalar_name integer, intent(in) :: flds_scalar_num integer, intent(inout) :: rc @@ -3888,20 +3883,25 @@ subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, mpicom, fl ! local variables integer :: mytask type(ESMF_Field) :: field + type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetScalar)' rc = ESMF_SUCCESS - call MPI_COMM_RANK(mpicom, mytask, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u, mpierr=.true.)) return + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (mytask == 0) then call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE @@ -3931,11 +3931,11 @@ subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) rc = ESMF_SUCCESS call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return do i=1, size(fieldList) call shr_nuopc_methods_Field_UpdateTimestamp(fieldList(i), time, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo end subroutine shr_nuopc_methods_State_UpdateTimestamp @@ -3958,12 +3958,12 @@ subroutine shr_nuopc_methods_Field_UpdateTimestamp(field, time, rc) call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, ms=ms, us=us, & ns=ns, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(field, & name="TimeStamp", valueList=(/yy,mm,dd,h,m,s,ms,us,ns/), & convention="NUOPC", purpose="Instance", & attnestflag=ESMF_ATTNEST_ON, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine shr_nuopc_methods_Field_UpdateTimestamp From ba82262d3e6f10e258d36415fbb8db5a7943c742 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 29 Nov 2018 20:11:26 -0700 Subject: [PATCH 2/8] more mpicom cleanup --- src/drivers/nuopc/cime_driver/esm.F90 | 8 - src/drivers/nuopc/cime_flds/esmFlds.F90 | 19 +- src/drivers/nuopc/mediator/med.F90 | 8 +- .../nuopc/mediator/med_connectors_mod.F90 | 468 +++++------------- .../nuopc/mediator/med_infodata_mod.F90 | 29 +- .../nuopc/mediator/med_internalstate_mod.F90 | 3 +- src/drivers/nuopc/mediator/med_io_mod.F90 | 100 ++-- .../nuopc/mediator/med_phases_history_mod.F90 | 6 +- .../nuopc/mediator/med_phases_restart_mod.F90 | 25 +- src/drivers/nuopc/shr/shr_nuopc_time_mod.F90 | 2 - 10 files changed, 209 insertions(+), 459 deletions(-) diff --git a/src/drivers/nuopc/cime_driver/esm.F90 b/src/drivers/nuopc/cime_driver/esm.F90 index 46e39529d52..2ef4b77172c 100644 --- a/src/drivers/nuopc/cime_driver/esm.F90 +++ b/src/drivers/nuopc/cime_driver/esm.F90 @@ -1645,14 +1645,8 @@ subroutine esm_finalize(driver, rc) character(CL) :: timing_dir ! timing directory character(len=5) :: inst_suffix logical :: isPresent - type(ESMF_VM) :: vm - integer :: mpicomm rc = ESMF_SUCCESS - call ESMF_GridCompGet(driver, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="timing_dir",value=timing_dir, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1665,8 +1659,6 @@ subroutine esm_finalize(driver, rc) else inst_suffix = "" endif - call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), & - mpicom=mpicomm) call t_finalizef() diff --git a/src/drivers/nuopc/cime_flds/esmFlds.F90 b/src/drivers/nuopc/cime_flds/esmFlds.F90 index 2526ca179ce..39d42096306 100644 --- a/src/drivers/nuopc/cime_flds/esmFlds.F90 +++ b/src/drivers/nuopc/cime_flds/esmFlds.F90 @@ -63,15 +63,12 @@ subroutine esmFlds_Init(gcomp, rc) integer :: ice_ncat ! number of sea ice thickness categories integer :: glc_nec ! number of land-ice elevation classes integer :: max_megan - integer :: max_ddep + integer :: max_ddep integer :: max_fire logical :: flds_i2o_per_cat integer :: dbrc - type(ESMF_VM) :: vm - integer :: localPet integer :: num, i, n integer :: n1, n2, n3, n4 - integer :: mpicom character(len=3) :: cnum character(len=CL) :: cvalue character(len=CS) :: name, fldname @@ -120,17 +117,11 @@ subroutine esmFlds_Init(gcomp, rc) max_ddep = 80 max_fire = 10 glc_nec = 10 - ice_ncat = 5 + ice_ncat = 5 flds_i2o_per_cat = .true. rc = ESMF_SUCCESS - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a @@ -1328,7 +1319,7 @@ subroutine esmFlds_Init(gcomp, rc) end if !----------------------------- - ! lnd -> glc + ! lnd -> glc !----------------------------- ! glc fields with multiple elevation classes: lnd->glc @@ -1468,7 +1459,7 @@ subroutine esmFlds_Init(gcomp, rc) !-------------------------------------------- ! Atmospheric specific humidty at lowest level: !-------------------------------------------- - + call shr_nuopc_fldList_AddFld(fldListFr(compatm)%flds, 'Sa_shum_16O', fldindex=n1) call shr_nuopc_fldList_AddMap(fldListFr(compatm)%flds(n1), compatm, complnd, mapbilnr, 'one', atm2lnd_smapname) call shr_nuopc_fldList_AddMap(fldListFr(compatm)%flds(n1), compatm, compice, mapbilnr, 'one', atm2ice_smapname) @@ -1572,7 +1563,7 @@ subroutine esmFlds_Init(gcomp, rc) !------------- ! Isotopic snow: !------------- - + call shr_nuopc_fldList_AddFld(fldListFr(compatm)%flds, 'Faxa_snowl_16O', fldindex=n1) call shr_nuopc_fldList_AddMap(fldListFr(compatm)%flds(n1), compatm, complnd, mapbilnr, 'one', atm2lnd_smapname) call shr_nuopc_fldList_AddMap(fldListFr(compatm)%flds(n1), compatm, compice, mapconsf, 'one', atm2ice_fmapname) diff --git a/src/drivers/nuopc/mediator/med.F90 b/src/drivers/nuopc/mediator/med.F90 index 3bd494720a4..15162540ff4 100644 --- a/src/drivers/nuopc/mediator/med.F90 +++ b/src/drivers/nuopc/mediator/med.F90 @@ -646,7 +646,6 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) ! Realize connected Fields with transfer action "provide" - use MPI , only : MPI_Comm_Dup use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_TimeInterval use ESMF , only : ESMF_VMGet, ESMF_StateIsCreated, ESMF_GridCompGet @@ -667,7 +666,6 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) integer :: i, j real(kind=R8),pointer :: lonPtr(:), latPtr(:) type(InternalState) :: is_local - integer :: lmpicom real(R8) :: intervalSec type(ESMF_TimeInterval) :: timeStep ! tcx XGrid @@ -693,9 +691,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize the internal state members - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call MPI_Comm_Dup(lmpicom, is_local%wrap%mpicom, stat) + is_local%wrap%vm = vm ! Realize States do n = 1,ncomps @@ -1750,7 +1746,7 @@ subroutine DataInitialize(gcomp, rc) if (atCorrectTime) then if (fieldNameList(n) == flds_scalar_name) then call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(n1), med_infodata, & - trim(compname(n1))//'2cpli', is_local%wrap%mpicom, rc) + trim(compname(n1))//'2cpli', is_local%wrap%vm, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & ESMF_LOGMSG_INFO, rc=rc) diff --git a/src/drivers/nuopc/mediator/med_connectors_mod.F90 b/src/drivers/nuopc/mediator/med_connectors_mod.F90 index 12390c02a08..ca3bff37c6a 100644 --- a/src/drivers/nuopc/mediator/med_connectors_mod.F90 +++ b/src/drivers/nuopc/mediator/med_connectors_mod.F90 @@ -7,10 +7,9 @@ module med_connectors_mod use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_Failure use ESMF , only : ESMF_State, ESMF_Clock, ESMF_GridComp use med_internalstate_mod , only : InternalState - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr use med_constants_mod , only : spval => med_constants_spval use med_constants_mod , only : czero => med_constants_czero - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag implicit none private @@ -48,11 +47,8 @@ module med_connectors_mod contains !----------------------------------------------------------------------------- - subroutine med_connectors_prep_generic(gcomp, type, rc) - - use ESMF , only : ESMF_GridCompGet - use esmFlds , only : compatm, compocn, compice - use esmFlds , only : complnd, comprof, compwav, compglc + subroutine med_connectors_prep_generic(gcomp, type, compid, rc) + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet use med_infodata_mod , only : med_infodata_CopyStateToInfodata use med_infodata_mod , only : med_infodata_CopyInfodataToState use med_infodata_mod , only : med_infodata @@ -62,6 +58,7 @@ subroutine med_connectors_prep_generic(gcomp, type, rc) ! input/output variables type(ESMF_GridComp) :: gcomp character(len=*), intent(in) :: type + integer, intent(in) :: compid integer, intent(out) :: rc ! local variables @@ -71,143 +68,56 @@ subroutine med_connectors_prep_generic(gcomp, type, rc) logical :: connected integer :: n integer :: dbrc + integer :: mytask + character(len=10) :: med2comp + character(len=7) :: cpl2comp character(len=*),parameter :: subname='(med_connectors_prep_generic)' !--------------------------------------------- call t_startf('MED:'//subname) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(is_local%wrap%vm, localPet=mytask, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !------------------------- ! diagnose export state ! update scalar data in Exp and Imp State !------------------------- + med2comp = "med_to_"//type + cpl2comp = "cpl2"//type + + is_local%wrap%conn_prep_cnt(compid) = is_local%wrap%conn_prep_cnt(compid) + 1 + call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compid), value=spval, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compid), is_local%wrap%FBExp(compid), rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_connectors_diagnose(is_local%wrap%NStateExp(compid), is_local%wrap%conn_prep_cnt(compid), med2comp, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compid), cpl2comp, mytask, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compid), cpl2comp, mytask, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) - select case (type) - - case('atm') - is_local%wrap%conn_prep_cnt(compatm) = is_local%wrap%conn_prep_cnt(compatm) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compatm), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compatm), is_local%wrap%FBExp(compatm), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compatm), is_local%wrap%conn_prep_cnt(compatm), "med_to_atm", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compatm),'cpl2atm',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compatm),'cpl2atm',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('ocn') - is_local%wrap%conn_prep_cnt(compocn) = is_local%wrap%conn_prep_cnt(compocn) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compocn), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compocn), is_local%wrap%FBExp(compocn), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compocn), is_local%wrap%conn_prep_cnt(compocn), "med_to_ocn", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compocn),'cpl2ocn',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compocn),'cpl2ocn',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('ice') - is_local%wrap%conn_prep_cnt(compice) = is_local%wrap%conn_prep_cnt(compice) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compice), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compice), is_local%wrap%FBExp(compice), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compice), is_local%wrap%conn_prep_cnt(compice), "med_to_ice", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compice),'cpl2ice',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compice),'cpl2ice',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('lnd') - is_local%wrap%conn_prep_cnt(complnd) = is_local%wrap%conn_prep_cnt(complnd) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(complnd), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(complnd), is_local%wrap%FBExp(complnd), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(complnd), is_local%wrap%conn_prep_cnt(complnd), "med_to_lnd", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(complnd),'cpl2lnd',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(complnd),'cpl2lnd',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('rof') - is_local%wrap%conn_prep_cnt(comprof) = is_local%wrap%conn_prep_cnt(comprof) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(comprof), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(comprof), is_local%wrap%FBExp(comprof), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(comprof), is_local%wrap%conn_prep_cnt(comprof), "med_to_rof", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(comprof),'cpl2rof',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(comprof),'cpl2rof',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('wav') - is_local%wrap%conn_prep_cnt(compwav) = is_local%wrap%conn_prep_cnt(compwav) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compwav), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compwav), is_local%wrap%FBExp(compwav), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compwav), is_local%wrap%conn_prep_cnt(compwav), "med_to_wav", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compwav),'cpl2wav',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compwav),'cpl2wav',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('glc') - is_local%wrap%conn_prep_cnt(compglc) = is_local%wrap%conn_prep_cnt(compglc) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compglc), value=spval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compglc), is_local%wrap%FBExp(compglc), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compglc), is_local%wrap%conn_prep_cnt(compglc), "med_to_glc", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compglc),'cpl2glc',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compglc),'cpl2glc',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case default - rc = ESMF_Failure - call ESMF_LogWrite(trim(subname)//trim(type)//" unsupported", ESMF_LOGMSG_INFO, rc=dbrc) - - end select - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif call t_stopf('MED:'//subname) end subroutine med_connectors_prep_generic !----------------------------------------------------------------------------- - subroutine med_connectors_post_generic(gcomp, type, rc) + subroutine med_connectors_post_generic(gcomp, type, compid, rc) use ESMF , only : ESMF_GridCompGet - use esmFlds , only : compatm, compocn, compice - use esmFlds , only : complnd, comprof, compwav, compglc use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use med_infodata_mod , only : med_infodata @@ -216,126 +126,54 @@ subroutine med_connectors_post_generic(gcomp, type, rc) ! input/output variables type(ESMF_GridComp) :: gcomp character(len=*), intent(in) :: type + integer, intent(in) :: compid integer, intent(out) :: rc ! local variables type(ESMF_Clock) :: clock type(InternalState) :: is_local integer :: dbrc + character(len=10) :: comp2med + character(len=7) :: comp2cpl character(len=*),parameter :: subname='(med_connectors_post_generic)' !--------------------------------------------- ! Note: for information obtained by the mediator always write out the state ! if statewrite_flag is .true. + rc = ESMF_SUCCESS call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return !------------------------- ! diagnose import state ! copy import state scalar data to local datatype !------------------------- + comp2med = "med_from_"//type + comp2cpl = type//"2cpl" + + is_local%wrap%conn_post_cnt(compid) = is_local%wrap%conn_post_cnt(compid) + 1 + call med_connectors_diagnose(is_local%wrap%NStateImp(compid), is_local%wrap%conn_post_cnt(compid),comp2med, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compid),med_infodata, comp2cpl ,is_local%wrap%vm,rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compid,compid), value=czero, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compid,compid), is_local%wrap%NStateImp(compid), rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) - select case (type) - - case('atm') - is_local%wrap%conn_post_cnt(compatm) = is_local%wrap%conn_post_cnt(compatm) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compatm), is_local%wrap%conn_post_cnt(compatm), " med_from_atm", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compatm),med_infodata,'atm2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compatm,compatm), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compatm,compatm), is_local%wrap%NStateImp(compatm), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('ocn') - is_local%wrap%conn_post_cnt(compocn) = is_local%wrap%conn_post_cnt(compocn) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compocn), is_local%wrap%conn_post_cnt(compocn), " med_from_ocn", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compocn),med_infodata,'ocn2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compocn,compocn), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compocn,compocn), is_local%wrap%NStateImp(compocn), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('ice') - is_local%wrap%conn_post_cnt(compice) = is_local%wrap%conn_post_cnt(compice) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compice), is_local%wrap%conn_post_cnt(compice), " med_from_ice", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compice),med_infodata,'ice2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compice,compice), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compice,compice), is_local%wrap%NStateImp(compice), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('lnd') - is_local%wrap%conn_post_cnt(complnd) = is_local%wrap%conn_post_cnt(complnd) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(complnd), is_local%wrap%conn_post_cnt(complnd), " med_from_lnd", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(complnd),med_infodata,'lnd2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(complnd,complnd), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(complnd,complnd), is_local%wrap%NStateImp(complnd), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('rof') - is_local%wrap%conn_post_cnt(comprof) = is_local%wrap%conn_post_cnt(comprof) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(comprof), is_local%wrap%conn_post_cnt(comprof), " med_from_rof", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(comprof),med_infodata,'rof2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(comprof,comprof), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(comprof,comprof), is_local%wrap%NStateImp(comprof), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('wav') - is_local%wrap%conn_post_cnt(compwav) = is_local%wrap%conn_post_cnt(compwav) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compwav), is_local%wrap%conn_post_cnt(compwav), " med_from_wav", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compwav),med_infodata,'wav2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compwav,compwav), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compwav,compwav), is_local%wrap%NStateImp(compwav), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case('glc') - is_local%wrap%conn_post_cnt(compglc) = is_local%wrap%conn_post_cnt(compglc) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compglc), is_local%wrap%conn_post_cnt(compglc), " med_from_glc", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compglc),med_infodata,'glc2cpl',is_local%wrap%mpicom,rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compglc,compglc), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compglc,compglc), is_local%wrap%NStateImp(compglc), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case default - rc = ESMF_Failure - call ESMF_LogWrite(trim(subname)//trim(type)//" unsupported", ESMF_LOGMSG_INFO, rc=dbrc) - - end select - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif call t_stopf('MED:'//subname) end subroutine med_connectors_post_generic @@ -344,6 +182,7 @@ end subroutine med_connectors_post_generic subroutine med_connectors_prep_med2atm(gcomp, rc) use perf_mod, only : t_startf, t_stopf + use esmFlds, only : compatm type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -353,17 +192,14 @@ subroutine med_connectors_prep_med2atm(gcomp, rc) !--------------------------------------------- call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'atm', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'atm', compatm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) call t_stopf('MED:'//subname) end subroutine med_connectors_prep_med2atm @@ -371,6 +207,7 @@ end subroutine med_connectors_prep_med2atm !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2ocn(gcomp, rc) + use esmFlds, only : compocn type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -379,23 +216,21 @@ subroutine med_connectors_prep_med2ocn(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2ocn)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'ocn', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'ocn', compocn, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2ocn !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2ice(gcomp, rc) + use esmFlds, only : compice type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -404,23 +239,20 @@ subroutine med_connectors_prep_med2ice(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2ice)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'ice', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'ice', compice, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2ice !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2lnd(gcomp, rc) + use esmFlds, only : complnd type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -429,23 +261,20 @@ subroutine med_connectors_prep_med2lnd(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2lnd)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'lnd', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'lnd', complnd, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2lnd !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2rof(gcomp, rc) + use esmFlds, only : comprof type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -454,23 +283,20 @@ subroutine med_connectors_prep_med2rof(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2rof)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'rof', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'rof', comprof, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2rof !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2wav(gcomp, rc) + use esmFlds, only : compwav type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -479,23 +305,21 @@ subroutine med_connectors_prep_med2wav(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2wav)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'wav', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'wav', compwav, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2wav !----------------------------------------------------------------------------- subroutine med_connectors_prep_med2glc(gcomp, rc) + use esmFlds, only : compglc type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -504,23 +328,20 @@ subroutine med_connectors_prep_med2glc(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_prep_med2glc)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_prep_generic(gcomp, 'glc', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_prep_generic(gcomp, 'glc', compglc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_prep_med2glc !----------------------------------------------------------------------------- subroutine med_connectors_post_atm2med(gcomp, rc) + use esmFlds, only : compatm type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -529,23 +350,21 @@ subroutine med_connectors_post_atm2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_atm2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'atm', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'atm', compatm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_atm2med !----------------------------------------------------------------------------- subroutine med_connectors_post_ocn2med(gcomp, rc) + use esmFlds, only : compocn type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -554,23 +373,20 @@ subroutine med_connectors_post_ocn2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_ocn2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'ocn', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'ocn', compocn, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_ocn2med !----------------------------------------------------------------------------- subroutine med_connectors_post_ice2med(gcomp, rc) + use esmFlds, only : compice type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -579,23 +395,20 @@ subroutine med_connectors_post_ice2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_ice2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'ice', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'ice', compice, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_ice2med !----------------------------------------------------------------------------- subroutine med_connectors_post_lnd2med(gcomp, rc) + use esmFlds, only : complnd type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -604,23 +417,20 @@ subroutine med_connectors_post_lnd2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_lnd2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'lnd', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'lnd', complnd, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_lnd2med !----------------------------------------------------------------------------- subroutine med_connectors_post_rof2med(gcomp, rc) + use esmFlds, only : comprof type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -629,23 +439,20 @@ subroutine med_connectors_post_rof2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_rof2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'rof', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'rof', comprof, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_rof2med !----------------------------------------------------------------------------- subroutine med_connectors_post_wav2med(gcomp, rc) + use esmFlds, only : compwav type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -654,23 +461,21 @@ subroutine med_connectors_post_wav2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_wav2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'wav', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'wav', compwav, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_wav2med !----------------------------------------------------------------------------- subroutine med_connectors_post_glc2med(gcomp, rc) + use esmFlds, only : compglc type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -679,17 +484,13 @@ subroutine med_connectors_post_glc2med(gcomp, rc) character(len=*),parameter :: subname='(med_connectors_post_glc2med)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS - call med_connectors_post_generic(gcomp, 'glc', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_connectors_post_generic(gcomp, 'glc', compglc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_post_glc2med @@ -701,6 +502,7 @@ subroutine med_connectors_diagnose(State, cntr, string, rc) use NUOPC , only : NUOPC_Write use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_diagnose use med_constants_mod , only : statewrite_flag => med_constants_statewrite_flag + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag ! input/output variables type(ESMF_State), intent(in) :: State @@ -715,18 +517,16 @@ subroutine med_connectors_diagnose(State, cntr, string, rc) character(len=*),parameter :: subname='(med_connectors_diagnose)' !--------------------------------------------- - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(string)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//trim(string)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return ! Obtain the field names in State - allocate memory which will be deallocated at the end allocate(fieldnamelist(fieldCount)) call ESMF_StateGet(State, itemNameList=fieldnamelist, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call shr_nuopc_methods_State_diagnose(State, string=trim(subname)//trim(string), rc=rc) @@ -734,19 +534,17 @@ subroutine med_connectors_diagnose(State, cntr, string, rc) ! Write out the fields in State to netcdf files if (cntr > 0 .and. statewrite_flag) then - call ESMF_LogWrite(trim(subname)//trim(string)//": writing out fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//trim(string)//": writing out fields", ESMF_LOGMSG_INFO, rc=rc) call NUOPC_Write(State, & fieldnamelist(1:fieldCount), & "field_"//trim(string)//"_", timeslice=cntr, & overwrite=.true., relaxedFlag=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return endif deallocate(fieldnamelist) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(string)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//trim(string)//": done", ESMF_LOGMSG_INFO, rc=rc) end subroutine med_connectors_diagnose diff --git a/src/drivers/nuopc/mediator/med_infodata_mod.F90 b/src/drivers/nuopc/mediator/med_infodata_mod.F90 index 0e1f07a6097..af0d3786b2a 100644 --- a/src/drivers/nuopc/mediator/med_infodata_mod.F90 +++ b/src/drivers/nuopc/mediator/med_infodata_mod.F90 @@ -111,11 +111,12 @@ subroutine med_infodata_init2(infodata) end subroutine med_infodata_init2 !================================================================================ - subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) + subroutine med_infodata_CopyStateToInfodata(State, infodata, type, vm, rc) use ESMF , only : ESMF_State, ESMF_Field, ESMF_StateItem_Flag use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_LogWrite use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO use ESMF , only : ESMF_STATEITEM_NOTFOUND, operator(==) + use ESMF , only : ESMF_VMBroadCast, ESMF_VM, ESMF_VMGet use esmFlds , only : compname use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny @@ -123,9 +124,6 @@ subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) use shr_nuopc_scalars_mod , only : flds_scalar_index_flood_present use shr_nuopc_scalars_mod , only : flds_scalar_index_rofice_present use shr_nuopc_scalars_mod , only : flds_scalar_index_precip_fact - ! use mpi , only : mpi_comm_rank, MPI_ERROR_STRING, mpi_bcast, mpi_real8, MPI_SUCCESS - ! use mpi , only : MPI_MAX_ERROR_STRING - use mpi ! TODO - have an only for mpi_bcast does not work on hobart use shr_nuopc_methods_mod , only : shr_nuopc_methods_chkErr ! ---------------------------------------------- @@ -136,13 +134,12 @@ subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) type(ESMF_State), intent(in) :: State type(med_infodata_type), intent(inout) :: infodata character(len=*), intent(in) :: type - integer, intent(in) :: mpicom + type(ESMF_VM) :: vm integer, intent(inout) :: rc ! local variables integer :: n integer :: mytask, ierr, len - character(MPI_MAX_ERROR_STRING) :: lstring type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: itemType real(R8), pointer :: farrayptr(:,:) @@ -154,8 +151,9 @@ subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) !---------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call MPI_COMM_RANK(mpicom, mytask, rc) call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -177,13 +175,8 @@ subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) data(1:flds_scalar_num) = farrayptr(1,1:flds_scalar_num) endif - call MPI_BCAST(data, flds_scalar_num, MPI_REAL8, 0, mpicom, rc) - if (rc /= MPI_SUCCESS) then - call MPI_ERROR_STRING(rc,lstring,len,ierr) - call ESMF_LogWrite(trim(subname)//": ERROR "//trim(lstring), ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call ESMF_VMBroadCast(vm, data, flds_scalar_num, 0, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps ntype = trim(compname(n))//'2cpli' @@ -250,11 +243,10 @@ subroutine med_infodata_CopyStateToInfodata(State, infodata, type, mpicom, rc) end subroutine med_infodata_CopyStateToInfodata !================================================================================ - subroutine med_infodata_CopyInfodataToState(infodata, State, type, mpicom, rc) + subroutine med_infodata_CopyInfodataToState(infodata, State, type, mytask, rc) use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_StateItem_Flag, ESMF_FieldGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_STATEITEM_NOTFOUND use ESMF , only : operator(==), ESMF_FAILURE - use mpi , only : mpi_comm_rank use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday @@ -269,11 +261,10 @@ subroutine med_infodata_CopyInfodataToState(infodata, State, type, mpicom, rc) type(med_infodata_type),intent(in):: infodata type(ESMF_State), intent(inout) :: State character(len=*), intent(in) :: type - integer, intent(in) :: mpicom + integer , intent(in) :: mytask integer, intent(inout) :: rc ! local variables - integer :: mytask type(ESMF_Field) :: field type(ESMF_StateItem_Flag) :: ItemType real(R8), pointer :: farrayptr(:,:) @@ -284,8 +275,6 @@ subroutine med_infodata_CopyInfodataToState(infodata, State, type, mpicom, rc) rc = ESMF_SUCCESS - call MPI_COMM_RANK(mpicom, mytask, rc) - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 index 2138fc7dbeb..e244224ef20 100644 --- a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 +++ b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 @@ -5,6 +5,7 @@ module med_internalstate_mod !----------------------------------------------------------------------------- use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State + use ESMF , only : ESMF_VM use esmFlds , only : ncomps use shr_nuopc_fldList_mod , only : nmappers @@ -64,7 +65,7 @@ module med_internalstate_mod logical :: FBExpAccumFlag(ncomps) = .false. ! Accumulator flag, if true accumulation was done integer :: conn_prep_cnt(ncomps) ! Connector prep count integer :: conn_post_cnt(ncomps) ! Connector post count - integer :: mpicom + type(ESMF_VM) :: vm ! CESM-specific internal state fields type(ESMF_FieldBundle):: FBMed_ocnalb_o ! Ocn albedo on ocn grid diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index e07128d2c09..8775ad31fce 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -2,7 +2,7 @@ module med_io_mod ! !DESCRIPTION: Writes attribute vectors to netcdf ! !USES: - use ESMF, only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VM + use ESMF, only : ESMF_VM use med_constants_mod , only : CL use pio, only : file_desc_t, iosystem_desc_t use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr @@ -60,19 +60,24 @@ module med_io_mod !================================================================================= contains !================================================================================= - subroutine broadcast_logical(vm, exists) - use ESMF, only : ESMF_VM, ESMF_VMBroadCast - type(ESMF_VM) :: vm - logical, intent(inout) :: exists + logical function med_io_file_exists(vm, iam, filename) + use ESMF, only : ESMF_VMBroadCast + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(in) :: filename + + logical :: exists integer :: tmp(1) integer :: rc - if (exists) tmp(1) = 1 + med_io_file_exists = .false. + if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) + if (med_io_file_exists) tmp(1) = 1 call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if(tmp(1) == 1) exists = .true. + if(tmp(1) == 1) med_io_file_exists = .true. - end subroutine broadcast_logical + end function med_io_file_exists subroutine med_io_init() use seq_comm_mct , only : CPLID @@ -84,7 +89,7 @@ subroutine med_io_init() end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! !DESCRIPTION: open netcdf file use pio, only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR use pio, only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef, pio_put_att, pio_redef, pio_get_att @@ -93,12 +98,13 @@ subroutine med_io_wopen(filename, clobber, file_ind, model_doi_url) use med_internalstate_mod, only : logunit ! input/output arguments character(*), intent(in) :: filename + type(ESMF_VM) :: vm + integer, intent(in) :: iam logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url ! local variables - type(ESMF_VM) :: vm logical :: exists logical :: lclobber integer :: tmp(1) @@ -106,15 +112,10 @@ subroutine med_io_wopen(filename, clobber, file_ind, model_doi_url) integer :: nmode integer :: lfile_ind integer :: rc - integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url character(*),parameter :: subName = '(med_io_wopen) ' !------------------------------------------------------------------------------- - call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lversion=trim(version) @@ -131,10 +132,8 @@ subroutine med_io_wopen(filename, clobber, file_ind, model_doi_url) ! filename not open wfilename = filename - if (iam==0) inquire(file=trim(filename),exist=exists) - call broadcast_logical(vm, exists) - if (exists) then + if (med_io_file_exists(vm, iam, filename)) then if (lclobber) then nmode = pio_clobber ! only applies to classic NETCDF files. @@ -936,7 +935,7 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& end subroutine med_io_write_time !=============================================================================== - subroutine med_io_read_FB(filename, FB, pre, rc) + subroutine med_io_read_FB(filename, vm, iam, FB, pre, rc) use med_constants_mod, only : R8, CL use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid @@ -958,12 +957,14 @@ subroutine med_io_read_FB(filename, FB, pre, rc) ! !input/output arguments character(len=*) ,intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer ,intent(in) :: iam type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be written character(len=*),optional ,intent(in) :: pre ! prefix to variable name integer ,intent(out) :: rc ! local variables - type(ESMF_VM) :: vm + type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid @@ -985,7 +986,6 @@ subroutine med_io_read_FB(filename, FB, pre, rc) integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: iam real(r8), pointer :: fldptr1(:) character(CL) :: tmpstr @@ -995,11 +995,6 @@ subroutine med_io_read_FB(filename, FB, pre, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - lpre = ' ' if (present(pre)) then lpre = trim(pre) @@ -1029,10 +1024,8 @@ subroutine med_io_read_FB(filename, FB, pre, rc) endif return endif - if (iam==0) inquire(file=trim(filename),exist=exists) - call broadcast_logical(vm, exists) - if (exists) then + if (med_io_file_exists(vm, iam, trim(filename))) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1135,12 +1128,14 @@ subroutine med_io_read_FB(filename, FB, pre, rc) end subroutine med_io_read_FB !=============================================================================== - subroutine med_io_read_int(filename, idata, dname) + subroutine med_io_read_int(filename, vm, iam, idata, dname) ! !DESCRIPTION: Read scalar integer from netcdf file ! input/output arguments character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam integer , intent(inout) :: idata ! integer data character(len=*) , intent(in) :: dname ! name of data @@ -1149,13 +1144,13 @@ subroutine med_io_read_int(filename, idata, dname) character(*),parameter :: subName = '(med_io_read_int) ' !------------------------------------------------------------------------------- - call med_io_read_int1d(filename, i1d, dname) + call med_io_read_int1d(filename, vm, iam, i1d, dname) idata = i1d(1) end subroutine med_io_read_int !=============================================================================== - subroutine med_io_read_int1d(filename, idata, dname) + subroutine med_io_read_int1d(filename, vm, iam, idata, dname) ! !DESCRIPTION: Read 1d integer array from netcdf file use shr_sys_mod, only : shr_sys_abort use med_constants_mod, only : R8 @@ -1166,29 +1161,25 @@ subroutine med_io_read_int1d(filename, idata, dname) ! input/output arguments character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam integer , intent(inout) :: idata(:) ! integer data character(len=*), intent(in) :: dname ! name of data ! local variables - type(ESMF_VM) :: vm integer :: rcode type(file_desc_t) :: pioid type(var_desc_t) :: varid logical :: exists character(CL) :: lversion character(CL) :: name1 - integer :: iam integer :: rc character(*),parameter :: subName = '(med_io_read_int1d) ' !------------------------------------------------------------------------------- lversion=trim(version) - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (iam==0) inquire(file=trim(filename),exist=exists) - call broadcast_logical(vm, exists) - if (exists) then + if (med_io_file_exists(vm, iam, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -1210,13 +1201,15 @@ subroutine med_io_read_int1d(filename, idata, dname) end subroutine med_io_read_int1d !=============================================================================== - subroutine med_io_read_r8(filename, rdata, dname) + subroutine med_io_read_r8(filename, vm, iam, rdata, dname) use med_constants_mod, only : R8 ! !DESCRIPTION: Read scalar double from netcdf file ! input/output arguments character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam real(r8) , intent(inout) :: rdata ! real data character(len=*) , intent(in) :: dname ! name of data @@ -1225,12 +1218,12 @@ subroutine med_io_read_r8(filename, rdata, dname) character(*),parameter :: subName = '(med_io_read_r8) ' !------------------------------------------------------------------------------- - call med_io_read_r81d(filename, r1d,dname) + call med_io_read_r81d(filename, vm, iam, r1d,dname) rdata = r1d(1) end subroutine med_io_read_r8 !=============================================================================== - subroutine med_io_read_r81d(filename, rdata, dname) + subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) use med_constants_mod, only : R8 use pio, only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling use pio, only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var @@ -1241,16 +1234,17 @@ subroutine med_io_read_r81d(filename, rdata, dname) ! input/output arguments character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam real(r8) , intent(inout) :: rdata(:) ! real data character(len=*), intent(in) :: dname ! name of data ! local variables - type(ESMF_VM) :: vm integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid logical :: exists - integer :: iam + integer :: rc character(CL) :: lversion character(CL) :: name1 @@ -1258,12 +1252,8 @@ subroutine med_io_read_r81d(filename, rdata, dname) !------------------------------------------------------------------------------- lversion=trim(version) - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (iam==0) inquire(file=trim(filename),exist=exists) - call broadcast_logical(vm, exists) - if (exists) then + if (med_io_file_exists(vm, iam, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) rcode = pio_get_att(pioid,pio_global,"file_version",lversion) @@ -1285,7 +1275,7 @@ subroutine med_io_read_r81d(filename, rdata, dname) end subroutine med_io_read_r81d !=============================================================================== - subroutine med_io_read_char(filename, rdata, dname) + subroutine med_io_read_char(filename, vm, iam, rdata, dname) use pio, only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR use pio, only : pio_closefile, pio_inq_varid, pio_get_var use pio, only : pio_openfile, pio_global, pio_get_att, pio_nowrite @@ -1295,16 +1285,16 @@ subroutine med_io_read_char(filename, rdata, dname) ! input/output arguments character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam character(len=*), intent(inout) :: rdata ! character data character(len=*), intent(in) :: dname ! name of data ! local variables - type(ESMF_VM) :: vm integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid logical :: exists - integer :: iam integer :: rc character(CL) :: lversion character(CL) :: name1 @@ -1313,12 +1303,8 @@ subroutine med_io_read_char(filename, rdata, dname) !------------------------------------------------------------------------------- lversion=trim(version) - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (iam==0) inquire(file=trim(filename),exist=exists) - call broadcast_logical(vm, exists) - if (exists) then + if (med_io_file_exists(vm, iam, filename)) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) ! write(logunit,*) subname,' open file ',trim(filename) call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) diff --git a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index 0b489be9b1f..d5ad620d22b 100644 --- a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -73,7 +73,6 @@ subroutine med_phases_history_write(gcomp, rc) type(InternalState) :: is_local character(CS) :: histavg_option ! Histavg option units integer :: i,j,m,n,n1,ncnt - integer :: mpicom, iam integer :: start_ymd ! Starting date YYYYMMDD integer :: start_tod ! Starting time-of-day (s) integer :: nx,ny ! global grid size @@ -93,6 +92,7 @@ subroutine med_phases_history_write(gcomp, rc) real(r8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/history cdf files integer :: dbrc + integer :: iam logical,save :: first_call = .true. character(len=*), parameter :: subname='(med_phases_history_write)' logical :: isPresent @@ -111,7 +111,7 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=mpicom, localPet=iam, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- @@ -249,7 +249,7 @@ subroutine med_phases_history_write(gcomp, rc) write(hist_file,"(6a)") & trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=dbrc) - call med_io_wopen(hist_file, mpicom, iam, clobber=.true.) + call med_io_wopen(hist_file, vm, iam, clobber=.true.) do m = 1,2 whead=.false. diff --git a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index b63bdaa1643..6530b6d17b2 100644 --- a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -83,7 +83,7 @@ subroutine med_phases_restart_write(gcomp, rc) logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/restart cdf files - integer :: iam,mpicom ! vm stuff + integer :: iam ! vm stuff character(len=ESMF_MAXSTR) :: tmpstr integer :: dbrc logical :: isPresent @@ -107,7 +107,7 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=mpicom, localPet=iam, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) @@ -224,7 +224,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) - call med_io_wopen(restart_file, mpicom, iam, clobber=.true.) + call med_io_wopen(restart_file, vm, iam, clobber=.true.) do m = 1,2 if (m == 1) then @@ -333,7 +333,7 @@ subroutine med_phases_restart_read(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -342,7 +342,6 @@ subroutine med_phases_restart_read(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - use shr_mpi_mod , only : shr_mpi_bcast use med_io_mod , only : med_io_read use perf_mod , only : t_startf, t_stopf ! Input/output variables @@ -358,7 +357,7 @@ subroutine med_phases_restart_read(gcomp, rc) integer :: i,j,m,n,n1,ncnt integer :: ierr, unitn integer :: yr,mon,day,sec ! time units - integer :: iam,mpicom ! vm stuff + integer :: iam ! vm stuff character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename @@ -384,7 +383,7 @@ subroutine med_phases_restart_read(gcomp, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, mpiCommunicator=mpicom, rc=rc) + call ESMF_VMGet(vm, localPet=iam, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) @@ -446,31 +445,31 @@ subroutine med_phases_restart_read(gcomp, rc) call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), & ESMF_LOGMSG_INFO, rc=dbrc) endif - call shr_mpi_bcast(restart_file, mpicom) + call ESMF_VMBroadCast(vm, restart_file, len(restart_file), 0, rc=rc) call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) - call med_io_read(restart_file, mpicom, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt') + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt') do n = 1,ncomps if (is_local%wrap%comp_present(n)) then ! Read import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_read(restart_file, mpicom, iam, is_local%wrap%FBimp(n,n), & + call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), & pre=trim(compname(n))//'Imp', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read import fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_read(restart_file, mpicom, iam, is_local%wrap%FBfrac(n), & + call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), & pre=trim(compname(n))//'Frac', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read export field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then - call med_io_read(restart_file, mpicom, iam, is_local%wrap%FBExpAccum(n), & + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), & pre=trim(compname(n))//'ExpAccum', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -479,7 +478,7 @@ subroutine med_phases_restart_read(gcomp, rc) ! Read ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_read(restart_file, mpicom, iam, is_local%wrap%FBMed_ocnalb_o, & + call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, & pre='MedOcnAlb_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/src/drivers/nuopc/shr/shr_nuopc_time_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_time_mod.F90 index bc99ba09b23..0d3ee8d791d 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_time_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_time_mod.F90 @@ -66,7 +66,6 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) use med_constants_mod , only : CL, CS use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_calendarname - use shr_mpi_mod , only : shr_mpi_bcast ! input/output variables type(ESMF_GridComp) :: ensemble_driver, esmdriver @@ -120,7 +119,6 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) character(CL) :: tmpstr ! temporary character(CS) :: calendar_name ! Calendar name character(CS) :: inst_suffix - integer :: mpicom ! MPI communicator integer :: tmp(6) ! Array for Broadcast integer :: dbrc logical :: isPresent From 99fb3ad39f924ac71ad35924819a0000cd5c8a29 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 30 Nov 2018 09:32:14 -0700 Subject: [PATCH 3/8] correct avgdt calculation --- .../nuopc/mediator/med_phases_profile_mod.F90 | 44 ++++++++++--------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 b/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 index c88f5f3a570..ab30230faa4 100644 --- a/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 @@ -10,8 +10,6 @@ module med_phases_profile_mod character(*), parameter :: u_FILE_u = & __FILE__ - integer :: iterations=0 - real(r8) :: previous_time=0_R8, accumulated_time=0_R8 !================================================================================= contains @@ -53,14 +51,16 @@ subroutine med_phases_profile(gcomp, rc) logical :: ispresent logical :: alarmison, stopalarmison real(R8) :: current_time, wallclockelapsed, ypd - real(r8) :: msize, mrss, avgdt, ringdays - integer dbrc + real(r8) :: msize, mrss, ringdays + integer, save :: iterations=0 + real(r8), save :: previous_time=0_R8, accumulated_time=0_R8 + real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr character(len=*), parameter :: subname='(med_phases_profile)' !--------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_SUCCESS call ESMF_VMGetCurrent(vm, rc=rc) @@ -86,7 +86,7 @@ subroutine med_phases_profile(gcomp, rc) ! intialize and return call ESMF_VMWtime(previous_time, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - iterations = iterations + 1 + iterations = 1 else !--------------------------------------- ! --- Get the clock info @@ -121,11 +121,22 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + prevtime = nexttime + call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMWtime(current_time, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + wallclockelapsed = current_time - previous_time + accumulated_time = accumulated_time + wallclockelapsed + if (alarmison) then call ESMF_AlarmGet( alarm, ringInterval=ringInterval, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(ringInterval, d_r8=ringdays, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + avgdt = accumulated_time/(ringdays*real(iterations-1)) else if (stopalarmison) then ! Here we need the interval since the last call to this function call ESMF_TimeIntervalGet(nexttime-prevtime, d_r8=ringdays, rc=rc) @@ -137,39 +148,30 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_TimeIntervalGet(timestep, d_r8=ringdays, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + avgdt = wallclockelapsed/ringdays endif - prevtime = nexttime - call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=dbrc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMWtime(current_time, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - wallclockelapsed = current_time - previous_time - accumulated_time = accumulated_time + wallclockelapsed - ! get current wall clock time call ESMF_TimeSet(wallclocktime, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeSyncToRealTime(wallclocktime, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(wallclocktime,timeString=walltimestr, rc=dbrc) + call ESMF_TimeGet(wallclocktime,timeString=walltimestr, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ! 1 model day/ x seconds = 1/365 yrs/ (wallclockelapsed s/86400spd ypd = ringdays*86400.0_R8/(365.0_R8*wallclockelapsed) - avgdt = accumulated_time/real(iterations) write(logunit,101) 'Model Date: ',trim(nexttimestr), ' wall clock = ',trim(walltimestr),' avg dt = ', & - accumulated_time/(ringdays*real(iterations)), 's/day, dt = ',wallclockelapsed/ringdays,'s/day, rate = ',ypd,' ypd' + avgdt, 's/day, dt = ',wallclockelapsed/ringdays,'s/day, rate = ',ypd,' ypd' call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',trim(nexttimestr), & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)' + iterations = iterations + 1 previous_time = current_time - iterations = iterations + 1 endif endif 101 format( 5A, F8.2, A, F8.2, A, F8.2, A) @@ -178,7 +180,7 @@ subroutine med_phases_profile(gcomp, rc) !--- clean up !--------------------------------------- - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) call t_stopf('MED:'//subname) end subroutine med_phases_profile From ddbfbb24c716b02ddaed778943d651496dc450a6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 30 Nov 2018 09:45:28 -0700 Subject: [PATCH 4/8] update data model interface --- src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 | 8 ++++---- src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 | 4 ++-- src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 | 4 ++-- src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 | 4 ++-- src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 index 972397d9ef4..0213b7a5fe8 100644 --- a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 @@ -432,15 +432,15 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDATM%nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDATM%nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -605,7 +605,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index 45a8d161101..794ea07dafd 100644 --- a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -392,11 +392,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) nx_global = SDICE%nxg ny_global = SDICE%nyg - call shr_nuopc_methods_State_SetScalar(dble(nx_global),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(nx_global),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(ny_global),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(ny_global),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 index 3db6336bd48..00ea9b54307 100644 --- a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 @@ -357,11 +357,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_grid_ArrayToState(d2x%rattr, flds_l2x, exportState, grid_option='mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDLND%nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDLND%nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 index c7e4827ddb0..9e25adcdb01 100644 --- a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 @@ -386,11 +386,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_grid_ArrayToState(o2x%rattr, flds_o2x, exportState, grid_option='mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 index 2e9c51862bb..3afa884d5e2 100644 --- a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 @@ -340,11 +340,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_grid_ArrayToState(r2x%rattr, flds_r2x, exportState, 'mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDROF%nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDROF%nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDROF%nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDROF%nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return From 1fe6cfefe658bac1e2b6cb6aa27b932397372c58 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 30 Nov 2018 10:19:12 -0700 Subject: [PATCH 5/8] another avgdt refinement --- src/drivers/nuopc/mediator/med_phases_profile_mod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 b/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 index ab30230faa4..87716c6668c 100644 --- a/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_profile_mod.F90 @@ -121,10 +121,6 @@ subroutine med_phases_profile(gcomp, rc) call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - prevtime = nexttime - call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMWtime(current_time, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return @@ -150,6 +146,9 @@ subroutine med_phases_profile(gcomp, rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return avgdt = wallclockelapsed/ringdays endif + prevtime = nexttime + call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return ! get current wall clock time call ESMF_TimeSet(wallclocktime, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return From 48a45512f339a947974ef39898a2a9e5dd2cdb83 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 30 Nov 2018 15:12:58 -0700 Subject: [PATCH 6/8] reduce stdout --- src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 | 4 ++-- src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 | 4 ++-- src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 | 4 ++-- src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 | 4 ++-- src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 | 8 ++++---- src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 | 4 ++-- src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 | 6 +++--- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 index 7c6f19ea12b..e575d5143b8 100644 --- a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 @@ -223,7 +223,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry4' , flds_concat=flds_a2x) do n = 1,fldsFrAtm_num - write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) + if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -256,7 +256,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' , flds_concat=flds_x2a) do n = 1,fldsToAtm_num - write(logunit,*)'Advertising To Xatm',trim(fldsToAtm(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xatm',trim(fldsToAtm(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index 183ee569a8e..128a3904851 100644 --- a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -202,7 +202,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Flgg_hflx' , flds_concat=flds_g2x) do n = 1,fldsFrGlc_num - write(logunit,*)'Advertising From Xglc ',trim(fldsFrGlc(n)%stdname) + if (mastertask) write(logunit,*)'Advertising From Xglc ',trim(fldsFrGlc(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -220,7 +220,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end do do n = 1,fldsToGlc_num - write(logunit,*)'Advertising To Xglc ',trim(fldsToGlc(n)%stdname) + if (mastertask) write(logunit,*)'Advertising To Xglc ',trim(fldsToGlc(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 index 7724c472b70..1163b3ae582 100644 --- a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 @@ -216,7 +216,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_flxdst' , flds_concat=flds_i2x) do n = 1,fldsFrIce_num - write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) + if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -257,7 +257,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet4' , flds_concat=flds_x2i) do n = 1,fldsToIce_num - write(logunit,*)'Advertising To Xice ',trim(fldsToIce(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xice ',trim(fldsToIce(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 index 12cf57d18a3..3a7393d1ed9 100644 --- a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 @@ -214,7 +214,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst4' , flds_concat=flds_l2x) do n = 1,fldsFrLnd_num - write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) + if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -256,7 +256,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet4' , flds_concat=flds_x2l) do n = 1,fldsToLnd_num - write(logunit,*)'Advertising To Xlnd',trim(fldsToLnd(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xlnd',trim(fldsToLnd(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 index 7406eb0ae36..d9239ef248c 100644 --- a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 @@ -140,7 +140,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -201,7 +201,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , flds_concat=flds_o2x) do n = 1,fldsFrOcn_num - write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) + if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -227,7 +227,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , flds_concat=flds_x2o) do n = 1,fldsToOcn_num - write(logunit,*)'Advertising To Xocn',trim(fldsToOcn(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xocn',trim(fldsToOcn(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -237,7 +237,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) allocate(x2d(FldsToOcn_num,lsize)); x2d(:,:) = 0._r8 end if - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values diff --git a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 index 3289be047e5..c0311db1bb3 100644 --- a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 @@ -190,7 +190,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') do n = 1,fldsFrRof_num - write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) + if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -205,7 +205,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') do n = 1,fldsToRof_num - write(logunit,*)'Advertising To Xrof',trim(fldsToRof(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xrof',trim(fldsToRof(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToRof(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 index 888279f2969..1d417eb669f 100644 --- a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 @@ -162,7 +162,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) !---------------------------------------------------------------------------- ! Initialize xwav @@ -191,7 +191,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_hstokes' , flds_concat=flds_w2x) do n = 1,fldsFrWav_num - write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) + if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -208,7 +208,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToWav_num, fldsToWav, 'So_bldepth' , flds_concat=flds_x2w) do n = 1,fldsToWav_num - write(logunit,*)'Advertising To Xwav ',trim(fldsToWav(n)%stdname) + if(mastertask) write(logunit,*)'Advertising To Xwav ',trim(fldsToWav(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToWav(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return From 9a04a5536be1e7b74566bc29178264b373af58a5 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 30 Nov 2018 18:16:06 -0700 Subject: [PATCH 7/8] reduce memleak --- src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 | 4 ++-- src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 index f5ab8cc86aa..24e0600de0f 100644 --- a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 @@ -344,11 +344,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call shr_nuopc_grid_ArrayToState(w2x%rattr, flds_w2x, exportState, grid_option='mesh', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nxg),flds_scalar_index_nx, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nyg),flds_scalar_index_ny, exportState, mpicom, & + call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 index c3e3b44b7cc..3e354ba6453 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 @@ -786,10 +786,10 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) do n = 1, fieldCount call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldDestroy(field, rc=rc) + call ESMF_FieldDestroy(field, rc=rc, noGarbage=.true.) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return enddo - call ESMF_FieldBundleDestroy(FB, rc=rc) + call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lfieldnamelist) From fd500c8f918fbc3335f4377e0d6c7112dd9a1c8e Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 3 Dec 2018 09:54:32 -0700 Subject: [PATCH 8/8] fix pylint 2 error --- scripts/lib/CIME/case/preview_namelists.py | 2 -- 1 file changed, 2 deletions(-) diff --git a/scripts/lib/CIME/case/preview_namelists.py b/scripts/lib/CIME/case/preview_namelists.py index c9f3f76f065..765f9219a9f 100644 --- a/scripts/lib/CIME/case/preview_namelists.py +++ b/scripts/lib/CIME/case/preview_namelists.py @@ -61,8 +61,6 @@ def create_namelists(self, component=None): logger.info("Creating component namelists") - cime_model = self.get_value("MODEL") - # Create namelists - must have cpl last in the list below # Note - cpl must be last in the loop below so that in generating its namelist, # it can use xml vars potentially set by other component's buildnml scripts