├── .gitignore ├── implicit_coupling.pdf ├── README.md ├── LICENSE ├── makefile ├── app.F90 ├── lnd.F90 ├── driver.F90 ├── atm.F90 └── mediator.F90 /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.mod 3 | PET*.ESMF_Logfile 4 | *.vtk 5 | *.nc 6 | -------------------------------------------------------------------------------- /implicit_coupling.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ESCOMP/ImplictCouplingXGrid/master/implicit_coupling.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ImplictCouplingXGrid 2 | Application demonstrating ESMF exchange grid with implicit atmosphere-land coupling 3 | 4 | 1. both ATM and LND transfer grids to MED 5 | 6 | 2. XGrid is created in MED from ATM grid and LND grid. 7 | 8 | 3. Both ATM and LND transfer surface flux relevant quantities to MED 9 | 10 | 4. Two sweep calculation for flux update 11 | 12 | Note: 13 | 14 | Tested with ESMF version hash: 8.1bs36 (8.1 series) 15 | 16 | Run mpirun -np 4 ./app 17 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Earth System Community Modeling Portal 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | # GNU Makefile template for user ESMF application 2 | 3 | ################################################################################ 4 | ################################################################################ 5 | ## This Makefile must be able to find the "esmf.mk" Makefile fragment in the ## 6 | ## 'include' line below. Following the ESMF User's Guide, a complete ESMF ## 7 | ## installation should ensure that a single environment variable "ESMFMKFILE" ## 8 | ## is made available on the system. This variable should point to the ## 9 | ## "esmf.mk" file. ## 10 | ## ## 11 | ## This example Makefile uses the "ESMFMKFILE" environment variable. ## 12 | ## ## 13 | ## If you notice that this Makefile cannot find variable ESMFMKFILE then ## 14 | ## please contact the person responsible for the ESMF installation on your ## 15 | ## system. ## 16 | ## As a work-around you can simply hardcode the path to "esmf.mk" in the ## 17 | ## include line below. However, doing so will render this Makefile a lot less ## 18 | ## flexible and non-portable. ## 19 | ################################################################################ 20 | 21 | ifneq ($(origin ESMFMKFILE), environment) 22 | $(error Environment variable ESMFMKFILE was not set.) 23 | endif 24 | 25 | include $(ESMFMKFILE) 26 | 27 | ################################################################################ 28 | ################################################################################ 29 | 30 | .SUFFIXES: .f90 .F90 .c .C 31 | 32 | %.o : %.f90 33 | $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREENOCPP) $< 34 | 35 | %.o : %.F90 36 | $(ESMF_F90COMPILER) -c $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $< 37 | 38 | %.o : %.c 39 | $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< 40 | 41 | %.o : %.C 42 | $(ESMF_CXXCOMPILER) -c $(ESMF_CXXCOMPILEOPTS) $(ESMF_CXXCOMPILEPATHSLOCAL) $(ESMF_CXXCOMPILEPATHS) $(ESMF_CXXCOMPILECPPFLAGS) $< 43 | 44 | 45 | # ----------------------------------------------------------------------------- 46 | app: app.o driver.o mediator.o lnd.o atm.o 47 | $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) -o $@ $^ $(ESMF_F90ESMFLINKLIBS) 48 | 49 | # module dependencies: 50 | app.o: driver.o 51 | driver.o: mediator.o lnd.o atm.o 52 | 53 | # ----------------------------------------------------------------------------- 54 | # ----------------------------------------------------------------------------- 55 | .PHONY: dust clean distclean info edit 56 | dust: 57 | rm -f PET*.ESMF_LogFile med_imp_*.nc med_exp_*.nc atm_imp_*.nc lnd_imp_*.nc lnd_exp_*.nc atm_exp_*.nc med_xgrid*.vtk *.stdout F0*.nc F0*.vtk 58 | clean: 59 | rm -f app *.o *.mod 60 | distclean: dust clean 61 | 62 | info: 63 | @echo ================================================================== 64 | @echo ESMFMKFILE=$(ESMFMKFILE) 65 | @echo ================================================================== 66 | @cat $(ESMFMKFILE) 67 | @echo ================================================================== 68 | 69 | edit: 70 | nedit app.F90 driver.F90 mediator.F90 lnd.F90 atm.F90 & 71 | 72 | run: 73 | mpirun -np 4 ./app 74 | -------------------------------------------------------------------------------- /app.F90: -------------------------------------------------------------------------------- 1 | !============================================================================== 2 | ! Earth System Modeling Framework 3 | ! Copyright 2002-2019, University Corporation for Atmospheric Research, 4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 5 | ! Laboratory, University of Michigan, National Centers for Environmental 6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 7 | ! NASA Goddard Space Flight Center. 8 | ! Licensed under the University of Illinois-NCSA License. 9 | !============================================================================== 10 | 11 | program esmApp 12 | 13 | !----------------------------------------------------------------------------- 14 | ! Generic ESM application driver 15 | !----------------------------------------------------------------------------- 16 | 17 | use ESMF 18 | use NUOPC 19 | use Driver, only: driverSS => SetServices 20 | 21 | implicit none 22 | 23 | integer :: rc, urc 24 | type(ESMF_GridComp) :: esmComp 25 | 26 | ! Initialize ESMF 27 | call ESMF_Initialize(logkindflag=ESMF_LOGKIND_MULTI, & 28 | defaultCalkind=ESMF_CALKIND_GREGORIAN, rc=rc) 29 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 30 | line=__LINE__, & 31 | file=__FILE__)) & 32 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 33 | 34 | call ESMF_LogWrite("esmApp STARTING", ESMF_LOGMSG_INFO, rc=rc) 35 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 36 | line=__LINE__, & 37 | file=__FILE__)) & 38 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 39 | 40 | !----------------------------------------------------------------------------- 41 | 42 | ! need to add "PINT" to the NUOPC Field Dictionary 43 | call NUOPC_FieldDictionaryAddEntry(standardName="PINT", canonicalUnits="Pa", rc=rc) 44 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 45 | line=__LINE__, & 46 | file=__FILE__)) & 47 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 48 | 49 | !----------------------------------------------------------------------------- 50 | 51 | ! Create the earth system Component 52 | esmComp = ESMF_GridCompCreate(name="esm", rc=rc) 53 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 54 | line=__LINE__, & 55 | file=__FILE__)) & 56 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 57 | 58 | ! SetServices for the earth system Component 59 | call ESMF_GridCompSetServices(esmComp, driverSS, userRc=urc, rc=rc) 60 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 61 | line=__LINE__, & 62 | file=__FILE__)) & 63 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 64 | if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & 65 | line=__LINE__, & 66 | file=__FILE__)) & 67 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 68 | 69 | ! Call Initialize for the earth system Component 70 | call ESMF_GridCompInitialize(esmComp, userRc=urc, rc=rc) 71 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 72 | line=__LINE__, & 73 | file=__FILE__)) & 74 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 75 | if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & 76 | line=__LINE__, & 77 | file=__FILE__)) & 78 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 79 | 80 | ! Call Run for earth the system Component 81 | call ESMF_GridCompRun(esmComp, userRc=urc, rc=rc) 82 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 83 | line=__LINE__, & 84 | file=__FILE__)) & 85 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 86 | if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & 87 | line=__LINE__, & 88 | file=__FILE__)) & 89 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 90 | 91 | ! Call Finalize for the earth system Component 92 | call ESMF_GridCompFinalize(esmComp, userRc=urc, rc=rc) 93 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 94 | line=__LINE__, & 95 | file=__FILE__)) & 96 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 97 | if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & 98 | line=__LINE__, & 99 | file=__FILE__)) & 100 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 101 | 102 | ! Destroy the earth system Component 103 | call ESMF_GridCompDestroy(esmComp, rc=rc) 104 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 105 | line=__LINE__, & 106 | file=__FILE__)) & 107 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 108 | 109 | call ESMF_LogWrite("esmApp FINISHED", ESMF_LOGMSG_INFO, rc=rc) 110 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 111 | line=__LINE__, & 112 | file=__FILE__)) & 113 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 114 | 115 | ! Finalize ESMF 116 | call ESMF_Finalize() 117 | 118 | end program 119 | -------------------------------------------------------------------------------- /lnd.F90: -------------------------------------------------------------------------------- 1 | !============================================================================== 2 | ! Earth System Modeling Framework 3 | ! Copyright 2002-2019, University Corporation for Atmospheric Research, 4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 5 | ! Laboratory, University of Michigan, National Centers for Environmental 6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 7 | ! NASA Goddard Space Flight Center. 8 | ! Licensed under the University of Illinois-NCSA License. 9 | !============================================================================== 10 | 11 | module Lnd 12 | 13 | !----------------------------------------------------------------------------- 14 | ! ModelA Component. 15 | !----------------------------------------------------------------------------- 16 | 17 | use ESMF 18 | use NUOPC 19 | use NUOPC_Model, only: & 20 | model_routine_SS => SetServices, & 21 | model_label_Advance => label_Advance 22 | 23 | implicit none 24 | 25 | private 26 | 27 | integer :: impslice=1, expslice=1 28 | 29 | public SetServices 30 | 31 | !----------------------------------------------------------------------------- 32 | contains 33 | !----------------------------------------------------------------------------- 34 | 35 | subroutine SetServices(gcomp, rc) 36 | type(ESMF_GridComp) :: gcomp 37 | integer, intent(out) :: rc 38 | 39 | rc = ESMF_SUCCESS 40 | 41 | ! the NUOPC model component will register the generic methods 42 | call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) 43 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 44 | line=__LINE__, & 45 | file=__FILE__)) & 46 | return ! bail out 47 | 48 | ! set entry point for methods that require specific implementation 49 | 50 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 51 | phaseLabelList=(/"IPDv00p1"/), userRoutine=InitializeAdvertise, rc=rc) 52 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 53 | line=__LINE__, & 54 | file=__FILE__)) & 55 | return ! bail out 56 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 57 | phaseLabelList=(/"IPDv00p2"/), userRoutine=InitializeRealize, rc=rc) 58 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 59 | line=__LINE__, & 60 | file=__FILE__)) & 61 | return ! bail out 62 | 63 | ! attach specializing method(s) 64 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & 65 | specRoutine=ModelAdvance, rc=rc) 66 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 67 | line=__LINE__, & 68 | file=__FILE__)) & 69 | return ! bail out 70 | 71 | end subroutine 72 | 73 | !----------------------------------------------------------------------------- 74 | 75 | subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 76 | type(ESMF_GridComp) :: gcomp 77 | type(ESMF_State) :: importState, exportState 78 | type(ESMF_Clock) :: clock 79 | integer, intent(out) :: rc 80 | 81 | rc = ESMF_SUCCESS 82 | 83 | ! importable field: alpha 84 | call NUOPC_Advertise(importState, & 85 | StandardName="alpha", rc=rc) 86 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 87 | line=__LINE__, & 88 | file=__FILE__)) & 89 | return ! bail out 90 | 91 | ! importable field: beta 92 | call NUOPC_Advertise(importState, & 93 | StandardName="beta", rc=rc) 94 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 95 | line=__LINE__, & 96 | file=__FILE__)) & 97 | return ! bail out 98 | 99 | ! exportable field: DeltaT_L 100 | call NUOPC_Advertise(exportState, & 101 | StandardName="DeltaT_L", rc=rc) 102 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 103 | line=__LINE__, & 104 | file=__FILE__)) & 105 | return ! bail out 106 | 107 | end subroutine 108 | 109 | !----------------------------------------------------------------------------- 110 | 111 | subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 112 | type(ESMF_GridComp) :: gcomp 113 | type(ESMF_State) :: importState, exportState 114 | type(ESMF_Clock) :: clock 115 | integer, intent(out) :: rc 116 | 117 | ! local variables 118 | type(ESMF_Field) :: field 119 | type(ESMF_Grid) :: gridIn, gridOut 120 | integer :: i, j 121 | real(kind=ESMF_KIND_R8), pointer :: lonPtr(:,:), latPtr(:,:) 122 | 123 | rc = ESMF_SUCCESS 124 | 125 | ! create Grid objects for Fields 126 | #if 0 127 | gridIn = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=(/100,150/), & 128 | indexflag=ESMF_INDEX_GLOBAL, coordSys=ESMF_COORDSYS_SPH_DEG, rc=rc) 129 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 130 | line=__LINE__, & 131 | file=__FILE__)) & 132 | return ! bail out 133 | call ESMF_GridAddCoord(gridIn, rc=rc) 134 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 135 | line=__LINE__, & 136 | file=__FILE__)) & 137 | return ! bail out 138 | call ESMF_GridGetCoord(gridIn, coordDim=1, farrayPtr=lonPtr, rc=rc) 139 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 140 | line=__LINE__, & 141 | file=__FILE__)) & 142 | return ! bail out 143 | call ESMF_GridGetCoord(gridIn, coordDim=2, farrayPtr=latPtr, rc=rc) 144 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 145 | line=__LINE__, & 146 | file=__FILE__)) & 147 | return ! bail out 148 | do j=lbound(lonPtr,2),ubound(lonPtr,2) 149 | do i=lbound(lonPtr,1),ubound(lonPtr,1) 150 | lonPtr(i,j) = 360./real(100) * (i-1) 151 | latPtr(i,j) = 100./real(150) * (j-1) - 50. 152 | enddo 153 | enddo 154 | #endif 155 | #if 1 156 | !gridIn=ESMF_GridCreate1PeriDimUfrm(maxIndex=(/20,20/), & 157 | ! minCornerCoord=(/-50.0_ESMF_KIND_R8,-50.0_ESMF_KIND_R8/), & 158 | ! maxCornerCoord=(/49.0_ESMF_KIND_R8,49.0_ESMF_KIND_R8/), & 159 | ! staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & 160 | ! rc=rc) 161 | gridIn = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/40, 40/), & 162 | minCornerCoord=(/0._ESMF_KIND_R8, -50._ESMF_KIND_R8/), & 163 | maxCornerCoord=(/360._ESMF_KIND_R8, 70._ESMF_KIND_R8/), & 164 | staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), name="LND-Grid", rc=rc) 165 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 166 | line=__LINE__, & 167 | file=__FILE__)) & 168 | return ! bail out 169 | #endif 170 | gridOut = gridIn ! for now out same as in 171 | 172 | ! importable field: alpha 173 | field = ESMF_FieldCreate(name="alpha", & 174 | grid=gridIn, typekind=ESMF_TYPEKIND_R8, rc=rc) 175 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 176 | line=__LINE__, & 177 | file=__FILE__)) & 178 | return ! bail out 179 | call NUOPC_Realize(importState, field=field, rc=rc) 180 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 181 | line=__LINE__, & 182 | file=__FILE__)) & 183 | return ! bail out 184 | 185 | ! importable field: beta 186 | field = ESMF_FieldCreate(name="beta", & 187 | grid=gridIn, typekind=ESMF_TYPEKIND_R8, rc=rc) 188 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 189 | line=__LINE__, & 190 | file=__FILE__)) & 191 | return ! bail out 192 | call NUOPC_Realize(importState, field=field, rc=rc) 193 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 194 | line=__LINE__, & 195 | file=__FILE__)) & 196 | return ! bail out 197 | 198 | ! exportable field: DeltaT_L 199 | field = ESMF_FieldCreate(name="DeltaT_L", & 200 | grid=gridOut, typekind=ESMF_TYPEKIND_R8, rc=rc) 201 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 202 | line=__LINE__, & 203 | file=__FILE__)) & 204 | return ! bail out 205 | call NUOPC_Realize(exportState, field=field, rc=rc) 206 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 207 | line=__LINE__, & 208 | file=__FILE__)) & 209 | return ! bail out 210 | 211 | end subroutine 212 | 213 | !----------------------------------------------------------------------------- 214 | 215 | subroutine ModelAdvance(gcomp, rc) 216 | type(ESMF_GridComp) :: gcomp 217 | integer, intent(out) :: rc 218 | 219 | ! local variables 220 | type(ESMF_Clock) :: clock 221 | type(ESMF_State) :: importState, exportState 222 | type(ESMF_Time) :: currTime 223 | type(ESMF_TimeInterval) :: timeStep 224 | character(len=160) :: msgString 225 | 226 | rc = ESMF_SUCCESS 227 | 228 | ! query the Component for its clock, importState and exportState 229 | call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & 230 | exportState=exportState, rc=rc) 231 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 232 | line=__LINE__, & 233 | file=__FILE__)) & 234 | return ! bail out 235 | 236 | #ifdef WRITE_IMPEXP 237 | call NUOPC_Write(importState, filenamePrefix='lnd_imp_', & 238 | overwrite=.true., timeslice=impslice, rc=rc) 239 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 240 | line=__LINE__, & 241 | file=__FILE__)) & 242 | return ! bail out 243 | impslice=impslice+1 244 | #endif 245 | 246 | ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep 247 | 248 | call ESMF_ClockPrint(clock, options="currTime", & 249 | preString="------>Advancing ModelA from: ", unit=msgString, rc=rc) 250 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 251 | line=__LINE__, & 252 | file=__FILE__)) & 253 | return ! bail out 254 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 255 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 256 | line=__LINE__, & 257 | file=__FILE__)) & 258 | return ! bail out 259 | 260 | call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) 261 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 262 | line=__LINE__, & 263 | file=__FILE__)) & 264 | return ! bail out 265 | 266 | call ESMF_TimePrint(currTime + timeStep, & 267 | preString="------------------------> to: ", unit=msgString, rc=rc) 268 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 269 | line=__LINE__, & 270 | file=__FILE__)) & 271 | return ! bail out 272 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 273 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 274 | line=__LINE__, & 275 | file=__FILE__)) & 276 | return ! bail out 277 | 278 | #ifdef WRITE_IMPEXP 279 | call NUOPC_Write(exportState, filenamePrefix='lnd_exp_', & 280 | overwrite=.true., timeslice=expslice, rc=rc) 281 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 282 | line=__LINE__, & 283 | file=__FILE__)) & 284 | return ! bail out 285 | expslice=expslice+1 286 | #endif 287 | 288 | end subroutine 289 | 290 | end module 291 | -------------------------------------------------------------------------------- /driver.F90: -------------------------------------------------------------------------------- 1 | !============================================================================== 2 | ! Earth System Modeling Framework 3 | ! Copyright 2002-2019, University Corporation for Atmospheric Research, 4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 5 | ! Laboratory, University of Michigan, National Centers for Environmental 6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 7 | ! NASA Goddard Space Flight Center. 8 | ! Licensed under the University of Illinois-NCSA License. 9 | !============================================================================== 10 | 11 | module Driver 12 | 13 | !----------------------------------------------------------------------------- 14 | ! Code that specializes generic driver Component code. 15 | !----------------------------------------------------------------------------- 16 | 17 | use ESMF 18 | use NUOPC 19 | use NUOPC_Driver, & 20 | driver_routine_SS => SetServices, & 21 | driver_label_SetModelServices => label_SetModelServices, & 22 | driver_label_ModifyCplLists => label_ModifyCplLists, & 23 | driver_label_SetRunSequence => label_SetRunSequence 24 | 25 | use Mediator, only: medSS => SetServices 26 | use Lnd, only: modASS => SetServices 27 | use ATM, only: modBSS => SetServices 28 | 29 | use NUOPC_Connector, only: cplSS => SetServices 30 | 31 | implicit none 32 | 33 | private 34 | 35 | character(len=10), parameter :: standardNames(6) =(/ & 36 | "DeltaT_A ", & 37 | "e ", & 38 | "f ", & 39 | "DeltaT_L ", & 40 | "alpha ", & 41 | "beta "/) 42 | character(len=10), parameter :: units(6) =(/ & 43 | "K ", & 44 | "1 ", & 45 | "1 ", & 46 | "K ", & 47 | "1 ", & 48 | "1 "/) 49 | 50 | public SetServices 51 | 52 | !----------------------------------------------------------------------------- 53 | contains 54 | !----------------------------------------------------------------------------- 55 | 56 | subroutine SetServices(driver, rc) 57 | type(ESMF_GridComp) :: driver 58 | integer, intent(out) :: rc 59 | 60 | rc = ESMF_SUCCESS 61 | 62 | ! NUOPC_Driver registers the generic methods 63 | call NUOPC_CompDerive(driver, driver_routine_SS, rc=rc) 64 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 65 | line=__LINE__, & 66 | file=__FILE__)) & 67 | return ! bail out 68 | 69 | ! attach specializing method(s) 70 | call NUOPC_CompSpecialize(driver, specLabel=driver_label_SetModelServices, & 71 | specRoutine=SetModelServices, rc=rc) 72 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 73 | line=__LINE__, & 74 | file=__FILE__)) & 75 | return ! bail out 76 | call NUOPC_CompSpecialize(driver, specLabel=driver_label_SetRunSequence, & 77 | specRoutine=SetRunSequence, rc=rc) 78 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 79 | line=__LINE__, & 80 | file=__FILE__)) & 81 | return ! bail out 82 | call NUOPC_CompSpecialize(driver, specLabel=driver_label_ModifyCplLists, & 83 | specRoutine=ModifyCplLists, rc=rc) 84 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 85 | line=__LINE__, & 86 | file=__FILE__)) & 87 | return ! bail out 88 | 89 | end subroutine 90 | 91 | !----------------------------------------------------------------------------- 92 | 93 | subroutine SetModelServices(driver, rc) 94 | type(ESMF_GridComp) :: driver 95 | integer, intent(out) :: rc 96 | 97 | ! local variables 98 | type(ESMF_Time) :: startTime 99 | type(ESMF_Time) :: stopTime 100 | type(ESMF_TimeInterval) :: timeStep 101 | type(ESMF_Clock) :: internalClock 102 | integer :: petCount, i 103 | integer, allocatable :: petList(:) 104 | type(ESMF_GridComp) :: child 105 | 106 | rc = ESMF_SUCCESS 107 | 108 | ! get the petCount 109 | call ESMF_GridCompGet(driver, petCount=petCount, rc=rc) 110 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 111 | line=__LINE__, & 112 | file=__FILE__)) & 113 | return ! bail out 114 | 115 | ! SetServices for Mediator with petList on first half of PETs 116 | allocate(petList(petCount/2)) 117 | do i=1, petCount/2 118 | petList(i) = i-1 ! PET labeling goes from 0 to petCount-1 119 | enddo 120 | call NUOPC_DriverAddComp(driver, "Mediator", medSS, petList=petList, & 121 | comp=child, rc=rc) 122 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 123 | line=__LINE__, & 124 | file=__FILE__)) & 125 | return ! bail out 126 | deallocate(petList) 127 | call NUOPC_CompAttributeSet(child, name="Verbosity", value="1", rc=rc) 128 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 129 | line=__LINE__, & 130 | file=__FILE__)) & 131 | return ! bail out 132 | 133 | ! SetServices for Lnd and ATM with petList on second half of PETs 134 | allocate(petList(petCount/2)) 135 | do i=1, petCount/2 136 | petList(i) = petCount/2 + i-1 ! PET labeling goes from 0 to petCount-1 137 | enddo 138 | call NUOPC_DriverAddComp(driver, "LND", modASS, petList=petList, & 139 | comp=child, rc=rc) 140 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 141 | line=__LINE__, & 142 | file=__FILE__)) & 143 | return ! bail out 144 | call NUOPC_CompAttributeSet(child, name="Verbosity", value="1", rc=rc) 145 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 146 | line=__LINE__, & 147 | file=__FILE__)) & 148 | return ! bail out 149 | call NUOPC_DriverAddComp(driver, "ATM", modBSS, petList=petList, & 150 | comp=child, rc=rc) 151 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 152 | line=__LINE__, & 153 | file=__FILE__)) & 154 | return ! bail out 155 | call NUOPC_CompAttributeSet(child, name="Verbosity", value="1", rc=rc) 156 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 157 | line=__LINE__, & 158 | file=__FILE__)) & 159 | return ! bail out 160 | deallocate(petList) 161 | 162 | ! set the model clock 163 | call ESMF_TimeIntervalSet(timeStep, m=15, rc=rc) ! 15 minute steps 164 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 165 | line=__LINE__, & 166 | file=__FILE__)) & 167 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 168 | call ESMF_TimeSet(startTime, yy=2010, mm=6, dd=1, h=0, m=0, rc=rc) 169 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 170 | line=__LINE__, & 171 | file=__FILE__)) & 172 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 173 | call ESMF_TimeSet(stopTime, yy=2010, mm=6, dd=1, h=1, m=0, rc=rc) 174 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 175 | line=__LINE__, & 176 | file=__FILE__)) & 177 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 178 | internalClock = ESMF_ClockCreate(name="Application Clock", & 179 | timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) 180 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 181 | line=__LINE__, & 182 | file=__FILE__)) & 183 | call ESMF_Finalize(endflag=ESMF_END_ABORT) 184 | call ESMF_GridCompSet(driver, clock=internalClock, rc=rc) 185 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 186 | line=__LINE__, & 187 | file=__FILE__)) & 188 | return ! bail out 189 | 190 | do i=1, 6 191 | call NUOPC_FieldDictionaryAddEntry(standardName=standardNames(i), & 192 | canonicalUnits=units(i),rc=rc) 193 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 194 | line=__LINE__, & 195 | file=__FILE__)) & 196 | return ! bail out 197 | enddo 198 | 199 | end subroutine 200 | 201 | !----------------------------------------------------------------------------- 202 | 203 | subroutine SetRunSequence(driver, rc) 204 | type(ESMF_GridComp) :: driver 205 | integer, intent(out) :: rc 206 | 207 | ! local variables 208 | character(ESMF_MAXSTR) :: name 209 | type(NUOPC_FreeFormat) :: runSeqFF 210 | 211 | rc = ESMF_SUCCESS 212 | 213 | ! query the driver for its name 214 | call ESMF_GridCompGet(driver, name=name, rc=rc) 215 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 216 | line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out 217 | 218 | ! set up free format run sequence 219 | runSeqFF = NUOPC_FreeFormatCreate(stringList=(/ & 220 | " @* ", & 221 | " Mediator sfc_boundary_layer ", & 222 | " ATM atmos_down ", & 223 | " Mediator flux_down_from_atmos", & 224 | " Mediator -> LND ", & 225 | " LND ", & 226 | " LND -> Mediator ", & 227 | " Mediator flux_up_to_atmos ", & 228 | " Mediator -> ATM ", & 229 | " ATM atmos_up ", & 230 | " ATM -> Mediator ", & 231 | " @ " /), & 232 | rc=rc) 233 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 234 | line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out 235 | 236 | ! ingest FreeFormat run sequence 237 | call NUOPC_DriverIngestRunSequence(driver, runSeqFF, & 238 | autoAddConnectors=.true., rc=rc) 239 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 240 | line=__LINE__, file=trim(name)//":"//__FILE__)) return ! bail out 241 | 242 | end subroutine 243 | 244 | !----------------------------------------------------------------------------- 245 | 246 | subroutine ModifyCplLists(driver, rc) 247 | type(ESMF_GridComp) :: driver 248 | integer, intent(out) :: rc 249 | 250 | ! local variables 251 | character(len=160) :: msg 252 | type(ESMF_CplComp), pointer :: connectorList(:) 253 | integer :: i, j, cplListSize 254 | character(len=160), allocatable :: cplList(:) 255 | character(len=160) :: tempString 256 | 257 | rc = ESMF_SUCCESS 258 | 259 | call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) 260 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 261 | line=__LINE__, & 262 | file=__FILE__)) & 263 | return ! bail out 264 | 265 | nullify(connectorList) 266 | call NUOPC_DriverGetComp(driver, compList=connectorList, rc=rc) 267 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 268 | line=__LINE__, & 269 | file=__FILE__)) & 270 | return ! bail out 271 | 272 | write (msg,*) "Found ", size(connectorList), " Connectors."// & 273 | " Modifying CplList Attribute...." 274 | call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO, rc=rc) 275 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 276 | line=__LINE__, & 277 | file=__FILE__)) & 278 | return ! bail out 279 | #if 1 280 | do i=1, size(connectorList) 281 | ! query the cplList for connector i 282 | call NUOPC_CompAttributeGet(connectorList(i), name="CplList", & 283 | itemCount=cplListSize, rc=rc) 284 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 285 | line=__LINE__, & 286 | file=__FILE__)) & 287 | return ! bail out 288 | if (cplListSize>0) then 289 | allocate(cplList(cplListSize)) 290 | call NUOPC_CompAttributeGet(connectorList(i), name="CplList", & 291 | valueList=cplList, rc=rc) 292 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 293 | line=__LINE__, & 294 | file=__FILE__)) & 295 | return ! bail out 296 | ! go through all of the entries in the cplList and switch to redist 297 | do j=1, cplListSize 298 | ! switch remapping to redist 299 | cplList(j) = trim(cplList(j))//":REMAPMETHOD=redist" 300 | enddo 301 | ! store the modified cplList in CplList attribute of connector i 302 | call NUOPC_CompAttributeSet(connectorList(i), & 303 | name="CplList", valueList=cplList, rc=rc) 304 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 305 | line=__LINE__, & 306 | file=__FILE__)) & 307 | return ! bail out 308 | deallocate(cplList) 309 | endif 310 | enddo 311 | #endif 312 | deallocate(connectorList) 313 | 314 | end subroutine 315 | 316 | !----------------------------------------------------------------------------- 317 | 318 | end module 319 | -------------------------------------------------------------------------------- /atm.F90: -------------------------------------------------------------------------------- 1 | !============================================================================== 2 | ! Earth System Modeling Framework 3 | ! Copyright 2002-2019, University Corporation for Atmospheric Research, 4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 5 | ! Laboratory, University of Michigan, National Centers for Environmental 6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 7 | ! NASA Goddard Space Flight Center. 8 | ! Licensed under the University of Illinois-NCSA License. 9 | !============================================================================== 10 | 11 | module ATM 12 | 13 | !----------------------------------------------------------------------------- 14 | ! ModelB Component. 15 | !----------------------------------------------------------------------------- 16 | 17 | use ESMF 18 | use NUOPC 19 | use NUOPC_Model, & 20 | model_routine_SS => SetServices, & 21 | model_label_CheckImport => label_CheckImport, & 22 | model_routine_Run => routine_Run, & 23 | model_label_SetRunClock => label_SetRunClock, & 24 | model_label_Advance => label_Advance 25 | 26 | implicit none 27 | 28 | private 29 | 30 | integer :: impslice=1, expslice=1 31 | integer :: debug_level = 10 32 | 33 | public SetServices 34 | 35 | !----------------------------------------------------------------------------- 36 | contains 37 | !----------------------------------------------------------------------------- 38 | 39 | subroutine SetServices(gcomp, rc) 40 | type(ESMF_GridComp) :: gcomp 41 | integer, intent(out) :: rc 42 | 43 | rc = ESMF_SUCCESS 44 | 45 | ! the NUOPC model component will register the generic methods 46 | call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) 47 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 48 | line=__LINE__, & 49 | file=__FILE__)) & 50 | return ! bail out 51 | 52 | ! set entry point for methods that require specific implementation 53 | 54 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 55 | phaseLabelList=(/"IPDv00p1"/), userRoutine=InitializeAdvertise, rc=rc) 56 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 57 | line=__LINE__, & 58 | file=__FILE__)) & 59 | return ! bail out 60 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & 61 | phaseLabelList=(/"IPDv00p2"/), userRoutine=InitializeRealize, rc=rc) 62 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 63 | line=__LINE__, & 64 | file=__FILE__)) & 65 | return ! bail out 66 | 67 | ! attach specializing method(s) 68 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & 69 | phaseLabelList=(/"atmos_down"/), & 70 | userRoutine=model_routine_Run, rc=rc) 71 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 72 | line=__LINE__, & 73 | file=__FILE__)) & 74 | return ! bail out 75 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & 76 | specPhaseLabel="atmos_down", specRoutine=update_atmos_model_down, rc=rc) 77 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 78 | line=__LINE__, & 79 | file=__FILE__)) & 80 | return ! bail out 81 | call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & 82 | phaseLabelList=(/"atmos_up"/), & 83 | userRoutine=model_routine_Run, rc=rc) 84 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 85 | line=__LINE__, & 86 | file=__FILE__)) & 87 | return ! bail out 88 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & 89 | specPhaseLabel="atmos_up", specRoutine=update_atmos_model_up, rc=rc) 90 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 91 | line=__LINE__, & 92 | file=__FILE__)) & 93 | return ! bail out 94 | 95 | call ESMF_MethodRemove(gcomp, model_label_CheckImport, rc=rc) 96 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 97 | line=__LINE__, file=__FILE__)) return ! bail out 98 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_CheckImport, & 99 | specRoutine=NUOPC_NoOp, rc=rc) 100 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 101 | line=__LINE__, file=__FILE__)) return ! bail out 102 | call ESMF_MethodRemove(gcomp, model_label_SetRunClock, rc=rc) 103 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 104 | line=__LINE__, file=__FILE__)) return ! bail out 105 | call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, & 106 | specRoutine=SetRunClock, rc=rc) 107 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 108 | line=__LINE__, file=__FILE__)) return ! bail out 109 | 110 | end subroutine 111 | 112 | !----------------------------------------------------------------------------- 113 | 114 | subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 115 | type(ESMF_GridComp) :: gcomp 116 | type(ESMF_State) :: importState, exportState 117 | type(ESMF_Clock) :: clock 118 | integer, intent(out) :: rc 119 | 120 | rc = ESMF_SUCCESS 121 | 122 | ! exportable field: e 123 | call NUOPC_Advertise(exportState, & 124 | StandardName="e", rc=rc) 125 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 126 | line=__LINE__, & 127 | file=__FILE__)) & 128 | return ! bail out 129 | 130 | ! exportable field: f 131 | call NUOPC_Advertise(exportState, & 132 | StandardName="f", rc=rc) 133 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 134 | line=__LINE__, & 135 | file=__FILE__)) & 136 | return ! bail out 137 | 138 | ! importable field: DeltaT_A 139 | call NUOPC_Advertise(importState, & 140 | StandardName="DeltaT_A", rc=rc) 141 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 142 | line=__LINE__, & 143 | file=__FILE__)) & 144 | return ! bail out 145 | 146 | end subroutine 147 | 148 | !----------------------------------------------------------------------------- 149 | 150 | subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 151 | type(ESMF_GridComp) :: gcomp 152 | type(ESMF_State) :: importState, exportState 153 | type(ESMF_Clock) :: clock 154 | integer, intent(out) :: rc 155 | 156 | ! local variables 157 | type(ESMF_Field) :: field 158 | type(ESMF_Grid) :: gridIn, gridOut 159 | integer :: i, j 160 | real(kind=ESMF_KIND_R8), pointer :: lonPtr(:,:), latPtr(:,:) 161 | 162 | rc = ESMF_SUCCESS 163 | 164 | ! create Grid objects for Fields 165 | #if 0 166 | gridIn = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=(/100,150/), & 167 | indexflag=ESMF_INDEX_GLOBAL, coordSys=ESMF_COORDSYS_SPH_DEG, rc=rc) 168 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 169 | line=__LINE__, & 170 | file=__FILE__)) & 171 | return ! bail out 172 | call ESMF_GridAddCoord(gridIn, rc=rc) 173 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 174 | line=__LINE__, & 175 | file=__FILE__)) & 176 | return ! bail out 177 | call ESMF_GridGetCoord(gridIn, coordDim=1, farrayPtr=lonPtr, rc=rc) 178 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 179 | line=__LINE__, & 180 | file=__FILE__)) & 181 | return ! bail out 182 | call ESMF_GridGetCoord(gridIn, coordDim=2, farrayPtr=latPtr, rc=rc) 183 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 184 | line=__LINE__, & 185 | file=__FILE__)) & 186 | return ! bail out 187 | do j=lbound(lonPtr,2),ubound(lonPtr,2) 188 | do i=lbound(lonPtr,1),ubound(lonPtr,1) 189 | lonPtr(i,j) = 360./real(100) * (i-1) 190 | latPtr(i,j) = 100./real(150) * (j-1) - 50. 191 | enddo 192 | enddo 193 | #endif 194 | #ifdef GRID_FAIL 195 | gridIn=ESMF_GridCreateNoPeriDimUfrm(maxIndex=(/30,30/), & 196 | minCornerCoord=(/-50.0_ESMF_KIND_R8,-50.0_ESMF_KIND_R8/), & 197 | maxCornerCoord=(/49.0_ESMF_KIND_R8,49.0_ESMF_KIND_R8/), & 198 | staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & 199 | rc=rc) 200 | #endif 201 | #if 1 202 | gridIn = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/50, 50/), & 203 | minCornerCoord=(/0._ESMF_KIND_R8, -50._ESMF_KIND_R8/), & 204 | maxCornerCoord=(/360._ESMF_KIND_R8, 70._ESMF_KIND_R8/), & 205 | staggerLocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), name="ATM-Grid", rc=rc) 206 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 207 | line=__LINE__, & 208 | file=__FILE__)) & 209 | return ! bail out 210 | #endif 211 | gridOut = gridIn ! for now out same as in 212 | 213 | ! exportable field: e 214 | field = ESMF_FieldCreate(name="e", & 215 | grid=gridIn, typekind=ESMF_TYPEKIND_R8, rc=rc) 216 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 217 | line=__LINE__, & 218 | file=__FILE__)) & 219 | return ! bail out 220 | call NUOPC_Realize(exportState, field=field, rc=rc) 221 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 222 | line=__LINE__, & 223 | file=__FILE__)) & 224 | return ! bail out 225 | 226 | ! exportable field: f 227 | field = ESMF_FieldCreate(name="f", & 228 | grid=gridIn, typekind=ESMF_TYPEKIND_R8, rc=rc) 229 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 230 | line=__LINE__, & 231 | file=__FILE__)) & 232 | return ! bail out 233 | call NUOPC_Realize(exportState, field=field, rc=rc) 234 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 235 | line=__LINE__, & 236 | file=__FILE__)) & 237 | return ! bail out 238 | 239 | ! importable field: DeltaT_A 240 | field = ESMF_FieldCreate(name="DeltaT_A", & 241 | grid=gridOut, typekind=ESMF_TYPEKIND_R8, rc=rc) 242 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 243 | line=__LINE__, & 244 | file=__FILE__)) & 245 | return ! bail out 246 | call NUOPC_Realize(importState, field=field, rc=rc) 247 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 248 | line=__LINE__, & 249 | file=__FILE__)) & 250 | return ! bail out 251 | 252 | end subroutine 253 | 254 | !----------------------------------------------------------------------------- 255 | 256 | subroutine ModelAdvance(gcomp, rc) 257 | type(ESMF_GridComp) :: gcomp 258 | integer, intent(out) :: rc 259 | 260 | ! local variables 261 | type(ESMF_Clock) :: clock 262 | type(ESMF_State) :: importState, exportState 263 | type(ESMF_Time) :: currTime 264 | type(ESMF_TimeInterval) :: timeStep 265 | character(len=160) :: msgString 266 | 267 | rc = ESMF_SUCCESS 268 | 269 | ! query the Component for its clock, importState and exportState 270 | call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, & 271 | exportState=exportState, rc=rc) 272 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 273 | line=__LINE__, & 274 | file=__FILE__)) & 275 | return ! bail out 276 | 277 | #ifdef WRITE_IMPEXP 278 | call NUOPC_Write(importState, filenamePrefix='atm_imp_', & 279 | overwrite=.true., timeslice=impslice, rc=rc) 280 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 281 | line=__LINE__, & 282 | file=__FILE__)) & 283 | return ! bail out 284 | impslice=impslice+1 285 | #endif 286 | 287 | ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep 288 | 289 | call ESMF_ClockPrint(clock, options="currTime", & 290 | preString="------>Advancing ModelB from: ", unit=msgString, rc=rc) 291 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 292 | line=__LINE__, & 293 | file=__FILE__)) & 294 | return ! bail out 295 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 296 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 297 | line=__LINE__, & 298 | file=__FILE__)) & 299 | return ! bail out 300 | 301 | call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) 302 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 303 | line=__LINE__, & 304 | file=__FILE__)) & 305 | return ! bail out 306 | 307 | call ESMF_TimePrint(currTime + timeStep, & 308 | preString="------------------------> to: ", unit=msgString, rc=rc) 309 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 310 | line=__LINE__, & 311 | file=__FILE__)) & 312 | return ! bail out 313 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 314 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 315 | line=__LINE__, & 316 | file=__FILE__)) & 317 | return ! bail out 318 | 319 | #ifdef WRITE_IMPEXP 320 | call NUOPC_Write(exportState, filenamePrefix='atm_exp_', & 321 | overwrite=.true., timeslice=expslice, rc=rc) 322 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 323 | line=__LINE__, & 324 | file=__FILE__)) & 325 | return ! bail out 326 | expslice=expslice+1 327 | #endif 328 | 329 | end subroutine 330 | 331 | subroutine update_atmos_model_down(model, rc) 332 | type(ESMF_GridComp) :: model 333 | integer, intent(out) :: rc 334 | 335 | ! local variables 336 | type(ESMF_Clock) :: clock 337 | type(ESMF_Time) :: time 338 | character(len=64) :: timestr 339 | type(ESMF_State) :: importState, exportState 340 | character(len=*),parameter :: subname='(update_atmos_model_down)' 341 | 342 | if (debug_level > 5) then 343 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 344 | endif 345 | rc = ESMF_SUCCESS 346 | 347 | end subroutine 348 | 349 | subroutine update_atmos_model_up(model, rc) 350 | type(ESMF_GridComp) :: model 351 | integer, intent(out) :: rc 352 | 353 | ! local variables 354 | type(ESMF_Clock) :: clock 355 | type(ESMF_Time) :: time 356 | character(len=64) :: timestr 357 | type(ESMF_State) :: importState, exportState 358 | character(len=*),parameter :: subname='(update_atmos_model_up)' 359 | 360 | if (debug_level > 5) then 361 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 362 | endif 363 | rc = ESMF_SUCCESS 364 | 365 | end subroutine 366 | 367 | subroutine SetRunClock(gcomp, rc) 368 | type(ESMF_GridComp) :: gcomp 369 | integer, intent(out) :: rc 370 | 371 | ! local variables 372 | type(ESMF_Clock) :: modelClock, driverClock 373 | type(ESMF_Time) :: currTime 374 | type(ESMF_TimeInterval) :: timeStep 375 | character(len=*),parameter :: subname='(atm:SetRunClock)' 376 | 377 | rc = ESMF_SUCCESS 378 | 379 | ! query the Model for clocks 380 | call NUOPC_ModelGet(gcomp, modelClock=modelClock, & 381 | driverClock=driverClock, rc=rc) 382 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 383 | line=__LINE__, file=__FILE__)) return ! bail out 384 | 385 | ! set the modelClock to have the current start time as the driverClock 386 | call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) 387 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 388 | line=__LINE__, file=__FILE__)) return ! bail out 389 | call ESMF_ClockSet(modelClock, currTime=currTime, timeStep=timeStep, rc=rc) 390 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 391 | line=__LINE__, file=__FILE__)) return ! bail out 392 | 393 | ! check and set the component clock against the driver clock 394 | call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) 395 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 396 | line=__LINE__, file=__FILE__)) return ! bail out 397 | 398 | end subroutine SetRunClock 399 | 400 | end module 401 | -------------------------------------------------------------------------------- /mediator.F90: -------------------------------------------------------------------------------- 1 | !============================================================================== 2 | ! Earth System Modeling Framework 3 | ! Copyright 2002-2019, University Corporation for Atmospheric Research, 4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 5 | ! Laboratory, University of Michigan, National Centers for Environmental 6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 7 | ! NASA Goddard Space Flight Center. 8 | ! Licensed under the University of Illinois-NCSA License. 9 | !============================================================================== 10 | 11 | module Mediator 12 | 13 | !----------------------------------------------------------------------------- 14 | ! Mediator Component. 15 | !----------------------------------------------------------------------------- 16 | 17 | use ESMF 18 | use NUOPC 19 | use NUOPC_Base 20 | use NUOPC_Mediator, & 21 | mediator_routine_SS => SetServices, & 22 | mediator_routine_Run => routine_Run, & 23 | mediator_label_DataInitialize => label_DataInitialize, & 24 | mediator_label_Advance => label_Advance, & 25 | mediator_label_SetRunClock => label_SetRunClock 26 | 27 | implicit none 28 | 29 | private 30 | 31 | type(ESMF_State) :: frLND, toLND 32 | type(ESMF_State) :: frATM, toATM 33 | integer :: impslice=1, expslice=1 34 | 35 | type(ESMF_XGrid) :: xgrid 36 | ! the following fields are on xgrid 37 | type(ESMF_Field) :: F0, dFdTA, dFdTL, alpha, beta, e, f, DeltaT_L, DeltaT_A 38 | 39 | public SetServices 40 | 41 | !----------------------------------------------------------------------------- 42 | contains 43 | !----------------------------------------------------------------------------- 44 | 45 | subroutine SetServices(mediator, rc) 46 | type(ESMF_GridComp) :: mediator 47 | integer, intent(out) :: rc 48 | 49 | rc = ESMF_SUCCESS 50 | 51 | ! the NUOPC mediator component will register the generic methods 52 | call NUOPC_CompDerive(mediator, mediator_routine_SS, rc=rc) 53 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 54 | line=__LINE__, & 55 | file=__FILE__)) & 56 | return ! bail out 57 | 58 | ! --- Initialization phases -------------------------------------- 59 | 60 | ! Provide InitializeP0 to switch from default IPDv00 to IPDv03 61 | call ESMF_GridCompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & 62 | userRoutine=InitializeP0, phase=0, rc=rc) 63 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 64 | line=__LINE__, & 65 | file=__FILE__)) & 66 | return ! bail out 67 | 68 | ! IPDv03p1: advertise Fields 69 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & 70 | phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeP1, rc=rc) 71 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 72 | line=__LINE__, & 73 | file=__FILE__)) & 74 | return ! bail out 75 | 76 | ! IPDv03p3: realize connected Fields with transfer action "provide" 77 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & 78 | phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeP3, rc=rc) 79 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 80 | line=__LINE__, & 81 | file=__FILE__)) & 82 | return ! bail out 83 | 84 | ! IPDv03p4: optionally modify the decomp/distr of transferred Grid/Mesh 85 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & 86 | phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeP4, rc=rc) 87 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 88 | line=__LINE__, & 89 | file=__FILE__)) & 90 | return ! bail out 91 | 92 | ! IPDv03p5: realize all Fields with transfer action "accept" 93 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_INITIALIZE, & 94 | phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeP5, rc=rc) 95 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 96 | line=__LINE__, & 97 | file=__FILE__)) & 98 | return ! bail out 99 | 100 | ! attach specializing method(s) 101 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Advance, & 102 | specRoutine=MediatorAdvance, rc=rc) 103 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 104 | line=__LINE__, & 105 | file=__FILE__)) & 106 | return ! bail out 107 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_DataInitialize, & 108 | specRoutine=DataInitialize, rc=rc) 109 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 110 | line=__LINE__, & 111 | file=__FILE__)) & 112 | return ! bail out 113 | 114 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_RUN, & 115 | phaseLabelList=(/"sfc_boundary_layer"/), & 116 | userRoutine=mediator_routine_Run, rc=rc) 117 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 118 | line=__LINE__, & 119 | file=__FILE__)) & 120 | return ! bail out 121 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Advance, & 122 | specPhaseLabel="sfc_boundary_layer", specRoutine=sfc_boundary_layer, rc=rc) 123 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 124 | line=__LINE__, & 125 | file=__FILE__)) & 126 | return ! bail out 127 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_RUN, & 128 | phaseLabelList=(/"flux_down_from_atmos"/), & 129 | userRoutine=mediator_routine_Run, rc=rc) 130 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 131 | line=__LINE__, & 132 | file=__FILE__)) & 133 | return ! bail out 134 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Advance, & 135 | specPhaseLabel="flux_down_from_atmos", specRoutine=flux_down_from_atmos, rc=rc) 136 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 137 | line=__LINE__, & 138 | file=__FILE__)) & 139 | return ! bail out 140 | call NUOPC_CompSetEntryPoint(mediator, ESMF_METHOD_RUN, & 141 | phaseLabelList=(/"flux_up_to_atmos"/), & 142 | userRoutine=mediator_routine_Run, rc=rc) 143 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 144 | line=__LINE__, & 145 | file=__FILE__)) & 146 | return ! bail out 147 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_Advance, & 148 | specPhaseLabel="flux_up_to_atmos", specRoutine=flux_up_to_atmos, rc=rc) 149 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 150 | line=__LINE__, & 151 | file=__FILE__)) & 152 | return ! bail out 153 | 154 | call ESMF_MethodRemove(mediator, label_CheckImport, rc=rc) 155 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 156 | line=__LINE__, & 157 | file=__FILE__)) & 158 | return ! bail out 159 | call NUOPC_CompSpecialize(mediator, specLabel=label_CheckImport, & 160 | specRoutine=NUOPC_NoOp, rc=rc) 161 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 162 | line=__LINE__, & 163 | file=__FILE__)) & 164 | return ! bail out 165 | 166 | call ESMF_MethodRemove(mediator, mediator_label_SetRunClock, rc=rc) 167 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 168 | line=__LINE__, file=__FILE__)) return ! bail out 169 | call NUOPC_CompSpecialize(mediator, specLabel=mediator_label_SetRunClock, & 170 | specRoutine=SetRunClock, rc=rc) 171 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 172 | line=__LINE__, file=__FILE__)) return ! bail out 173 | 174 | end subroutine 175 | 176 | !----------------------------------------------------------------------------- 177 | 178 | subroutine InitializeP0(mediator, importState, exportState, clock, rc) 179 | type(ESMF_GridComp) :: mediator 180 | type(ESMF_State) :: importState, exportState 181 | type(ESMF_Clock) :: clock 182 | integer, intent(out) :: rc 183 | 184 | rc = ESMF_SUCCESS 185 | 186 | ! Switch to IPDv03 by filtering all other phaseMap entries 187 | call NUOPC_CompFilterPhaseMap(mediator, ESMF_METHOD_INITIALIZE, & 188 | acceptStringList=(/"IPDv03p"/), rc=rc) 189 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 190 | line=__LINE__, & 191 | file=__FILE__)) & 192 | return ! bail out 193 | 194 | end subroutine 195 | 196 | !----------------------------------------------------------------------------- 197 | 198 | subroutine InitializeP1(mediator, importState, exportState, clock, rc) 199 | ! IPDv03p1: advertise Fields 200 | type(ESMF_GridComp) :: mediator 201 | type(ESMF_State) :: importState, exportState 202 | type(ESMF_Clock) :: clock 203 | integer, intent(out) :: rc 204 | 205 | rc = ESMF_SUCCESS 206 | 207 | ! Fields from LND 208 | ! use namespace in the importState 209 | call NUOPC_AddNamespace(importState, namespace="LND", & 210 | nestedState=frLND, rc=rc) 211 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 212 | line=__LINE__, & 213 | file=__FILE__)) & 214 | return ! bail out 215 | ! advertise fields in the nested state 216 | call NUOPC_Advertise(frLND, & 217 | StandardNames=(/ & 218 | "DeltaT_L"/), & 219 | TransferOfferGeomObject="cannot provide", rc=rc) 220 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 221 | line=__LINE__, & 222 | file=__FILE__)) & 223 | return ! bail out 224 | 225 | ! Fields to LND 226 | ! use namespace in the exportState 227 | call NUOPC_AddNamespace(exportState, namespace="LND", & 228 | nestedState=toLND, rc=rc) 229 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 230 | line=__LINE__, & 231 | file=__FILE__)) & 232 | return ! bail out 233 | ! advertise fields in the nested state 234 | call NUOPC_Advertise(toLND, & 235 | StandardNames=(/ & 236 | "alpha ", & 237 | "beta "/), & 238 | TransferOfferGeomObject="cannot provide", rc=rc) 239 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 240 | line=__LINE__, & 241 | file=__FILE__)) & 242 | return ! bail out 243 | 244 | ! Fields from ATM 245 | ! use namespace in the importState 246 | call NUOPC_AddNamespace(importState, namespace="ATM", & 247 | nestedState=frATM, rc=rc) 248 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 249 | line=__LINE__, & 250 | file=__FILE__)) & 251 | return ! bail out 252 | ! advertise fields in the nested state 253 | call NUOPC_Advertise(frATM, & 254 | StandardNames=(/ & 255 | "e ", & 256 | "f "/), & 257 | TransferOfferGeomObject="cannot provide", rc=rc) 258 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 259 | line=__LINE__, & 260 | file=__FILE__)) & 261 | return ! bail out 262 | 263 | ! Fields to ATM 264 | ! use namespace in the exportState 265 | call NUOPC_AddNamespace(exportState, namespace="ATM", & 266 | nestedState=toATM, rc=rc) 267 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 268 | line=__LINE__, & 269 | file=__FILE__)) & 270 | return ! bail out 271 | ! advertise fields in the nested state 272 | call NUOPC_Advertise(toATM, & 273 | StandardNames=(/ & 274 | "DeltaT_A "/), & 275 | TransferOfferGeomObject="cannot provide", rc=rc) 276 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 277 | line=__LINE__, & 278 | file=__FILE__)) & 279 | return ! bail out 280 | 281 | end subroutine 282 | 283 | !----------------------------------------------------------------------------- 284 | 285 | subroutine InitializeP3(mediator, importState, exportState, clock, rc) 286 | ! IPDv03p3: realize connected Fields with transfer action "provide" 287 | ! and remove Fields that are not connected 288 | type(ESMF_GridComp) :: mediator 289 | type(ESMF_State) :: importState, exportState 290 | type(ESMF_Clock) :: clock 291 | integer, intent(out) :: rc 292 | 293 | rc = ESMF_SUCCESS 294 | 295 | call checkConnectedFlagProvide(importState, rc=rc) 296 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 297 | line=__LINE__, & 298 | file=__FILE__)) & 299 | return ! bail out 300 | 301 | call checkConnectedFlagProvide(exportState, rc=rc) 302 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 303 | line=__LINE__, & 304 | file=__FILE__)) & 305 | return ! bail out 306 | 307 | contains ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 308 | 309 | subroutine checkConnectedFlagProvide(state, rc) 310 | ! Look at all of the fields in state, including in nested states. Error 311 | ! out if a connected field is found for which geom object must be 312 | ! provided here. Remove all not connected fields. 313 | type(ESMF_State) :: state 314 | integer, optional :: rc 315 | ! local variables 316 | integer :: itemCount, item 317 | character(len=80) :: stateName 318 | type(ESMF_Field) :: field 319 | character(len=80) :: connectedValue 320 | character(len=20) :: transferAction 321 | type(ESMF_StateIntent_Flag) :: stateIntent 322 | character(len=80) :: transferActionAttr 323 | character(len=80), allocatable :: itemNameList(:) 324 | type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) 325 | 326 | if (present(rc)) rc = ESMF_SUCCESS 327 | 328 | call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) 329 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 330 | line=__LINE__, & 331 | file=__FILE__)) & 332 | return ! bail out 333 | 334 | if (stateIntent == ESMF_STATEINTENT_EXPORT) then 335 | transferActionAttr="ProducerTransferAction" 336 | elseif (stateIntent == ESMF_STATEINTENT_IMPORT) then 337 | transferActionAttr="ConsumerTransferAction" 338 | else 339 | call ESMF_LogSetError(ESMF_RC_ARG_BAD, & 340 | msg="The stateIntent must either be IMPORT or EXPORT here.", & 341 | line=__LINE__, & 342 | file=__FILE__, & 343 | rcToReturn=rc) 344 | return ! bail out 345 | endif 346 | 347 | call ESMF_StateGet(state, name=stateName, nestedFlag=.true., & 348 | itemCount=itemCount, rc=rc) 349 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 350 | line=__LINE__, & 351 | file=__FILE__)) & 352 | return ! bail out 353 | 354 | allocate(itemNameList(itemCount), itemTypeList(itemCount)) 355 | 356 | call ESMF_StateGet(state, nestedFlag=.true., & 357 | itemNameList=itemNameList, itemTypeList=itemTypeList, rc=rc) 358 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 359 | line=__LINE__, & 360 | file=__FILE__)) & 361 | return ! bail out 362 | 363 | do item=1, itemCount 364 | if (itemTypeList(item)==ESMF_STATEITEM_FIELD) then 365 | ! this is a field -> get more info 366 | call ESMF_StateGet(state, field=field, itemName=itemNameList(item), & 367 | rc=rc) 368 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 369 | line=__LINE__, & 370 | file=__FILE__)) & 371 | return ! bail out 372 | call NUOPC_GetAttribute(field, name="Connected", & 373 | value=connectedValue, rc=rc) 374 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 375 | line=__LINE__, & 376 | file=__FILE__)) & 377 | return ! bail out 378 | if (connectedValue=="false") then 379 | ! remove the field from the state 380 | call ESMF_StateRemove(state, (/itemNameList(item)/), rc=rc) 381 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 382 | line=__LINE__, & 383 | file=__FILE__)) & 384 | return ! bail out 385 | else 386 | call NUOPC_GetAttribute(field, name=transferActionAttr, & 387 | value=transferAction, rc=rc) 388 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 389 | line=__LINE__, & 390 | file=__FILE__)) & 391 | return ! bail out 392 | print *, 'from mediator: transferAction = ', trim(transferAction) 393 | if (trim(transferAction)=="provide") then 394 | ! the Connector instructed the Mediator to provide geom object 395 | call ESMF_LogSetError(ESMF_RC_NOT_VALID, & 396 | msg="Cannot fulfill request to provide geom object for "// & 397 | trim(itemNameList(item))//" in State "//trim(stateName), & 398 | line=__LINE__, & 399 | file=__FILE__, & 400 | rcToReturn=rc) 401 | return ! bail out 402 | endif 403 | endif 404 | endif 405 | enddo 406 | 407 | deallocate(itemNameList, itemTypeList) 408 | 409 | end subroutine 410 | 411 | end subroutine 412 | 413 | !----------------------------------------------------------------------------- 414 | 415 | subroutine InitializeP4(mediator, importState, exportState, clock, rc) 416 | ! IPDv03p4: optionally modify the decomp/distr of transferred Grid/Mesh 417 | type(ESMF_GridComp) :: mediator 418 | type(ESMF_State) :: importState, exportState 419 | type(ESMF_Clock) :: clock 420 | integer, intent(out) :: rc 421 | 422 | rc = ESMF_SUCCESS 423 | 424 | call adjustAcceptedGeom(importState, rc=rc) 425 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 426 | line=__LINE__, & 427 | file=__FILE__)) & 428 | return ! bail out 429 | 430 | call adjustAcceptedGeom(exportState, rc=rc) 431 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 432 | line=__LINE__, & 433 | file=__FILE__)) & 434 | return ! bail out 435 | 436 | contains ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 437 | 438 | subroutine adjustAcceptedGeom(state, rc) 439 | ! Look at all of the fields in state, including in nested states. Adjust 440 | ! the distribution of the accepted geom object to a 1 DE/PET distribution. 441 | type(ESMF_State) :: state 442 | integer, optional :: rc 443 | ! local variables 444 | integer :: itemCount, item 445 | type(ESMF_Field) :: field 446 | character(len=20) :: transferAction 447 | character(len=80), allocatable :: itemNameList(:) 448 | type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) 449 | type(ESMF_GeomType_Flag) :: geomtype 450 | type(ESMF_Grid) :: grid 451 | type(ESMF_Mesh) :: mesh 452 | character(160) :: msgString 453 | type(ESMF_DistGrid) :: distgrid 454 | integer :: dimCount, tileCount 455 | integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) 456 | type(ESMF_StateIntent_Flag) :: stateIntent 457 | character(len=80) :: transferActionAttr 458 | 459 | if (present(rc)) rc = ESMF_SUCCESS 460 | 461 | call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) 462 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 463 | line=__LINE__, & 464 | file=__FILE__)) & 465 | return ! bail out 466 | 467 | if (stateIntent==ESMF_STATEINTENT_EXPORT) then 468 | transferActionAttr="ProducerTransferAction" 469 | elseif (stateIntent==ESMF_STATEINTENT_IMPORT) then 470 | transferActionAttr="ConsumerTransferAction" 471 | else 472 | call ESMF_LogSetError(ESMF_RC_ARG_BAD, & 473 | msg="The stateIntent must either be IMPORT or EXPORT here.", & 474 | line=__LINE__, & 475 | file=__FILE__, & 476 | rcToReturn=rc) 477 | return ! bail out 478 | endif 479 | 480 | call ESMF_StateGet(state, nestedFlag=.true., itemCount=itemCount, rc=rc) 481 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 482 | line=__LINE__, & 483 | file=__FILE__)) & 484 | return ! bail out 485 | 486 | allocate(itemNameList(itemCount), itemTypeList(itemCount)) 487 | 488 | call ESMF_StateGet(state, nestedFlag=.true., & 489 | itemNameList=itemNameList, itemTypeList=itemTypeList, rc=rc) 490 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 491 | line=__LINE__, & 492 | file=__FILE__)) & 493 | return ! bail out 494 | 495 | do item=1, itemCount 496 | if (itemTypeList(item)==ESMF_STATEITEM_FIELD) then 497 | ! this is a field -> get more info 498 | call ESMF_StateGet(state, field=field, itemName=itemNameList(item), & 499 | rc=rc) 500 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 501 | line=__LINE__, & 502 | file=__FILE__)) & 503 | return ! bail out 504 | call NUOPC_GetAttribute(field, name=TransferActionAttr, & 505 | value=transferAction, rc=rc) 506 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 507 | line=__LINE__, & 508 | file=__FILE__)) & 509 | return ! bail out 510 | if (trim(transferAction)=="accept") then 511 | ! the Connector instructed the Mediator to accept geom object 512 | ! -> find out which type geom object the field holds 513 | call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) 514 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 515 | line=__LINE__, & 516 | file=__FILE__)) & 517 | return ! bail out 518 | if (geomtype==ESMF_GEOMTYPE_GRID) then 519 | ! empty field holds a Grid with DistGrid 520 | call ESMF_FieldGet(field, grid=grid, rc=rc) 521 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 522 | line=__LINE__, & 523 | file=__FILE__)) & 524 | return ! bail out 525 | ! access the DistGrid 526 | call ESMF_GridGet(grid, distgrid=distgrid, rc=rc) 527 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 528 | line=__LINE__, & 529 | file=__FILE__)) & 530 | return ! bail out 531 | ! Create a custom DistGrid, based on the minIndex, maxIndex of the 532 | ! accepted DistGrid, but with a default regDecomp for the current VM 533 | ! that leads to 1DE/PET. 534 | ! get dimCount and tileCount 535 | call ESMF_DistGridGet(distgrid, dimCount=dimCount, & 536 | tileCount=tileCount, rc=rc) 537 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 538 | line=__LINE__, & 539 | file=__FILE__)) & 540 | return ! bail out 541 | ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount 542 | allocate(minIndexPTile(dimCount, tileCount), & 543 | maxIndexPTile(dimCount, tileCount)) 544 | ! get minIndex and maxIndex arrays 545 | call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & 546 | maxIndexPTile=maxIndexPTile, rc=rc) 547 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 548 | line=__LINE__, & 549 | file=__FILE__)) & 550 | return ! bail out 551 | ! create the new DistGrid with the same minIndexPTile and maxIndexPTile, 552 | ! but with a default regDecompPTile 553 | distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & 554 | maxIndexPTile=maxIndexPTile, rc=rc) 555 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 556 | line=__LINE__, & 557 | file=__FILE__)) & 558 | return ! bail out 559 | ! Create a new Grid on the new DistGrid and swap it in the Field 560 | grid = ESMF_GridCreate(distgrid, rc=rc) 561 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 562 | line=__LINE__, & 563 | file=__FILE__)) & 564 | return ! bail out 565 | call ESMF_FieldEmptySet(field, grid=grid, rc=rc) 566 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 567 | line=__LINE__, & 568 | file=__FILE__)) & 569 | return ! bail out 570 | ! local clean-up 571 | deallocate(minIndexPTile, maxIndexPTile) 572 | elseif (geomtype==ESMF_GEOMTYPE_MESH) then 573 | ! empty field holds a Mesh with DistGrid 574 | call ESMF_FieldGet(field, mesh=mesh, rc=rc) 575 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 576 | line=__LINE__, & 577 | file=__FILE__)) & 578 | return ! bail out 579 | ! access the DistGrid 580 | call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) 581 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 582 | line=__LINE__, & 583 | file=__FILE__)) & 584 | return ! bail out 585 | ! Create a custom DistGrid, based on the minIndex, maxIndex of the 586 | ! accepted DistGrid, but with a default regDecomp for the current VM 587 | ! that leads to 1DE/PET. 588 | ! get dimCount and tileCount 589 | call ESMF_DistGridGet(distgrid, dimCount=dimCount, & 590 | tileCount=tileCount, rc=rc) 591 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 592 | line=__LINE__, & 593 | file=__FILE__)) & 594 | return ! bail out 595 | ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount 596 | allocate(minIndexPTile(dimCount, tileCount), & 597 | maxIndexPTile(dimCount, tileCount)) 598 | ! get minIndex and maxIndex arrays 599 | call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & 600 | maxIndexPTile=maxIndexPTile, rc=rc) 601 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 602 | line=__LINE__, & 603 | file=__FILE__)) & 604 | return ! bail out 605 | ! create the new DistGrid with the same minIndexPTile and maxIndexPTile, 606 | ! but with a default regDecompPTile 607 | distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & 608 | maxIndexPTile=maxIndexPTile, rc=rc) 609 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 610 | line=__LINE__, & 611 | file=__FILE__)) & 612 | return ! bail out 613 | ! Create a new Grid on the new DistGrid and swap it in the Field 614 | mesh = ESMF_MeshCreate(distgrid, distgrid, rc=rc) 615 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 616 | line=__LINE__, & 617 | file=__FILE__)) & 618 | return ! bail out 619 | call ESMF_FieldEmptySet(field, mesh=mesh, rc=rc) 620 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 621 | line=__LINE__, & 622 | file=__FILE__)) & 623 | return ! bail out 624 | ! local clean-up 625 | deallocate(minIndexPTile, maxIndexPTile) 626 | else 627 | call ESMF_LogSetError(ESMF_RC_NOT_VALID, & 628 | msg="Unsupported geom object found in "// & 629 | trim(itemNameList(item)), & 630 | line=__LINE__, & 631 | file=__FILE__, & 632 | rcToReturn=rc) 633 | return ! bail out 634 | endif 635 | endif 636 | endif 637 | enddo 638 | 639 | deallocate(itemNameList, itemTypeList) 640 | 641 | end subroutine 642 | 643 | end subroutine 644 | 645 | !----------------------------------------------------------------------------- 646 | 647 | subroutine InitializeP5(mediator, importState, exportState, clock, rc) 648 | ! IPDv03p5: realize all Fields with transfer action "accept" 649 | type(ESMF_GridComp) :: mediator 650 | type(ESMF_State) :: importState, exportState 651 | type(ESMF_Clock) :: clock 652 | integer, intent(out) :: rc 653 | 654 | type(ESMF_Field) :: field 655 | type(ESMF_Grid) :: grid1, grid2 656 | 657 | rc = ESMF_SUCCESS 658 | 659 | call ESMF_StateGet(frLND, 'DeltaT_L', field=field, rc=rc) 660 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 661 | line=__LINE__, & 662 | file=__FILE__)) & 663 | return ! bail out 664 | call ESMF_FieldGet(field, grid=grid1, rc=rc) 665 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 666 | line=__LINE__, & 667 | file=__FILE__)) & 668 | return ! bail out 669 | call ESMF_StateGet(frATM, 'e', field=field, rc=rc) 670 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 671 | line=__LINE__, & 672 | file=__FILE__)) & 673 | return ! bail out 674 | call ESMF_FieldGet(field, grid=grid2, rc=rc) 675 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 676 | line=__LINE__, & 677 | file=__FILE__)) & 678 | return ! bail out 679 | xgrid = ESMF_XGridCreate(sideAGrid=(/grid1/), sideBGrid=(/grid2/), & 680 | storeoverlay=.true., rc=rc) 681 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 682 | line=__LINE__, & 683 | file=__FILE__)) & 684 | return ! bail out 685 | #ifdef EXPORT_VTK 686 | call ESMF_XGridWriteVTK(xgrid, filename='med_xgrid', rc=rc) 687 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 688 | line=__LINE__, & 689 | file=__FILE__)) & 690 | return ! bail out 691 | #endif 692 | 693 | F0 = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) 694 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 695 | line=__LINE__, & 696 | file=__FILE__)) & 697 | return ! bail out 698 | dFdTA = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) 699 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 700 | line=__LINE__, & 701 | file=__FILE__)) & 702 | return ! bail out 703 | dFdTL = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, rc=rc) 704 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 705 | line=__LINE__, & 706 | file=__FILE__)) & 707 | return ! bail out 708 | 709 | #if 0 710 | ! Update fields according to field metadata and phase map convention 711 | ! LND Fields 712 | alpha = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='alpha', rc=rc) 713 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 714 | line=__LINE__, & 715 | file=__FILE__)) & 716 | return ! bail out 717 | call NUOPC_InitAttributes(alpha, 'alpha', Connected='true', rc=rc) 718 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 719 | line=__LINE__, & 720 | file=__FILE__)) & 721 | return ! bail out 722 | call ESMF_StateReplace(toLND, fieldList=(/alpha/), rc=rc) 723 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 724 | line=__LINE__, & 725 | file=__FILE__)) & 726 | return ! bail out 727 | beta = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='beta', rc=rc) 728 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 729 | line=__LINE__, & 730 | file=__FILE__)) & 731 | return ! bail out 732 | call NUOPC_InitAttributes(beta, 'beta', Connected='true', rc=rc) 733 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 734 | line=__LINE__, & 735 | file=__FILE__)) & 736 | return ! bail out 737 | call ESMF_StateReplace(toLND, fieldList=(/beta/), rc=rc) 738 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 739 | line=__LINE__, & 740 | file=__FILE__)) & 741 | return ! bail out 742 | DeltaT_L = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='DeltaT_L', rc=rc) 743 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 744 | line=__LINE__, & 745 | file=__FILE__)) & 746 | return ! bail out 747 | call NUOPC_InitAttributes(DeltaT_L, 'DeltaT_L', Connected='true', rc=rc) 748 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 749 | line=__LINE__, & 750 | file=__FILE__)) & 751 | return ! bail out 752 | call ESMF_StateReplace(frLND, fieldList=(/DeltaT_L/), rc=rc) 753 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 754 | line=__LINE__, & 755 | file=__FILE__)) & 756 | return ! bail out 757 | 758 | ! ATM Fields 759 | e = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='e', rc=rc) 760 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 761 | line=__LINE__, & 762 | file=__FILE__)) & 763 | return ! bail out 764 | call NUOPC_InitAttributes(e, 'e', Connected='true', rc=rc) 765 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 766 | line=__LINE__, & 767 | file=__FILE__)) & 768 | return ! bail out 769 | call ESMF_StateReplace(frATM, fieldList=(/e/), rc=rc) 770 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 771 | line=__LINE__, & 772 | file=__FILE__)) & 773 | return ! bail out 774 | f = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='f', rc=rc) 775 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 776 | line=__LINE__, & 777 | file=__FILE__)) & 778 | return ! bail out 779 | call NUOPC_InitAttributes(f, 'f', Connected='true', rc=rc) 780 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 781 | line=__LINE__, & 782 | file=__FILE__)) & 783 | return ! bail out 784 | call ESMF_StateReplace(frATM, fieldList=(/f/), rc=rc) 785 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 786 | line=__LINE__, & 787 | file=__FILE__)) & 788 | return ! bail out 789 | DeltaT_A = ESMF_FieldCreate(xgrid, typekind=ESMF_TYPEKIND_R8, name='DeltaT_A', rc=rc) 790 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 791 | line=__LINE__, & 792 | file=__FILE__)) & 793 | return ! bail out 794 | call NUOPC_InitAttributes(DeltaT_A, 'DeltaT_A', Connected='true', rc=rc) 795 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 796 | line=__LINE__, & 797 | file=__FILE__)) & 798 | return ! bail out 799 | call ESMF_StateReplace(toATM, fieldList=(/DeltaT_A/), rc=rc) 800 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 801 | line=__LINE__, & 802 | file=__FILE__)) & 803 | return ! bail out 804 | #endif 805 | 806 | ! Realize the fields 807 | call realizeWithAcceptedGeom(importState, rc=rc) 808 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 809 | line=__LINE__, & 810 | file=__FILE__)) & 811 | return ! bail out 812 | 813 | call realizeWithAcceptedGeom(exportState, rc=rc) 814 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 815 | line=__LINE__, & 816 | file=__FILE__)) & 817 | return ! bail out 818 | 819 | contains ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 820 | 821 | subroutine realizeWithAcceptedGeom(state, rc) 822 | ! Look at all of the fields in state, including in nested states. Realize 823 | ! with the accepted and adjusted geom object. 824 | type(ESMF_State) :: state 825 | integer, optional :: rc 826 | ! local variables 827 | integer :: itemCount, item 828 | character(len=80), allocatable :: itemNameList(:) 829 | type(ESMF_StateItem_Flag), allocatable :: itemTypeList(:) 830 | 831 | if (present(rc)) rc = ESMF_SUCCESS 832 | 833 | ! query info about the items in the state 834 | call ESMF_StateGet(state, nestedFlag=.true., itemCount=itemCount, rc=rc) 835 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 836 | line=__LINE__, & 837 | file=__FILE__)) & 838 | return ! bail out 839 | allocate(itemNameList(itemCount), itemTypeList(itemCount)) 840 | call ESMF_StateGet(state, nestedFlag=.true., & 841 | itemNameList=itemNameList, itemTypeList=itemTypeList, rc=rc) 842 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 843 | line=__LINE__, & 844 | file=__FILE__)) & 845 | return ! bail out 846 | 847 | ! realize all the fields in the state (geoms have been transferred) 848 | do item=1, itemCount 849 | if (itemTypeList(item)==ESMF_STATEITEM_FIELD) then 850 | ! realize this field 851 | call NUOPC_Realize(state, fieldName=itemNameList(item), rc=rc) 852 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 853 | line=__LINE__, & 854 | file=__FILE__)) & 855 | return ! bail out 856 | endif 857 | enddo 858 | 859 | deallocate(itemNameList, itemTypeList) 860 | 861 | end subroutine 862 | 863 | end subroutine 864 | 865 | !----------------------------------------------------------------------------- 866 | 867 | subroutine DataInitialize(mediator, rc) 868 | type(ESMF_GridComp) :: mediator 869 | integer, intent(out) :: rc 870 | 871 | rc = ESMF_SUCCESS 872 | 873 | ! indicate that data initialization is complete (breaking out of init-loop) 874 | call NUOPC_CompAttributeSet(mediator, & 875 | name="InitializeDataComplete", value="true", rc=rc) 876 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 877 | line=__LINE__, & 878 | file=__FILE__)) & 879 | return ! bail out 880 | 881 | end subroutine 882 | 883 | !----------------------------------------------------------------------------- 884 | subroutine MediatorAdvance(mediator, rc) 885 | type(ESMF_GridComp) :: mediator 886 | integer, intent(out) :: rc 887 | 888 | ! local variables 889 | type(ESMF_Clock) :: clock 890 | type(ESMF_State) :: importState, exportState 891 | integer :: itemCount(4) 892 | character(len=160) :: msgString 893 | 894 | rc = ESMF_SUCCESS 895 | 896 | ! query the Component for its clock, importState and exportState 897 | call ESMF_GridCompGet(mediator, clock=clock, importState=importState, & 898 | exportState=exportState, rc=rc) 899 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 900 | line=__LINE__, & 901 | file=__FILE__)) & 902 | return ! bail out 903 | 904 | #ifdef WRITE_IMPEXP 905 | call NUOPC_Write(frLND, filenamePrefix='med_imp_frLND_', & 906 | overwrite=.true., timeslice=impslice, rc=rc) 907 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 908 | line=__LINE__, & 909 | file=__FILE__)) & 910 | return ! bail out 911 | call NUOPC_Write(frATM, filenamePrefix='med_imp_frATM_', & 912 | overwrite=.true., timeslice=impslice, rc=rc) 913 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 914 | line=__LINE__, & 915 | file=__FILE__)) & 916 | return ! bail out 917 | #endif 918 | impslice=impslice+1 919 | 920 | ! HERE THE MEDIATOR ADVANCES: currTime -> currTime + timeStep 921 | 922 | call ESMF_ClockPrint(clock, options="currTime", & 923 | preString="------>Advancing MED from: ", unit=msgString, rc=rc) 924 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 925 | line=__LINE__, & 926 | file=__FILE__)) & 927 | return ! bail out 928 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 929 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 930 | line=__LINE__, & 931 | file=__FILE__)) & 932 | return ! bail out 933 | 934 | call ESMF_ClockPrint(clock, options="stopTime", & 935 | preString="---------------------> to: ", unit=msgString, rc=rc) 936 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 937 | line=__LINE__, & 938 | file=__FILE__)) & 939 | return ! bail out 940 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 941 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 942 | line=__LINE__, & 943 | file=__FILE__)) & 944 | return ! bail out 945 | 946 | call ESMF_StateGet(frLND, itemCount=itemCount(1), rc=rc) 947 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 948 | line=__LINE__, & 949 | file=__FILE__)) & 950 | return ! bail out 951 | 952 | call ESMF_StateGet(toLND, itemCount=itemCount(2), rc=rc) 953 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 954 | line=__LINE__, & 955 | file=__FILE__)) & 956 | return ! bail out 957 | 958 | call ESMF_StateGet(frATM, itemCount=itemCount(3), rc=rc) 959 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 960 | line=__LINE__, & 961 | file=__FILE__)) & 962 | return ! bail out 963 | 964 | call ESMF_StateGet(toATM, itemCount=itemCount(4), rc=rc) 965 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 966 | line=__LINE__, & 967 | file=__FILE__)) & 968 | return ! bail out 969 | 970 | write (msgString,*) "item counts for: "// & 971 | "frLND, toLND, frATM, toATM:", itemCount 972 | call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) 973 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 974 | line=__LINE__, & 975 | file=__FILE__)) & 976 | return ! bail out 977 | 978 | #ifdef WRITE_IMPEXP 979 | call NUOPC_Write(toLnd, filenamePrefix='med_exp_toLND_', & 980 | overwrite=.true., timeslice=expslice, rc=rc) 981 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 982 | line=__LINE__, & 983 | file=__FILE__)) & 984 | return ! bail out 985 | call NUOPC_Write(toATM, filenamePrefix='med_exp_toATM_', & 986 | overwrite=.true., timeslice=expslice, rc=rc) 987 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 988 | line=__LINE__, & 989 | file=__FILE__)) & 990 | return ! bail out 991 | #endif 992 | expslice=expslice+1 993 | 994 | end subroutine 995 | 996 | subroutine sfc_boundary_layer(mediator, rc) 997 | type(ESMF_GridComp) :: mediator 998 | integer, intent(out) :: rc 999 | 1000 | ! local variables 1001 | type(ESMF_Clock) :: clock 1002 | type(ESMF_Time) :: time 1003 | character(len=64) :: timestr 1004 | type(ESMF_State) :: importState, exportState 1005 | character(len=*),parameter :: subname='(sfc_boundary_layer)' 1006 | 1007 | type(ESMF_Array) :: f0a 1008 | type(ESMF_XGrid) :: ixgrid 1009 | 1010 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 1011 | 1012 | ! Calculate quantities needed for eq (9) 1013 | ! These are calculated through a PBL scheme such as MO 1014 | call ESMF_FieldFill(F0, dataFillScheme='const', step=impslice+1,rc=rc) 1015 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1016 | line=__LINE__, & 1017 | file=__FILE__)) & 1018 | return ! bail out 1019 | call ESMF_FieldFill(dFdTA, dataFillScheme='const', const1=1._ESMF_KIND_R8,rc=rc) 1020 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1021 | line=__LINE__, & 1022 | file=__FILE__)) & 1023 | return ! bail out 1024 | call ESMF_FieldFill(dFdTL, dataFillScheme='const', const1=1._ESMF_KIND_R8,rc=rc) 1025 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1026 | line=__LINE__, & 1027 | file=__FILE__)) & 1028 | return ! bail out 1029 | 1030 | #if 1 1031 | call ESMF_FieldWrite(F0, filename='F0.nc', overwrite=.true., timeslice=impslice+1, rc=rc) 1032 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1033 | line=__LINE__, & 1034 | file=__FILE__)) & 1035 | return ! bail out 1036 | #endif 1037 | 1038 | #if 1 1039 | call ESMF_FieldGet(F0, array=f0a, xgrid=ixgrid, rc=rc) 1040 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1041 | line=__LINE__, & 1042 | file=__FILE__)) & 1043 | return ! bail out 1044 | call ESMF_XGridWriteVTK(ixgrid, filename='F0', nodeArray1=f0a, rc=rc) 1045 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1046 | line=__LINE__, & 1047 | file=__FILE__)) & 1048 | return ! bail out 1049 | #endif 1050 | 1051 | rc = ESMF_SUCCESS 1052 | 1053 | end subroutine 1054 | 1055 | subroutine flux_down_from_atmos(mediator, rc) 1056 | type(ESMF_GridComp) :: mediator 1057 | integer, intent(out) :: rc 1058 | 1059 | ! local variables 1060 | type(ESMF_Clock) :: clock 1061 | type(ESMF_Time) :: time 1062 | character(len=64) :: timestr 1063 | type(ESMF_State) :: importState, exportState 1064 | character(len=*),parameter :: subname='(flux_down_from_atmos)' 1065 | 1066 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 1067 | ! Calculate e,f,alpha,beta and prepare average alpha beta to LND to use Eq. 9 1068 | rc = ESMF_SUCCESS 1069 | 1070 | end subroutine 1071 | 1072 | subroutine flux_up_to_atmos(mediator, rc) 1073 | type(ESMF_GridComp) :: mediator 1074 | integer, intent(out) :: rc 1075 | 1076 | ! local variables 1077 | type(ESMF_Clock) :: clock 1078 | type(ESMF_Time) :: time 1079 | character(len=64) :: timestr 1080 | type(ESMF_State) :: importState, exportState 1081 | character(len=*),parameter :: subname='(flux_up_to_atmos)' 1082 | 1083 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 1084 | ! Use LND temperature change and e,f to update ATM temperature change Eq. 8 1085 | rc = ESMF_SUCCESS 1086 | 1087 | end subroutine 1088 | 1089 | subroutine SetRunClock(gcomp, rc) 1090 | type(ESMF_GridComp) :: gcomp 1091 | integer, intent(out) :: rc 1092 | 1093 | ! local variables 1094 | type(ESMF_Clock) :: mediatorClock, driverClock 1095 | type(ESMF_Time) :: currTime 1096 | type(ESMF_TimeInterval) :: timeStep 1097 | character(len=*),parameter :: subname='(module_MEDIATOR:SetRunClock)' 1098 | 1099 | rc = ESMF_SUCCESS 1100 | 1101 | call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) 1102 | 1103 | ! query the Mediator for clocks 1104 | call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, & 1105 | driverClock=driverClock, rc=rc) 1106 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1107 | line=__LINE__, file=__FILE__)) return ! bail out 1108 | 1109 | ! set the mediatorClock to have the current start time as the driverClock 1110 | call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) 1111 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1112 | line=__LINE__, file=__FILE__)) return ! bail out 1113 | call ESMF_ClockSet(mediatorClock, currTime=currTime, timeStep=timeStep, rc=rc) 1114 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1115 | line=__LINE__, file=__FILE__)) return ! bail out 1116 | 1117 | ! check and set the component clock against the driver clock 1118 | call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) 1119 | if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & 1120 | line=__LINE__, file=__FILE__)) return ! bail out 1121 | 1122 | end subroutine SetRunClock 1123 | 1124 | end module 1125 | --------------------------------------------------------------------------------