diff --git a/components/stub_comps/satm/cpl/atm_comp_esmf.F90 b/components/stub_comps/satm/cpl/atm_comp_esmf.F90 deleted file mode 100644 index 7dc4aec95a23..000000000000 --- a/components/stub_comps/satm/cpl/atm_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module atm_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: atm_init_esmf - public :: atm_run_esmf - public :: atm_final_esmf - public :: atm_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine atm_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In atm register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - atm_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - atm_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - atm_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_init_esmf -! -! !DESCRIPTION: -! initialize dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="atm_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SATM", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Atmosphere Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Atmosphere", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "IndividualName", "Cecile Hannay", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "IndividualEmailAddress", & -! "hannay@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine atm_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_run_esmf -! -! !DESCRIPTION: -! run method for dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine atm_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine atm_final_esmf -!=============================================================================== -#endif - -end module atm_comp_esmf diff --git a/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 b/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 deleted file mode 100644 index 099431d210ec..000000000000 --- a/components/stub_comps/sesp/cpl/esp_comp_esmf.F90 +++ /dev/null @@ -1,164 +0,0 @@ -module esp_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: esp_init_esmf - public :: esp_run_esmf - public :: esp_final_esmf - public :: esp_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - subroutine esp_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In esp register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - esp_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - esp_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - esp_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - end subroutine esp_register_esmf - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_init_esmf -! -! !DESCRIPTION: -! initialize stub esp model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify stub components - call ESMF_AttributeSet(export_state, name="esp_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="esp_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SESP", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "External System Processing Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2016", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "External System Processing", & - convention=convCIM, purpose=purpComp, rc=rc) -#endif - - end subroutine esp_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_run_esmf -! -! !DESCRIPTION: -! run method for stub esp model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - - end subroutine esp_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: esp_final_esmf -! -! !DESCRIPTION: -! finalize method for stub model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - - subroutine esp_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - - end subroutine esp_final_esmf -!=============================================================================== -#endif - -end module esp_comp_esmf diff --git a/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 b/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 deleted file mode 100644 index 5c58235f0626..000000000000 --- a/components/stub_comps/sglc/cpl/glc_comp_esmf.F90 +++ /dev/null @@ -1,182 +0,0 @@ -module glc_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: glc_init_esmf - public :: glc_run_esmf - public :: glc_final_esmf - public :: glc_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine glc_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In glc register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - glc_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - glc_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - glc_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_init_esmf -! -! !DESCRIPTION: -! initialize dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="glc_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SGLC", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Ice Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Stephen Price", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "sprice@lanl.gov", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine glc_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_run_esmf -! -! !DESCRIPTION: -! run method for dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine glc_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine glc_final_esmf -!=============================================================================== -#endif - -end module glc_comp_esmf diff --git a/components/stub_comps/sice/cpl/ice_comp_esmf.F90 b/components/stub_comps/sice/cpl/ice_comp_esmf.F90 deleted file mode 100644 index 9d5b79a840bf..000000000000 --- a/components/stub_comps/sice/cpl/ice_comp_esmf.F90 +++ /dev/null @@ -1,176 +0,0 @@ -module ice_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ice_init_esmf - public :: ice_run_esmf - public :: ice_final_esmf - public :: ice_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine ice_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ice register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ice_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ice_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ice_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_init_esmf -! -! !DESCRIPTION: -! initialize dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="ice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SICE", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Ice Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine ice_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_run_esmf -! -! !DESCRIPTION: -! run method for dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine ice_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine ice_final_esmf -!=============================================================================== -#endif - -end module ice_comp_esmf diff --git a/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 b/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 deleted file mode 100644 index e975a9c720fb..000000000000 --- a/components/stub_comps/slnd/cpl/lnd_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module lnd_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: lnd_init_esmf - public :: lnd_run_esmf - public :: lnd_final_esmf - public :: lnd_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine lnd_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In lnd register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - lnd_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - lnd_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - lnd_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_init_esmf -! -! !DESCRIPTION: -! initialize dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SLND", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Sam Levis", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "slevis@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine lnd_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_run_esmf -! -! !DESCRIPTION: -! run method for dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine lnd_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine lnd_final_esmf -!=============================================================================== -#endif - -end module lnd_comp_esmf diff --git a/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 b/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 deleted file mode 100644 index ece7a885ef9b..000000000000 --- a/components/stub_comps/socn/cpl/ocn_comp_esmf.F90 +++ /dev/null @@ -1,176 +0,0 @@ -module ocn_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ocn_init_esmf - public :: ocn_run_esmf - public :: ocn_final_esmf - public :: ocn_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine ocn_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ocn register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ocn_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ocn_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ocn_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_init_esmf -! -! !DESCRIPTION: -! initialize dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="ocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SOCN", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Ocean Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Ocean", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Susan Bates", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "bates@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine ocn_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_run_esmf -! -! !DESCRIPTION: -! run method for dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine ocn_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine ocn_final_esmf -!=============================================================================== -#endif - -end module ocn_comp_esmf diff --git a/components/stub_comps/srof/cpl/rof_comp_esmf.F90 b/components/stub_comps/srof/cpl/rof_comp_esmf.F90 deleted file mode 100644 index 4bf6f66235d3..000000000000 --- a/components/stub_comps/srof/cpl/rof_comp_esmf.F90 +++ /dev/null @@ -1,182 +0,0 @@ -module rof_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: rof_init_esmf - public :: rof_run_esmf - public :: rof_final_esmf - public :: rof_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine rof_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In rof register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - rof_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - rof_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - rof_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_init_esmf -! -! !DESCRIPTION: -! initialize dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="rof_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="flood_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SROF", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "River Runoff Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2012", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "River Runoff", & - convention=convCIM, purpose=purpComp, rc=rc) - - ! call ESMF_AttributeSet(comp, "Name", "someone", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "EmailAddress", & - ! "someon@ucar.edu", & - ! convention=convCIM, purpose=purpComp, rc=rc) - ! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & - ! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine rof_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_run_esmf -! -! !DESCRIPTION: -! run method for dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine rof_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine rof_final_esmf -!=============================================================================== -#endif - -end module rof_comp_esmf diff --git a/components/stub_comps/swav/cpl/wav_comp_esmf.F90 b/components/stub_comps/swav/cpl/wav_comp_esmf.F90 deleted file mode 100644 index f4eebc32ef65..000000000000 --- a/components/stub_comps/swav/cpl/wav_comp_esmf.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module wav_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - - use ESMF - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: wav_init_esmf - public :: wav_run_esmf - public :: wav_final_esmf - public :: wav_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -subroutine wav_register_esmf(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In wav register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - wav_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - wav_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - wav_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - -end subroutine - -!=============================================================================== - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_init_esmf -! -! !DESCRIPTION: -! initialize dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_init_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - ! Local variables - character(ESMF_MAXSTR) :: convCIM, purpComp - -!EOP - - rc = ESMF_SUCCESS - - ! Set flag to specify dead components - call ESMF_AttributeSet(export_state, name="wav_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "SWAV", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Wav Stub Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Wav", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - -end subroutine wav_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_run_esmf -! -! !DESCRIPTION: -! run method for dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_run_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - -!EOP - - rc = ESMF_SUCCESS - -end subroutine wav_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_final_esmf(comp, import_state, export_state, EClock, rc) - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - - - rc = ESMF_SUCCESS - -end subroutine wav_final_esmf -!=============================================================================== -#endif - -end module wav_comp_esmf diff --git a/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 b/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 deleted file mode 100644 index dada3de41542..000000000000 --- a/components/xcpl_comps/xatm/cpl/atm_comp_esmf.F90 +++ /dev/null @@ -1,559 +0,0 @@ -module atm_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_a2x_fields, & - flds_x2d => seq_flds_x2a_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: atm_init_esmf - public :: atm_run_esmf - public :: atm_final_esmf - public :: atm_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'atm' ! user defined model name - integer(IN) :: ncomp =1 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data atmosphere component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine atm_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In atm register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - atm_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - atm_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - atm_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_init_esmf -! -! !DESCRIPTION: -! initialize dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - real(R8) :: nextsw_cday ! calendar of next atm shortwave - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(atm_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(atm_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(atm_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(atm_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(atm_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(atm_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(atm_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="atm_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('atm_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xatm_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xatm nxg') - call shr_mpi_bcast(nyg ,mpicom,'xatm nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xatm decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xatm nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xatm seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xatm input from file= xatm_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="atm_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="atm_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="atm_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - - call seq_timemgr_EClockGetData(EClock, next_cday=nextsw_cday) - call ESMF_AttributeSet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XATM", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Atmosphere Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Atmosphere", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Cecile Hannay", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "hannay@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine atm_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_run_esmf -! -! !DESCRIPTION: -! run method for dead atm model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - real(R8) :: nextsw_cday ! calendar of next atm shortwave - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(atm_run_esmf) " - character(*), parameter :: F04 = "('(atm_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - ! update nextsw_cday - call seq_timemgr_EClockGetData (EClock, next_cday=nextsw_cday) - call ESMF_AttributeSet(export_state, name="nextsw_cday", value=nextsw_cday, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine atm_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: atm_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine atm_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(atm_final_esmf) " - character(*), parameter :: F00 = "('(atm_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(atm_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine atm_final_esmf -!=============================================================================== -#endif - -end module atm_comp_esmf diff --git a/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 b/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 deleted file mode 100644 index 9bbfd675261d..000000000000 --- a/components/xcpl_comps/xglc/cpl/glc_comp_esmf.F90 +++ /dev/null @@ -1,561 +0,0 @@ -module glc_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_g2x_fields, & - flds_x2d => seq_flds_x2g_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: glc_init_esmf - public :: glc_run_esmf - public :: glc_final_esmf - public :: glc_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'glc' ! user defined model name - integer(IN) :: ncomp = 5 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data glc component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine glc_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In glc register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - glc_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - glc_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - glc_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_init_esmf -! -! !DESCRIPTION: -! initialize dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(glc_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(glc_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(glc_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(glc_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(glc_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(glc_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(glc_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="glc_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('glc_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xglc_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xglc nxg') - call shr_mpi_bcast(nyg ,mpicom,'xglc nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xglc decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xglc nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xglc seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xglc input from file= xglc_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="glc_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="glc_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glclnd_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glcice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="glc_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XGLC", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Ice Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Stephen Price", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "sprice@lanl.gov", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine glc_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_run_esmf -! -! !DESCRIPTION: -! run method for dead glc model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(glc_run_esmf) " - character(*), parameter :: F04 = "('(glc_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine glc_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: glc_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine glc_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(glc_final_esmf) " - character(*), parameter :: F00 = "('(glc_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(glc_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine glc_final_esmf -!=============================================================================== -#endif - -end module glc_comp_esmf diff --git a/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 b/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 deleted file mode 100644 index e62f8f24dde3..000000000000 --- a/components/xcpl_comps/xice/cpl/ice_comp_esmf.F90 +++ /dev/null @@ -1,557 +0,0 @@ -module ice_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_i2x_fields, & - flds_x2d => seq_flds_x2i_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ice_init_esmf - public :: ice_run_esmf - public :: ice_final_esmf - public :: ice_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'ice' ! user defined model name - integer(IN) :: ncomp = 3 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data ice component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine ice_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ice register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ice_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ice_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ice_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_init_esmf -! -! !DESCRIPTION: -! initialize dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(ice_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(ice_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(ice_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(ice_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(ice_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(ice_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(ice_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ice_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('ice_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xice_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xice nxg') - call shr_mpi_bcast(nyg ,mpicom,'xice nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xice decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xice nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xice seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xice input from file= xice_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="ice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="ice_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ice_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="iceberg_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XICE", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Ice Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ice_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_run_esmf -! -! !DESCRIPTION: -! run method for dead ice model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(ice_run_esmf) " - character(*), parameter :: F04 = "('(ice_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - nf = esmfshr_util_ArrayGetIndex(d2x_a, "Si_ifrac", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - fptr(nf, :) = min(1.0_R8,max(0.0_R8, fptr(nf,:))) - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ice_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ice_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ice_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(ice_final_esmf) " - character(*), parameter :: F00 = "('(ice_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(ice_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine ice_final_esmf -!=============================================================================== -#endif - -end module ice_comp_esmf diff --git a/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 b/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 deleted file mode 100644 index 3543f9c69183..000000000000 --- a/components/xcpl_comps/xlnd/cpl/lnd_comp_esmf.F90 +++ /dev/null @@ -1,527 +0,0 @@ -module lnd_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_cdata_mod - - use seq_flds_mod , only: flds_dom => seq_flds_dom_fields, & - flds_d2x => seq_flds_l2x_fields, & - flds_x2d => seq_flds_x2l_fields - - use esmfshr_mod - -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: lnd_init_esmf - public :: lnd_run_esmf - public :: lnd_final_esmf - public :: lnd_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'lnd' ! user defined model name - integer(IN) :: ncomp = 2 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data land component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine lnd_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In lnd register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - lnd_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - lnd_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - lnd_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_init_esmf -! -! !DESCRIPTION: -! initialize dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - - integer(IN), allocatable :: gindex(:) ! global index - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! temporary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - type(ESMF_Array) :: dom_a - type(ESMF_Array) :: d2x_a, x2d_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(lnd_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(lnd_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(lnd_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(lnd_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(lnd_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(lnd_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(lnd_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('lnd_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xlnd_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - - close (unitn) - call shr_file_freeUnit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xlnd nxg') - call shr_mpi_bcast(nyg ,mpicom,'xlnd nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xlnd decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xlnd nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xlnd seg_len') - - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domains - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="lnd_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="lnd_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="lnd_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - - call ESMF_AttributeSet(export_state, name="lnd_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_AttributeSet(export_state, name="lnd_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XLND", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Land Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Land", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Sam Levis", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "slevis@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine lnd_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_run_esmf -! -! !DESCRIPTION: -! run method for dead lnd model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:),blat(:) - real(R8), pointer :: fptr(:,:) - integer :: lsize - - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - character(*), parameter :: subName = "(lnd_run_esmf) " - character(*), parameter :: F04 = "('(lnd_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a , lsize2=lsize) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - allocate(blon(lsize),blat(lsize)) - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData( EClock, curr_ymd=CurrentYMD, curr_tod=CurrentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine lnd_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: lnd_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine lnd_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: dom_a - type(ESMF_Array) :: d2x_a, x2d_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(lnd_final_esmf) " - character(*), parameter :: F00 = "('(lnd_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(lnd_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destroy Arrays - !---------------------------- - - call esmfshr_util_StateADistgridDestroy(export_state, array_name="domain", rc=rc) - call esmfshr_util_StateArrayDestroy(export_state, array_name="domain", rc=rc) - call esmfshr_util_StateArrayDestroy(export_state, array_name="d2x", rc=rc) - call esmfshr_util_StateArrayDestroy(import_state, array_name="x2d", rc=rc) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine lnd_final_esmf -!=============================================================================== -#endif - -end module lnd_comp_esmf diff --git a/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 b/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 deleted file mode 100644 index 583ac0c21c4e..000000000000 --- a/components/xcpl_comps/xocn/cpl/ocn_comp_esmf.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module ocn_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_o2x_fields, & - flds_x2d => seq_flds_x2o_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: ocn_init_esmf - public :: ocn_run_esmf - public :: ocn_final_esmf - public :: ocn_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'ocn' ! user defined model name - integer(IN) :: ncomp = 4 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data ocn component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine ocn_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In ocn register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - ocn_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - ocn_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - ocn_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_init_esmf -! -! !DESCRIPTION: -! initialize dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - type(ESMF_DistGrid) :: distgrid - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(ocn_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(ocn_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(ocn_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(ocn_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(ocn_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(ocn_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(ocn_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="ocn_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('ocn_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xocn_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xocn nxg') - call shr_mpi_bcast(nyg ,mpicom,'xocn nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xocn decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xocn nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xocn seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xocn input from file= xocn_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="ocn_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="ocn_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocn_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="ocnrof_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "OCN", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Ocean Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Ocean", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "Susan Bates", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "bates@ucar.edu", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ocn_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_run_esmf -! -! !DESCRIPTION: -! run method for dead ocn model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(ocn_run_esmf) " - character(*), parameter :: F04 = "('(ocn_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine ocn_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: ocn_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine ocn_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(ocn_final_esmf) " - character(*), parameter :: F00 = "('(ocn_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(ocn_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine ocn_final_esmf -!=============================================================================== -#endif - -end module ocn_comp_esmf diff --git a/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 b/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 deleted file mode 100644 index 4780d1ffaa16..000000000000 --- a/components/xcpl_comps/xrof/cpl/rof_comp_esmf.F90 +++ /dev/null @@ -1,564 +0,0 @@ -module rof_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_r2x_fields, & - flds_x2d => seq_flds_x2r_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: rof_init_esmf - public :: rof_run_esmf - public :: rof_final_esmf - public :: rof_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'rof' ! user defined model name - integer(IN) :: ncomp = 6 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data rof component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine rof_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In rof register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - rof_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - rof_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - rof_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_init_esmf -! -! !DESCRIPTION: -! initialize dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - logical :: flood ! flood flag - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(rof_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(rof_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(rof_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(rof_init_esmf) ',a,i8,a)" - character(*), parameter :: F04 = "('(rof_init_esmf) ',a,l4)" - character(*), parameter :: F90 = "('(rof_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(rof_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(rof_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="rof_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('rof_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - flood = .false. - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xrof_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - read(unitn,*) flood - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xrof nxg') - call shr_mpi_bcast(nyg ,mpicom,'xrof nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xrof decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xrof nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xrof seg_len') - call shr_mpi_bcast(flood ,mpicom,'xrof flood') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xrof input from file= xrof_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F04) ' Flood mode : ',flood - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="rof_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="flood_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="rof_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rofice_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="rof_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="flood_present", value=flood, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XROF", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Sea Rof Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2010", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Sea Rof", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine rof_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_run_esmf -! -! !DESCRIPTION: -! run method for dead rof model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(rof_run_esmf) " - character(*), parameter :: F04 = "('(rof_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf+1) * 1.0_R8 -! lon = blon(n) -! lat = blat(n) -! fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & -! * cos (SHR_CONST_PI*lat/180.0_R8) & -! * sin((SHR_CONST_PI*lon/180.0_R8) & -! - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & -! + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine rof_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: rof_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine rof_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(rof_final_esmf) " - character(*), parameter :: F00 = "('(rof_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(rof_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------- - ! Destory Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine rof_final_esmf -!=============================================================================== -#endif - -end module rof_comp_esmf diff --git a/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 b/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 deleted file mode 100644 index 09dff485d4b7..000000000000 --- a/components/xcpl_comps/xwav/cpl/wav_comp_esmf.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module wav_comp_esmf - -#ifdef ESMF_INTERFACE -! !USES: - use shr_sys_mod - use shr_kind_mod , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS - use shr_file_mod , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, & - shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, & - shr_file_freeunit - use shr_mpi_mod , only: shr_mpi_bcast - use shr_const_mod , only: SHR_CONST_PI - use seq_timemgr_mod - use seq_comm_mct , only: seq_comm_inst, seq_comm_name, seq_comm_suffix - use ESMF - - use dead_data_mod - use dead_mod - - use seq_flds_mod , only: flds_d2x => seq_flds_w2x_fields, & - flds_x2d => seq_flds_x2w_fields, & - flds_dom => seq_flds_dom_fields - - use esmfshr_mod -! -! !PUBLIC TYPES: - implicit none - save - private ! except - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public :: wav_init_esmf - public :: wav_run_esmf - public :: wav_final_esmf - public :: wav_register_esmf - -!-------------------------------------------------------------------------- -! Private data interfaces -!-------------------------------------------------------------------------- - - !--- stdin input stuff --- - character(CS) :: str ! cpp defined model name - - !--- other --- - integer(IN) :: dbug = 0 ! debug level (higher is more) - - character(CS) :: myModelName = 'wav' ! user defined model name - integer(IN) :: ncomp = 7 ! component index - integer(IN) :: my_task ! my task in mpi communicator mpicom - integer(IN) :: master_task=0 ! task number of master task - integer(IN) :: logunit ! logging unit number - -! -! Author: Fei Liu -! ESMF compliant data wav component -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -CONTAINS -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -subroutine wav_register_esmf(comp, rc) - - implicit none - - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - - rc = ESMF_SUCCESS - - print *, "In wav register routine" - ! Register the callback routines. - - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_INITIALIZE, & - wav_init_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_RUN, & - wav_run_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_GridCompSetEntryPoint(comp, ESMF_METHOD_FINALIZE, & - wav_final_esmf, phase=1, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - -end subroutine - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_init_esmf -! -! !DESCRIPTION: -! initialize dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_init_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local variables --- - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: ierr ! error code - integer(IN) :: local_comm ! local communicator - integer(IN) :: mype ! pe info - integer(IN) :: totpe ! total number of pes - integer(IN), allocatable :: gindex(:) ! global index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - - real(R8), pointer :: gbuf(:,:) ! grid info buffer - real(R8), pointer :: buf(:) ! tempoary buffer - - integer(IN) :: nproc_x ! num of i pes (type 3) - integer(IN) :: seg_len ! length of segs (type 4) - integer(IN) :: nxg ! global dim i-direction - integer(IN) :: nyg ! global dim j-direction - integer(IN) :: decomp_type ! data decomp type: - - integer(IN) :: COMPID - integer(IN) :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=16) :: inst_suffix ! char string associated with instance - integer(IN) :: mpicom, mpicom_vm - integer(IN) :: lsize - integer(IN) :: phase - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - type(ESMF_VM) :: vm - - character(ESMF_MAXSTR) :: convCIM, purpComp - - !--- formats --- - character(*), parameter :: F00 = "('(wav_init_esmf) ',8a)" - character(*), parameter :: F01 = "('(wav_init_esmf) ',a,4i8)" - character(*), parameter :: F02 = "('(wav_init_esmf) ',a,4es13.6)" - character(*), parameter :: F03 = "('(wav_init_esmf) ',a,i8,a)" - character(*), parameter :: F90 = "('(wav_init_esmf) ',73('='))" - character(*), parameter :: F91 = "('(wav_init_esmf) ',73('-'))" - character(*), parameter :: subName = "(wav_init_esmf) " - - !---------------------------- - ! Initial Setup - !---------------------------- - - rc = ESMF_SUCCESS - - call ESMF_AttributeGet(export_state, name="wav_phase", value=phase, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeGet(export_state, name="ID", value=COMPID, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - ! duplicate the mpi communicator from the current VM - call ESMF_VMGetCurrent(vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_VMGet(vm, mpiCommunicator=mpicom_vm, rc=rc) - if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call MPI_Comm_dup(mpicom_vm, mpicom, rc) - if(rc /= 0) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (phase > 1) return - - call mpi_comm_rank(mpicom, my_task, ierr) - inst_name = seq_comm_name(COMPID) - inst_index = seq_comm_inst(COMPID) - inst_suffix = seq_comm_suffix(COMPID) - - !--- open log file --- - if (my_task == master_task) then - logUnit = shr_file_getUnit() - call shr_file_setIO('wav_modelio.nml'//trim(inst_suffix),logUnit) - else - logUnit = 6 - endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! read the namelist input (used to configure model) - !---------------------------- - - nxg = -9999 - nyg = -9999 - nproc_x = -9999 - seg_len = -9999 - decomp_type = -9999 - - if (my_task == master_task) then - unitn = shr_file_getUnit() - open( unitn, file='xwav_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - read(unitn,*) decomp_type - read(unitn,*) nproc_x - read(unitn,*) seg_len - close (unitn) - call shr_file_freeunit(unitn) - endif - - call shr_mpi_bcast(nxg ,mpicom,'xwav nxg') - call shr_mpi_bcast(nyg ,mpicom,'xwav nyg') - call shr_mpi_bcast(decomp_type,mpicom,'xwav decomp_type') - call shr_mpi_bcast(nproc_x ,mpicom,'xwav nproc_x') - call shr_mpi_bcast(seg_len ,mpicom,'xwav seg_len') - - if (my_task == master_task) then - write(logunit,* ) ' Read in Xwav input from file= xwav_in'//trim(inst_suffix) - write(logunit,F00) - write(logunit,F00) ' Model : ',trim(myModelName) - write(logunit,F01) ' NGX : ',nxg - write(logunit,F01) ' NGY : ',nyg - write(logunit,F01) ' Decomposition : ',decomp_type - write(logunit,F03) ' Num pes in X : ',nproc_x,' (type 3 only)' - write(logunit,F03) ' Segment Length : ',seg_len,' (type 11 only)' - write(logunit,F01) ' inst_index : ',inst_index - write(logunit,F00) ' inst_name : ',trim(inst_name) - write(logunit,F00) ' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) - call shr_sys_flush(logunit) - end if - - !---------------------------- - ! Determine communicator groups and sizes - !---------------------------- - - local_comm = mpicom - call MPI_COMM_RANK(local_comm,mype ,ierr) - call MPI_COMM_SIZE(local_comm,totpe,ierr) - - !---------------------------- - ! Determine decomposition and grid for dead component - !---------------------------- - - call dead_setNewGrid(decomp_type,nxg,nyg,totpe,mype,lsize,gbuf,seg_len,nproc_x) - - !---------------------------- - ! Set up distgrid - !---------------------------- - - allocate(gindex(lsize)) - gindex(:) = nint(gbuf(:,dead_grid_index)) - - distgrid = mct2esmf_init(gindex, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - deallocate(gindex) - - !---------------------------- - ! Init Arrays - !---------------------------- - - dom_a = mct2esmf_init(distgrid, attname=flds_dom, name="domain", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - d2x_a = mct2esmf_init(distgrid, attname=flds_d2x, name="d2x", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - x2d_a = mct2esmf_init(distgrid, attname=flds_x2d, name="x2d", rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Fill domain - !---------------------------- - - call esmfshr_util_ArrayZero(dom_a, rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - allocate(buf(lsize)) - buf(:) = gbuf(:,dead_grid_lon) - call esmfshr_util_ArrayPutField(dom_a, 'lon', buf) - buf(:) = gbuf(:,dead_grid_lat) - call esmfshr_util_ArrayPutField(dom_a, 'lat', buf) - buf(:) = gbuf(:,dead_grid_area) - call esmfshr_util_ArrayPutField(dom_a, 'area', buf) - call esmfshr_util_ArrayPutField(dom_a, 'aream', buf) - buf(:) = gbuf(:,dead_grid_mask) - call esmfshr_util_ArrayPutField(dom_a, 'mask', buf) - buf(:) = gbuf(:,dead_grid_frac) - call esmfshr_util_ArrayPutField(dom_a, 'frac', buf) - deallocate(buf) - - !---------------------------- - ! Add arrays to state - !---------------------------- - - call ESMF_StateAdd(export_state, (/dom_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(export_state, (/d2x_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateAdd(import_state, (/x2d_a/), rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Set flags - !---------------------------- - - call ESMF_AttributeSet(export_state, name="dead_comps", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_nx", value=nxg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_ny", value=nyg, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (nxg == 0 .and. nyg == 0) then - call ESMF_AttributeSet(export_state, name="wav_present", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.false., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - else - call ESMF_AttributeSet(export_state, name="wav_present", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_AttributeSet(export_state, name="wav_prognostic", value=.true., rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - endif - -#ifdef USE_ESMF_METADATA - convCIM = "CIM" - purpComp = "Model Component Simulation Description" - - call ESMF_AttributeAdd(comp, & - convention=convCIM, purpose=purpComp, rc=rc) - - call ESMF_AttributeSet(comp, "ShortName", "XWAV", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "LongName", & - "Wave Dead Model", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ReleaseDate", "2013", & - convention=convCIM, purpose=purpComp, rc=rc) - call ESMF_AttributeSet(comp, "ModelType", "Wave", & - convention=convCIM, purpose=purpComp, rc=rc) - -! call ESMF_AttributeSet(comp, "Name", "someone", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "EmailAddress", & -! "someone@someplace", & -! convention=convCIM, purpose=purpComp, rc=rc) -! call ESMF_AttributeSet(comp, "ResponsiblePartyRole", "contact", & -! convention=convCIM, purpose=purpComp, rc=rc) -#endif - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine wav_init_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_run_esmf -! -! !DESCRIPTION: -! run method for dead wav model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_run_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc - -!EOP - - !--- local --- - type(ESMF_Array) :: d2x_a, dom_a - real(R8), pointer :: blon(:), blat(:) - real(ESMF_KIND_R8), pointer :: fptr(:,:) - - integer(IN) :: lsize - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer(IN) :: n ! index - integer(IN) :: nf ! fields loop index - integer(IN) :: shrlogunit, shrloglev ! original log unit and level - integer(IN) :: CurrentYMD ! model date - integer(IN) :: CurrentTOD ! model sec into model date - character(*), parameter :: subName = "(wav_run_esmf) " - character(*), parameter :: F04 = "('(wav_run_esmf) ',2a,2i8,'s')" -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogUnit (logUnit) - - !---------------------------- - ! Get arrays, blon and blat - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call esmfshr_util_ArrayGetSize(dom_a, lsize2=lsize) - allocate(blon(lsize),blat(lsize)) - - call esmfshr_util_ArrayGetField(dom_a, 'lon', blon, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call esmfshr_util_ArrayGetField(dom_a, 'lat', blat, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - !---------------------------- - ! Pack d2x_a - ! the bounds are always from /1,1/ to /nflds_d2x, lsize/ locally. - !---------------------------- - - call ESMF_ArrayGet(d2x_a, localDe=0, farrayPtr=fptr, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - do n = 1, ubound(fptr,2)-lbound(fptr,2)+1 - do nf = 1, ubound(fptr,1)-lbound(fptr,1)+1 - lon = blon(n) - lat = blat(n) - fptr(nf-1+lbound(fptr,1),n-1+lbound(fptr,2)) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - - deallocate(blon,blat) - - !---------------------------- - ! Update attributes - !---------------------------- - - !---------------------------- - ! Log - !---------------------------- - - if (my_task == master_task) then - call seq_timemgr_EClockGetData (EClock, curr_ymd=currentYMD, curr_tod=currentTOD) - write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD - call shr_sys_flush(logunit) - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call shr_sys_flush(logunit) - -end subroutine wav_run_esmf - -!=============================================================================== -!BOP =========================================================================== -! -! !IROUTINE: wav_final_esmf -! -! !DESCRIPTION: -! finalize method for dead model -! -! !REVISION HISTORY: -! -! !INTERFACE: ------------------------------------------------------------------ - -subroutine wav_final_esmf(comp, import_state, export_state, EClock, rc) - - implicit none - -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp) :: comp - type(ESMF_State) :: import_state - type(ESMF_State) :: export_state - type(ESMF_Clock) :: EClock - integer, intent(out) :: rc -!EOP - type(ESMF_Array) :: d2x_a, x2d_a, dom_a - type(ESMF_DistGrid) :: distgrid - character(*), parameter :: subName = "(wav_final_esmf) " - character(*), parameter :: F00 = "('(wav_final_esmf) ',8a)" - character(*), parameter :: F91 = "('(wav_final_esmf) ',73('-'))" - -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !tcraig, Mar 2013, return here to avoid esmf abort on the destroy, bug tcx - return - - !---------------------------- - ! Destroy Arrays - !---------------------------- - - call ESMF_StateGet(export_state, itemName="domain", array=dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_ArrayDestroy(dom_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(export_state, itemName="d2x", array=d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(d2x_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - call ESMF_StateGet(import_state, itemName="x2d", array=x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayGet(x2d_a, distgrid=distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_ArrayDestroy(x2d_a, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - call ESMF_DistGridDestroy(distgrid, rc=rc) - if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) - - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) trim(myModelName),': end of main integration loop' - write(logunit,F91) - end if - -end subroutine wav_final_esmf -!=============================================================================== -#endif - -end module wav_comp_esmf