! +-======-+ ! Copyright (c) 2003-2007 United States Government as represented by ! the Admistrator of the National Aeronautics and Space Administration. ! All Rights Reserved. ! ! THIS OPEN SOURCE AGREEMENT ("AGREEMENT") DEFINES THE RIGHTS OF USE, ! REPRODUCTION, DISTRIBUTION, MODIFICATION AND REDISTRIBUTION OF CERTAIN ! COMPUTER SOFTWARE ORIGINALLY RELEASED BY THE UNITED STATES GOVERNMENT AS ! REPRESENTED BY THE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT AGENCY"). ! THE UNITED STATES GOVERNMENT, AS REPRESENTED BY GOVERNMENT AGENCY, IS AN ! INTENDED THIRD-PARTY BENEFICIARY OF ALL SUBSEQUENT DISTRIBUTIONS OR ! REDISTRIBUTIONS OF THE SUBJECT SOFTWARE. ANYONE WHO USES, REPRODUCES, ! DISTRIBUTES, MODIFIES OR REDISTRIBUTES THE SUBJECT SOFTWARE, AS DEFINED ! HEREIN, OR ANY PART THEREOF, IS, BY THAT ACTION, ACCEPTING IN FULL THE ! RESPONSIBILITIES AND OBLIGATIONS CONTAINED IN THIS AGREEMENT. ! ! Government Agency: National Aeronautics and Space Administration ! Government Agency Original Software Designation: GSC-15354-1 ! Government Agency Original Software Title: GEOS-5 GCM Modeling Software ! User Registration Requested. Please Visit http://opensource.gsfc.nasa.gov ! Government Agency Point of Contact for Original Software: ! Dale Hithon, SRA Assistant, (301) 286-2691 ! ! +-======-+ #include "MAPL_Generic.h" !============================================================================= !BOP ! !MODULE: GEOS\_GcsGridCompMod -- Parent DAS Component ! !INTERFACE: module GEOS_GcsGridCompMod ! !USES: use ESMF_Mod use MAPL_Mod use GEOS_GcmGridCompMod, only : GcmSetServices => SetServices use GEOS_AnaGridCompMod, only : AnaSetServices => SetServices implicit none private ! !PUBLIC MEMBER FUNCTIONS: public SetServices !============================================================================= ! !DESCRIPTION: This gridded component (GC) combines integer :: GCM ! Global Atmopheric Model integer :: ANA ! Global Analysis type MAPL_RouteHandle type(ESMF_RouteHandle) :: RH logical :: isNeeded end type MAPL_RouteHandle logical :: differentVMs type (ESMF_State) :: SIMP, SEXP type(MAPL_RouteHandle) :: g2aRH(3) logical, pointer :: anaNeedsThis(:) character(len=ESMF_MAXSTR), pointer :: ANAIM(:), GCMEX(:) contains !BOP ! !IROUTINE: SetServices -- Sets ESMF services for this component ! !INTERFACE: subroutine SetServices ( GC, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, optional , intent( OUT) :: RC ! return code ! !DESCRIPTION: The SetServices for the Chemistry GC needs to register its ! Initialize and Run. It uses the MAPL_Generic construct for defining ! state specs and couplings among its children. In addition, it creates the ! children GCs and runs their respective SetServices. ! ! !REVISION HISTORY: ! ! 13Aug2007 Todling/daSilva Add this component; still doesn't work as meant ! 08Jun2008 Todling Merge with latest MAPL version as in DAS-215 !EOP !============================================================================= ! ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals integer :: I integer :: n, id integer :: nGCM, nANA integer :: myid, npes integer :: NX, NY integer, pointer :: gcmPets(:), anaPets(:) type (ESMF_VM) :: vm type(MAPL_MetaComp), pointer :: MAPL !============================================================================= ! Begin... ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'SetServices' call ESMF_GridCompGet( GC, NAME=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // '::' // Iam ! nothing to register for this component ! -------------------------------------- ! get vm call ESMF_VMGetCurrent(vm, rc=status) VERIFY_(STATUS) call ESMF_VmGet(VM, localPet=MYID, petCount=npes, rc=status) VERIFY_(STATUS) ! get NX and NY from the resource file call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource(MAPL, NX, LABEL="NX:", RC=status) VERIFY_(STATUS) call MAPL_GetResource(MAPL, NY, LABEL="NY:", RC=status) VERIFY_(STATUS) nGCM = NX *NY differentVMs = .false. if (nGCM < npes) then differentVMs = .true. nANA = npes - nGCM allocate(gcmPets(nGCM), anaPets(nANA), stat=status) VERIFY_(STATUS) #ifdef GCM_STARTS_AT_PE0 do I = 1, nGCM gcmPets(I) = I-1 ! 0-based end do do I = 1, nANA anaPets(I) = nGCM+I-1 ! 0-based end do #else do I = 1, nANA anaPets(I) = I-1 ! 0-based end do do I = 1, nGCM gcmPets(I) = nANA+I-1 ! 0-based end do #endif GCM = MAPL_AddChild(GC, NAME='GCM', SS=GcmSetServices, & petList=gcmPets, RC=STATUS) VERIFY_(STATUS) ANA = MAPL_AddChild(GC, NAME='ANA', SS=AnaSetServices, & petList=anaPets, RC=STATUS) VERIFY_(STATUS) deallocate(gcmPets, anaPets) ! Set the Initialize, Run and Finalize entry points !-------------------------------------------------- call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETINIT, Initialize, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETRUN, Run, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETFINAL, Finalize, RC=STATUS ) VERIFY_(STATUS) else ASSERT_(nGCM == npes) ! Create childrens gridded components and invoke their SetServices ! ---------------------------------------------------------------- GCM = MAPL_AddChild(GC, NAME='GCM', SS=GcmSetServices, RC=STATUS) VERIFY_(STATUS) ANA = MAPL_AddChild(GC, NAME='ANA', SS=AnaSetServices, RC=STATUS) VERIFY_(STATUS) end if ! Connect GCM with ANA ! -------------------- call MAPL0_AddConnectivity ( GC, & SRC_NAME = (/ & 'U ','V ','TV ','Q ' , & 'O3PPMV ', 'PHIS ','PS ' , & 'TS ','U10N ','V10N ','SNOMAS ' , & 'WET1 ','TSOIL1 ','Z0 ','QITOT ' , & 'QLTOT ','FRLAND ','FRLANDICE ','FRLAKE ' , & 'FROCEAN ','FRACI ' /), & DST_NAME = (/ & 'u ','v ','tv ','sphu ' , & 'ozone ', 'phis ','ps ' , & 'ts ','U10M ','V10M ','SNOWDP ' , & 'GWETTOP ','TSOIL1 ','Z0M ','qitot ' , & 'qltot ','frland ','frlandice ','frlake ' , & 'frocean ','frseaice ' /), & SRC_ID = GCM, & DST_ID = ANA, & RC=STATUS ) VERIFY_(STATUS) ! We manually fill all of ANA's imports call MAPL_TerminateImport ( GC, CHILD = ANA, RC=STATUS ) VERIFY_(STATUS) ! Set services now ! ---------------- call MAPL_GenericSetServices ( GC, RC=STATUS ) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine SetServices ! ................................. subroutine MAPL0_AddConnectivity ( GC, SRC_NAME, SRC_ID, DST_NAME, DST_ID, RC ) type(ESMF_GridComp), intent(INOUT) :: GC ! Gridded component character (len=*), intent(IN ) :: SRC_NAME(:) character (len=*), intent(IN ) :: DST_NAME(:) integer, intent(IN ) :: SRC_ID integer, intent(IN ) :: DST_ID integer, optional, intent( OUT) :: RC ! Error code: character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_AddConnectivityRename" integer :: STATUS integer :: N ASSERT_(size(SRC_NAME) == size(DST_NAME)) if (.not. differentVMs) then call MAPL_AddConnectivity(GC, SRC_NAME, SRC_ID, DST_NAME, DST_ID, RC=status) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end if N = size(SRC_NAME) allocate(ANAIM(N), GCMEX(N), stat=status) VERIFY_(STATUS) ASSERT_(SRC_ID == GCM) ASSERT_(DST_ID == ANA) GCMEX = SRC_NAME ANAIM = DST_NAME RETURN_(ESMF_SUCCESS) end subroutine MAPL0_AddConnectivity ! ................................. !============================================================================= ! The rest of this file contains routines that are executed ONLY when the code ! is running on different VMs !============================================================================= !BOP ! !IROUTINE: Initialize -- Initialize method for the GEOS ANA component ! !INTERFACE: subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: The Initialize method of the Composite Analysis Gridded Component. !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (MAPL_MetaComp), pointer :: MAPL type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:), GEX(:) type (ESMF_Field) :: FIELD type (ESMF_Field) :: FIELD0 type (ESMF_VM) :: vm integer :: J integer :: dims character(len=ESMF_MAXSTR) :: string integer :: freq type(ESMF_TimeInterval) :: tstep type(ESMF_TimeInterval) :: Frequency type(ESMF_Time) :: currTime type(ESMF_Time) :: ringTime type(ESMF_Alarm) :: ALARM !============================================================================= ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- Iam = "Initialize" call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) ! get vm call ESMF_VMGetCurrent(vm, rc=status) VERIFY_(STATUS) ! create alarm for coupling/redist !================================= call MAPL_GetResource(MAPL, freq, Label="COUPLE_FREQUENCY:", & default=1, rc=status) VERIFY_(STATUS) call ESMF_ClockGet(clock, currTime=currTime, timestep=tstep, rc=status) VERIFY_(STATUS) Frequency = freq*tstep RingTime=currTime Alarm = ESMF_AlarmCreate( "COUPLE_"//trim(COMP_NAME), & clock=clock, RingTime=ringTime, RingInterval=Frequency, & sticky=.false., rc=status ) VERIFY_(STATUS) ! make sure this alrm is ringing on the first time step call ESMF_AlarmRingerOn(Alarm, rc=status) VERIFY_(STATUS) ! traditional Initialize call MAPL_Get ( MAPL, GCS=GCS, GIM = GIM, GEX = GEX, RC=STATUS ) VERIFY_(STATUS) ! Create grid for this component ? !--------------------------------- ! call MAPL_GridCreate(GC, rc=status) ! VERIFY_(STATUS) ! Recursive setup of grids (should be disabled) ! call ESMF_GridCompGet(GC, grid=anagrid, rc=status) ! VERIFY_(STATUS) ! call ESMF_GridCompSet(GCS(ANA), grid=anagrid, rc=status) ! VERIFY_(STATUS) ! Call Initialize for every Child !-------------------------------- call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) VERIFY_(STATUS) ! call ESMF_VMBarrier(vm, rc=status) ! VERIFY_(STATUS) SIMP = ESMF_StateCreate(statename = "GCS_super_imports", rc=status) VERIFY_(STATUS) SEXP = ESMF_StateCreate(statename = "GCS_super_exports", rc=status) VERIFY_(STATUS) DO J = 1, size(ANAIM) call ESMF_StateGet ( GIM(ANA), ANAIM(J), FIELD, RC=STATUS ) if (STATUS /= ESMF_SUCCESS) cycle call ESMF_StateAdd( SIMP, FIELD, RC=STATUS) VERIFY_(STATUS) END DO call write_parallel("DBG:reconcile IMPORTS") call ESMF_StateReconcile(SIMP, vm, ESMF_ATTRECONCILE_ON, rc=status) VERIFY_(STATUS) allocate(anaNeedsThis(size(ANAIM)), stat=status) VERIFY_(STATUS) DO J = 1, size(GCMEX) call ESMF_StateGet ( SIMP, ANAIM(J), FIELD, RC=STATUS ) if (STATUS /= ESMF_SUCCESS) then anaNeedsThis(J) = .false. ! ANA does not care about this cycle else anaNeedsThis(J) = .true. end if call ESMF_StateGet ( GEX(GCM), GCMEX(J), FIELD, RC=STATUS ) if (STATUS /= ESMF_SUCCESS) cycle ! this is not GCM pe ! force allocation of deferred exports call MAPL_AllocateCoupling(field, rc=status) VERIFY_(STATUS) call ESMF_StateAdd( SEXP, FIELD, RC=STATUS) VERIFY_(STATUS) END DO call write_parallel("DBG:reconcile EXPORTS") call ESMF_StateReconcile(SEXP, vm, ESMF_ATTRECONCILE_ON, rc=status) VERIFY_(STATUS) g2aRH(:)%isNeeded = .false. do J = 1, size(GCMEX) if (.not. anaNeedsThis(J)) cycle call ESMF_StateGet ( SIMP, ANAIM(J), FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_StateGet ( SEXP, GCMEX(J), FIELD0, RC=STATUS ) VERIFY_(STATUS) call ESMF_AttributeGet(FIELD0, NAME='DIMS', VALUE=DIMS, RC=STATUS) VERIFY_(STATUS) if (.not. g2aRH(dims)%isNeeded) then g2aRH(dims)%isNeeded = .true. call WRITE_PARALLEL("DBG: redistStore called for "//trim(ANAIM(J))) call ESMF_FieldRedistStore(srcField=field0, dstField=field, & routehandle=g2aRH(dims)%rh, rc=status) VERIFY_(STATUS) end if end do ! ALT: at this point could also call ESMF_FieldRedist ! but this is going to be needed only if ANA ! needs valid (i.e. filled in) imports RETURN_(ESMF_SUCCESS) end subroutine Initialize !============================================================================= subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: The Run method of the Composite Analysis Gridded Component. !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME integer :: J integer :: dims type (MAPL_MetaComp), pointer :: MAPL type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:), GEX(:) type (ESMF_Field) :: FIELD, FIELD0 type (ESMF_Alarm) :: ALARM type (ESMF_VM) :: vm logical :: timeToCouple Iam = "Run" call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam ! Get my MAPL_Generic state !-------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) ! get vm call ESMF_VMGetCurrent(vm, rc=status) VERIFY_(STATUS) ! Get children and their im/ex states from my generic state. !---------------------------------------------------------- call MAPL_Get ( MAPL, GCS=GCS, GIM=GIM, GEX=GEX, RC=STATUS ) VERIFY_(STATUS) call ESMF_ClockGetAlarm(clock, name="COUPLE_"//trim(COMP_NAME), & alarm=ALARM, rc=status) VERIFY_(STATUS) timeToCouple = ESMF_AlarmIsRinging( ALARM, rc=status) VERIFY_(STATUS) if (timeToCouple) then call ESMF_AlarmRingerOff(ALARM, RC=STATUS) VERIFY_(STATUS) end if ! run GCMs ! -------- ! this is only for debugging ! call WRITE_PARALLEL("Running GCM") call ESMF_GridCompRun ( GCS(GCM), GIM(GCM), GEX(GCM), clock, rc=status ) VERIFY_(STATUS) ! run "couplers", i.e. redist ! --------------------------- if (timeToCouple) then do J = 1, size(GCMEX) if (.not. anaNeedsThis(J)) cycle call ESMF_StateGet ( SIMP, ANAIM(J), FIELD, RC=STATUS ) VERIFY_(STATUS) ! this is only for debugging ! call WRITE_PARALLEL("... doing redist for "//trim(ANAIM(J))) call ESMF_StateGet ( SEXP, GCMEX(J), FIELD0, RC=STATUS ) VERIFY_(STATUS) ! ALT warning: I am not sure if everybody has DIMS properly set call ESMF_AttributeGet(FIELD0, NAME='DIMS', VALUE=DIMS, RC=STATUS) VERIFY_(STATUS) call ESMF_FieldRedist(srcField=FIELD0, dstField=FIELD, & routehandle=g2aRH(dims)%rh, rc=status) VERIFY_(STATUS) end do call ESMF_VMBarrier(vm, rc=status) VERIFY_(STATUS) end if ! run ANA ! -------- if (timeToCouple) then ! this is only for debugging ! call WRITE_PARALLEL("Running analysis/couple") call ESMF_GridCompRun ( GCS(ANA), GIM(ANA), GEX(ANA), clock, rc=status ) VERIFY_(STATUS) ! run "couplers", i.e. redist (NONE yet) ! --------------------------- end if RETURN_(ESMF_SUCCESS) end subroutine Run !============================================================================= subroutine Finalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: The Finalize method of the Composite Analysis Gridded Component. !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME integer :: J Iam = "Finalize" call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam call MAPL_GenericFinalize( GC, IMPORT, EXPORT, CLOCK, RC=STATUS ) VERIFY_(STATUS) ! clean-up DO J=1,3 ! covers MAPL_DimsVertOnly, MAPL_DimsHorzOnly, MAPL_DimsHorzVert if (g2aRH(J)%isNeeded) then call ESMF_FieldRedistRelease(g2aRH(J)%rh, rc=status) VERIFY_(STATUS) end if END DO deallocate(anaNeedsThis) deallocate(ANAIM, GCMEX) call ESMF_StateDestroy(SIMP, rc=status) VERIFY_(STATUS) call ESMF_StateDestroy(SEXP, rc=status) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine Finalize !============================================================================= end module GEOS_GcsGridCompMod