! +-======-+ ! 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 ! ! +-======-+ ! ********************************************************************* ! ***** Main Program **** ! ***** Composite Gridded Component SuperDynamics **** ! ***** (fvDycore plus Gravity Wave Drag) **** ! ***** Forced by Full Physics **** ! ***** (Longwave, Shortwave, RAS, Cloud, Turb) **** ! ********************************************************************* #include "GEOS_ErrLogMain.h" Program Main use ESMF_Mod use GEOS_Mod use GEOS_GenericCplCompMod, only: Cpl_SetServices => GenericCplSetServices use GEOS_singcolGridCompMod, only: GC1_SetServices => SetServices use GEOS_physicsGridCompMod, only: GC2_SetServices => SetServices implicit none integer :: RC ! Define Primary CAP Gridded Components GCs ! ----------------------------------------- integer, parameter :: DYNAM = 1 integer, parameter :: PHYS = 2 integer, parameter :: GCNUM = 2 type(ESMF_GridComp) :: GC(GCNUM) type(ESMF_CplComp) :: CC(GCNUM,GCNUM) type(ESMF_State) :: import(GCNUM) type(ESMF_State), pointer :: export(:) character(len=ESMF_MAXSTR) :: GCNAMES(GCNUM) data GCNAMES / 'SCMDYNAMICS' , & 'PHYSICS' / ! Define History Lists for Output ! ------------------------------- type history_list character(len=ESMF_MAXSTR) :: filename character(len=ESMF_MAXSTR) :: format character(len=ESMF_MAXSTR) :: mode character(len=ESMF_MAXSTR),pointer :: fields (:,:) integer :: frequency integer :: acc_interval integer :: ref_date integer :: ref_time integer :: duration type(ESMF_Alarm) :: his_alarm type(ESMF_Alarm) :: seg_alarm integer,pointer :: expSTATE (:) integer :: unit integer :: nfield endtype history_list type ( history_list ),pointer :: hlist(:) type(ESMF_VM) :: VM type(ESMF_DELayout) :: layout type(ESMF_Config) :: config type(ESMF_Clock) :: clock type(ESMF_Grid) :: grid type(ESMF_Bundle) :: bundle_i type(ESMF_Bundle) :: bundle_e type(ESMF_Field) :: field integer :: NQ, CCNUM integer :: NX, NY, nDEs integer :: LM integer :: I,k,n,m, rank integer :: nlist character(len=ESMF_MAXSTR), parameter :: IAm="GEOScap" character(len=ESMF_MAXSTR) :: cf_file character(len=ESMF_MAXSTR) :: cf_label character(len=ESMF_MAXSTR) :: expid character(len=ESMF_MAXSTR) :: expdsc integer :: STATUS type(ESMF_Alarm) :: Final_End_Time_Alarm logical Alarm ! Initialize framework ! -------------------- call ESMF_Initialize (vm=vm, rc=status) VERIFY_(STATUS) ! ********************************************************************** ! **** Create Layout and Initialize Clock & EXP_ID **** ! ********************************************************************** config = ESMF_ConfigCreate (rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile ( config,'CAP.rc',rc=status ) ; VERIFY_(STATUS) call ESMF_ConfigGetAttribute ( config, LM, label ='LM:', rc=status ) ; VERIFY_(STATUS) call ESMF_ConfigGetAttribute ( config, value=expid, label ='EXPID:', default='test', rc=status ) if( STATUS /= -2) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, value=expdsc, label ='EXPDSC:', default='test', rc=status ) if( STATUS /= -2) then VERIFY_(STATUS) endif call Clock_Init ( config,clock,Final_End_Time_Alarm,expid,expdsc,rc=status ) VERIFY_(STATUS) grid = AppGridCreate(config, vm=vm, rc=status); VERIFY_(STATUS) ! ********************************************************************** ! **** Create CAP Gridded Components **** ! ********************************************************************** do n=1,GCNUM cf_label = 'CAP_GCx_config_file:' write(cf_label(7:7),'(i1)') n call ESMF_ConfigGetAttribute ( config, & value=cf_file, & label=trim(cf_label), & default=trim(GCNAMES(n)) // '.rc', rc=status ) if( STATUS /= -2) then VERIFY_(STATUS) endif GC(n) = ESMF_GridCompCreate ( vm=vm, name=trim(GCNAMES(n)), & grid = grid, & gridcomptype=ESMF_ATM, & configfile=cf_file, rc=status) VERIFY_(STATUS) enddo ! ********************************************************************** ! **** Create CAP Gridded Component Import and Exports **** ! ********************************************************************** allocate ( export(GCNUM),stat=status ) VERIFY_(STATUS) do n=1,GCNUM import(n) = ESMF_StateCreate ( trim(GCNAMES(n)) // '_Imports', & ESMF_STATE_IMPORT, rc=status ) VERIFY_(STATUS) export(n) = ESMF_StateCreate ( trim(GCNAMES(n)) // '_Exports', & ESMF_STATE_EXPORT, rc=status ) VERIFY_(STATUS) enddo ! ********************************************************************** ! **** Create CAP Coupler Components **** ! ********************************************************************** do n=1,GCNUM do m=1,GCNUM if( m.ne.n ) then CC(m,n) = ESMF_CplCompCreate ( vm=vm, name=trim(GCNAMES(m)) // 'x' // trim(GCNAMES(n)), & config=config, rc=status ) VERIFY_(STATUS) endif enddo enddo ! ********************************************************************** ! **** Register services for components **** ! **** Note: Enumeration is done by hand !! **** ! ********************************************************************** call ESMF_GridCompSetServices ( GC(1), GC1_SetServices, status ) ; VERIFY_(STATUS) call ESMF_GridCompSetServices ( GC(2), GC2_SetServices, status ) ; VERIFY_(STATUS) ! ********************************************************************** ! **** Register services for couplers **** ! ********************************************************************** do n=1,GCNUM do m=1,GCNUM if( m.ne.n ) then call ESMF_CplCompSetServices ( CC(m,n), CPL_SetServices, status ) ; VERIFY_(STATUS) call GEOS_SetVarSpecForCC ( GC(m), GC(n), CC(m,n), rc=STATUS ) ; VERIFY_(STATUS) endif enddo enddo ! ********************************************************************** ! **** Initialize Gridded Components **** ! ********************************************************************** do n=1,GCNUM call ESMF_GridCompInitialize ( GC(n), import(n), export(n), clock, & ESMF_SINGLEPHASE, rc=status ) VERIFY_(STATUS) enddo ! ********************************************************************** ! **** Initialize Coupler Components **** ! ********************************************************************** do n=1,GCNUM do m=1,GCNUM if( m.ne.n ) then call ESMF_CplCompInitialize ( CC(m,n), export(m), import(n), clock, rc=status ) VERIFY_(STATUS) endif enddo enddo ! ********************************************************************** ! **** Kludge for Bundles **** ! ********************************************************************** call ESMF_StateGetBundle ( export(PHYS), 'TRADV', BUNDLE_E, RC=STATUS ) ; VERIFY_(STATUS) call ESMF_StateGetBundle ( import(DYNAM), 'QTR' , BUNDLE_I, RC=STATUS ) ; VERIFY_(STATUS) ! Count the friendlies !--------------------- call ESMF_BundleGet ( BUNDLE_E, fieldCount=NQ, RC=STATUS ) ; VERIFY_(STATUS) IF (NQ > 0) THEN DO I = 1, NQ call ESMF_BundleGetField ( bundle_E, FieldIndex=I, field=field, rc=status ) VERIFY_(STATUS) call ESMF_BundleAddField ( bundle_I, field, rc=status ) VERIFY_(STATUS) END DO END IF ! Initialize History Lists for Output ! ----------------------------------- call GEOS_HistoryInit ( hlist,clock,export,rc=STATUS ) VERIFY_(STATUS) ! ********************************************************************* ! ***** Main Time Loop **** ! ********************************************************************* call write_parallel ('Begin Model Execution ...') call write_parallel ('-------------------------') do ! Run all Gridded Components ! -------------------------- #if 1 do n=1,GCNUM call ESMF_GridCompRun ( GC(n), import(n), export(n), clock, rc=status ) VERIFY_(STATUS) do m=1,GCNUM if( m.ne.n ) then call ESMF_CplCompRun ( CC(n,m), export(n), import(m), clock, rc=status ) VERIFY_(STATUS) endif enddo enddo #endif ! Advance the Clock ! ----------------- call ESMF_ClockAdvance ( clock, rc=status ) VERIFY_(STATUS) ! Call History Run for Output ! --------------------------- call GEOS_HistoryRun ( hlist,clock,export,expid,expdsc,LM,rc=status ) VERIFY_(STATUS) ! Check for Segment Ending Time ! ----------------------------- if ( ESMF_ClockIsStopTime( clock, rc=status ) ) exit VERIFY_(STATUS) enddo ! ********************************************************************* ! ***** Close and Finalize Job **** ! ********************************************************************* ! Close UNITs of GEOSgcm History Data ! ----------------------------------- nlist = size(hlist) do n=1,nlist if( hlist(n)%unit.ne.0 ) call FREE_FILE( hlist(n)%unit ) enddo ! Finalize ! -------- do n=1,GCNUM call ESMF_GridCompFinalize( GC(n),import(n),export(n),clock,rc=status ) VERIFY_(STATUS) enddo do n=1,GCNUM do m=1,GCNUM if( m.ne.n ) then call ESMF_CplCompFinalize ( CC(n,m), export(n), import(m), clock, rc=status ) VERIFY_(STATUS) endif enddo enddo call CAP_FINI ( layout,clock ) ! Check for Job ReSubmit ! ---------------------- alarm = ESMF_AlarmIsRinging ( Final_End_Time_Alarm,rc=status ) ; VERIFY_(STATUS) if( alarm ) then rc = 1 ! Final End Time has been reached, DO NOT resubmit job else rc = 0 ! Final End Time has been NOT reached, DO resubmit job endif ! Finalize framework ! ------------------ call ESMF_Finalize (status) VERIFY_(STATUS) call exit (rc) contains #include "GEOS_ErrLog.h" !BOP ! !IROUTINE: GEOS\_HistoryInit -- Initializes GEOS History Lists for Diagnostic Output ! !INTERFACE: subroutine GEOS_HistoryInit ( list,clock,export,rc ) ! !ARGUMENTS: type(history_list), pointer :: list(:) type(ESMF_Clock) :: clock type(ESMF_State), pointer :: export(:) integer, optional, intent(out) :: rc ! !DESCRIPTION: ! GEOS\_HistoryInit initializes GEOS History Lists for Diagnostic Output. ! Diagnostics have the following attributes: ! ! \begin{description} ! \item[1)] Diagnostics may be "instantaneous" or "time-averaged" ! \item[2)] Diagnostics have a "frequency" and an associated "ref_date" and "ref_time" ! from which the frequency is based ! \item[3)] Time-Averaged Diagnostics have an associated accumulation interval, "acc_interval", ! which may be <= to the diagnostic "frequency" ! \item[4)] Diagnostics are "time-stamped" with the ending time of the frequency period ! \item[5)] The default "acc_interval" is the diagnostic "frequency" ! \item[6)] The default "ref_date" is the beginning date of the experiment ! \item[7)] The default "ref_time" is 0z ! \end{description} ! ! Through the use of History Lists, the user may define the type of diagnostic output desired. ! History Lists contain the following attributes: ! ! \begin{description} ! \item[filename] Character string defining the filename of a particular diagnostic output stream. ! \item[mode] Character string equal to "instantaneous" or "time-averaged". Default = "instantaneous". ! \item[frequency] Integer (HHMMSS) for the frequency of output. Default = 060000. ! \item[acc_interval] Integer (HHMMSS) for the acculation interval (<= frequency) for time-averaged diagnostics. ! Default = Diagnostic Frequency. ! \item[ref_date] Integer (YYYYMMDD) reference date from which the frequency is based. ! Default is the Experiment beginning date. ! \item[ref_time] Integer (HHMMSS) reference time from which the frequency is based. Default = 0. ! \item[duration] Integer (HHMMSS) for the duration of each file. Default = 240000 (one-day segments). ! \item[fields] Paired character strings for the diagnostic Name and its associated Gridded Component. ! \end{description} ! !EOP type(ESMF_State), pointer :: exptmp (:) type(ESMF_Time) :: StartTime type(ESMF_Time) :: CurrTime type(ESMF_Time) :: RingTime type(ESMF_Time) :: RefTime type(ESMF_TimeInterval) :: Frequency type(ESMF_Array) :: array type(ESMF_Calendar) :: cal type(ESMF_Config) :: config character(len=ESMF_MAXSTR) :: string character*80,allocatable :: fields (:,:) character*80 :: fields1 character*80 :: fields2 logical tend character(len=ESMF_MAXSTR),allocatable :: statelist(:) character(len=ESMF_MAXSTR),allocatable :: tmplist(:) integer :: nlist,unit,nsecf,nfield,nstatelist integer :: k,m,n,sec,rank,nhms,status,size0 integer :: year,month,day,hour,minute,nymd0,nhms0 integer, dimension(ESMF_MAXDIM) :: lbounds, ubounds integer :: ref_time(6) real, pointer, dimension(:,:) :: Q2D real, pointer, dimension(:,:,:) :: Q3D nsecf(nhms) = nhms/10000*3600 + mod(nhms,10000)/100*60 + mod(nhms,100) ! Get Clock StartTime for Default ref_date, ref_time ! -------------------------------------------------- call ESMF_ClockGet ( clock, calendar=cal, rc=STATUS ) ; VERIFY_(STATUS) call ESMF_ClockGet ( clock, currTime=CurrTime, rc=STATUS ) ; VERIFY_(STATUS) call ESMF_ClockGet ( clock, StartTime=StartTime,rc=STATUS ) ; VERIFY_(STATUS) call ESMF_TimeGet ( StartTime,TimeString=string ,rc=STATUS ) ; VERIFY_(STATUS) read(string( 1: 4),'(i4.4)') year read(string( 6: 7),'(i2.2)') month read(string( 9:10),'(i2.2)') day nymd0 = year*10000 + month*100 + day nhms0 = 000000 ! Read User-Supplied History Lists from Config File ! ------------------------------------------------- config = ESMF_ConfigCreate (rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile ( config,'history_list.rc',rc=STATUS ) ; VERIFY_(STATUS) n = 1 do while ( STATUS /= 39 ) if( n.lt.10 ) then string = 'list(n)%filename:' write(string(6:6),'(i1)') n else if( n.lt.100 ) then string = 'list(nn)%filename:' write(string(6:7),'(i2)') n else if( n.lt.1000 ) then string = 'list(nnn)%filename:' write(string(6:8),'(i3)') n endif call ESMF_ConfigFindLabel ( config,trim(string),rc=STATUS ) if( STATUS /= 39 ) then VERIFY_(STATUS) n = n+1 endif enddo nlist = n-1 allocate( list(nlist) ) ! Initialize History Lists ! ------------------------ do n=1,nlist list(n)%unit = 0 if( n.lt.10 ) then string = 'list(n)%' write(string(6:6),'(i1)') n else if( n.lt.100 ) then string = 'list(nn)%' write(string(6:7),'(i2)') n else if( n.lt.1000 ) then string = 'list(nnn)%' write(string(6:8),'(i3)') n endif call ESMF_ConfigGetAttribute ( config, value=list(n)%filename, & label=trim(string) // 'filename:' ) call ESMF_ConfigGetAttribute ( config, value=list(n)%format,default='flat', & label=trim(string) // 'format:' ,rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, value=list(n)%mode,default='instantaneous', & label=trim(string) // 'mode:' ,rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, list(n)%frequency, default=060000, & label=trim(string) // 'frequency:',rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, list(n)%acc_interval, default=list(n)%frequency, & label=trim(string) // 'acc_interval:',rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, list(n)%ref_date, default=nymd0, & label=trim(string) // 'ref_date:',rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, list(n)%ref_time, default=nhms0, & label=trim(string) // 'ref_time:',rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigGetAttribute ( config, list(n)%duration, default=240000, & label=trim(string) // 'duration:' ,rc=status ) if( STATUS /= -2 ) then VERIFY_(STATUS) endif call ESMF_ConfigFindLabel ( config,trim(string) // 'fields:',rc=STATUS ) tend = .false. m = 0 do while (.not.tend) m = m+1 allocate( fields(2,m) ) call ESMF_ConfigGetAttribute ( config,value=fields1 ) call ESMF_ConfigGetAttribute ( config,value=string ) call ESMF_ConfigGetAttribute ( config,value=fields2 ) call ESMF_ConfigNextLine ( config,tableEnd=tend,rc=STATUS ) VERIFY_(STATUS) if( m==1 ) then fields(1,m) = fields1 fields(2,m) = fields2 allocate( list(n)%fields(2,m) ) list(n)%fields = fields else fields(1,1:m-1) = list(n)%fields(1,:) fields(2,1:m-1) = list(n)%fields(2,:) fields(1,m) = fields1 fields(2,m) = fields2 deallocate (list(n)%fields) allocate( list(n)%fields(2,m) ) list(n)%fields = fields endif deallocate (fields) enddo list(n)%nfield = m enddo ! Set Alarms based on Reference Date and Time ! ------------------------------------------- do n=1,nlist REF_TIME(1) = list(n)%ref_date/10000 REF_TIME(2) = mod(list(n)%ref_date,10000)/100 REF_TIME(3) = mod(list(n)%ref_date,100) REF_TIME(4) = list(n)%ref_time/10000 REF_TIME(5) = mod(list(n)%ref_time,10000)/100 REF_TIME(6) = mod(list(n)%ref_time,100) call ESMF_TimeSet( RefTime, YY = REF_TIME(1), & MM = REF_TIME(2), & DD = REF_TIME(3), & H = REF_TIME(4), & M = REF_TIME(5), & S = REF_TIME(6), calendar=cal, rc=rc ) sec = nsecf( list(n)%frequency ) call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; VERIFY_(STATUS) RingTime = RefTime if (RingTime < currTime) then RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency endif list(n)%his_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, rc=status ) sec = nsecf( list(n)%duration ) call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; VERIFY_(STATUS) RingTime = RefTime if (RingTime < currTime) then RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency endif list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, rc=status ) enddo ! Extract List of Unique Export State Names ! ----------------------------------------- size0 = size( export ) nstatelist = size0 allocate( statelist(size0) ) do n=1,nstatelist call ESMF_StateGet ( export(n),name=string,rc=status ) VERIFY_(STATUS) k = index( string,'_' )-1 statelist(n) = string(1:k) enddo do n=1,nlist do m=1,list(n)%nfield k=1 do while ( statelist(k).ne.list(n)%fields(2,m) .and. k.le.nstatelist ) k=k+1 enddo if(k.eq.nstatelist+1) then allocate( tmplist (nstatelist) ) tmplist = statelist nstatelist = k deallocate( statelist ) allocate( statelist(nstatelist) ) statelist(1:k-1) = tmplist statelist(k) = list(n)%fields(2,m) deallocate( tmplist ) endif enddo enddo if( GEOS_AM_I_ROOT() ) then print * print *, 'Independent Output Export States:' print *, '---------------------------------' do n=1,nstatelist print *, n,trim(statelist(n)) enddo endif ! Get Output Export States ! ------------------------ allocate ( exptmp (size0) ) exptmp = export deallocate ( export ) allocate ( export(nstatelist) ) do n=1,nstatelist call GEOS_ExportStateGet ( exptmp,statelist(n),export(n),rc=status ) if( STATUS/= ESMF_SUCCESS ) then call write_parallel ('Cannot Find ' // trim(statelist(n)) ) endif VERIFY_(STATUS) enddo deallocate ( exptmp ) ! Associate Output Names with EXPORT State Index ! ---------------------------------------------- do n=1,nlist allocate( list(n)%expSTATE(list(n)%nfield) ) do m=1,list(n)%nfield do k=1,nstatelist if( trim(list(n)%fields(2,m)) .eq. trim(statelist(k)) ) list(n)%expSTATE(m) = k enddo enddo enddo deallocate( statelist ) ! Ensure Diagnostic Output has been Allocated ! ------------------------------------------- do n=1,nlist do m=1,list(n)%nfield call ESMFL_StateGetFieldArray( export(list(n)%expSTATE(m)),trim(list(n)%fields(1,m)),array,status ) VERIFY_(STATUS) call ESMF_ArrayGet( array, RANK=rank, lbounds=lbounds, ubounds=ubounds, rc=status) ; VERIFY_(STATUS) if( rank==2 ) then call ESMFL_StateGetPointerToData( export(list(n)%expSTATE(m)), Q2D, & trim(list(n)%fields(1,m)),alloc=.true.,rc=status ) VERIFY_(STATUS) endif if( rank==3 ) then call ESMFL_StateGetPointerToData( export(list(n)%expSTATE(m)), Q3D, & trim(list(n)%fields(1,m)),alloc=.true.,rc=status ) VERIFY_(STATUS) endif enddo enddo ! Echo History List Data Structure ! -------------------------------- if( GEOS_AM_I_ROOT() ) then print * do n=1,nlist print *, 'Initializing Output Stream: ', trim(list(n)%filename) print *, ' Format: ', trim(list(n)%format) print *, ' Mode: ', trim(list(n)%mode) print *, ' Frequency: ', list(n)%frequency if( trim(list(n)%mode).eq.'time_averaged' ) & print *, 'Acc_Interval: ', list(n)%acc_interval print *, ' Ref_Date: ', list(n)%ref_date print *, ' Ref_Time: ', list(n)%ref_time print *, ' Duration: ', list(n)%duration print *, ' Fields: ',((trim(list(n)%fields(1,m)),' '),m=1,list(n)%nfield) print * enddo endif RETURN_(ESMF_SUCCESS) end subroutine GEOS_HistoryInit subroutine GEOS_HistoryRun ( hlist,clock,export,expid,expdsc,LM,rc ) integer :: nlist,LM type(ESMF_Clock) :: clock type(ESMF_State) :: export (:) type(history_list) :: hlist (:) type(ESMF_TimeInterval) :: Frequency integer, optional, intent(out) :: rc character(len=ESMF_MAXSTR) :: DateStamp character(len=ESMF_MAXSTR) :: expid character(len=ESMF_MAXSTR) :: expdsc character(len=ESMF_MAXSTR) :: filename integer :: n,m,status logical :: NewSeg logical :: Output logical :: LOUT logical, allocatable, save :: LCTL(:) logical :: first data first /.true./ ! Initialize Logical for Grads Control File ! ----------------------------------------- nlist = size(hlist) if( first ) then allocate( LCTL(nlist) ) do n=1,nlist if( hlist(n)%format == 'flat' ) then LCTL(n) = .true. else LCTL(n) = .false. endif enddo first = .false. endif ! Retrieve Current Date and Time ! ------------------------------ call get_DateStamp ( clock,DateStamp,expid,rc=status ) ; VERIFY_(STATUS) ! Check for History Output ! ------------------------ LOUT = .false. do n=1,nlist Output = ESMF_AlarmIsRinging ( hlist(n)%his_alarm,rc=status ) ; VERIFY_(STATUS) NewSeg = ESMF_AlarmIsRinging ( hlist(n)%seg_alarm,rc=status ) ; VERIFY_(STATUS) if( Output ) then if( .not.LOUT ) then call WRITE_PARALLEL( "" ) LOUT = .true. endif call WRITE_PARALLEL( " Writing History Output for File: " // trim(hlist(n)%filename) ) if( NewSeg .and. hlist(n)%unit.ne.0 .and. hlist(n)%duration.ne.0 ) then call FREE_FILE( hlist(n)%unit ) hlist(n)%unit = 0 endif if( hlist(n)%unit.eq.0 ) then filename = trim(expid) // '.' // trim(hlist(n)%filename) // '.' // trim(DateStamp) hlist(n)%unit = GETFILE( trim(filename), form="unformatted" ) if( LCTL(n) ) then call GEOS_GradsCtlWrite ( clock,export,hlist(n),filename,expid,expdsc,LM,rc ) LCTL(n) = .false. endif endif do m=1,hlist(n)%nfield call GEOS_VarWrite ( hlist(n)%unit, STATE=export(hlist(n)%expSTATE(m)), NAME=trim(hlist(n)%fields(1,m)), rc=status ); VERIFY_(STATUS) enddo call ESMF_AlarmRingerOff( hlist(n)%his_alarm,rc=status ) ; VERIFY_(STATUS) endif if( NewSeg) then call ESMF_AlarmRingerOff( hlist(n)%seg_alarm,rc=status ) ; VERIFY_(STATUS) endif enddo if( LOUT ) call WRITE_PARALLEL( "" ) RETURN_(ESMF_SUCCESS) end subroutine GEOS_HistoryRun subroutine GEOS_GradsCtlWrite ( clock,export,list,filename,expid,expdsc,LM,rc ) type(ESMF_Clock), intent(inout) :: clock type(ESMF_State) :: export (:) type(history_list) :: list character(len=*) :: filename character(len=*) :: expid character(len=*) :: expdsc integer :: LM integer, optional, intent(out) :: rc type(ESMF_Array) :: array type(ESMF_Field) :: field type(ESMF_Grid) :: grid type(ESMF_Time) :: CurrTime type(ESMF_Time) :: StopTime type(ESMF_Calendar) :: cal type(ESMF_TimeInterval) :: ti, Frequency integer :: nsteps integer, dimension(ESMF_MAXDIM):: lbounds, ubounds integer, allocatable :: vdim(:) character(len=ESMF_MAXSTR) :: TimeString integer :: DIMS(3) integer :: IM,JM character*3 :: months(12) data months /'JAN','FEB','MAR','APR','MAY','JUN', & 'JUL','AUG','SEP','OCT','NOV','DEC'/ integer :: unit,nfield integer :: k,m,n,nsecf,nhms,rank,status integer :: year,month,day,hour,minute integer :: gridRank real LONBEG,DLON real LATBEG,DLAT integer zero, freq nsecf(nhms) = nhms/10000*3600 + mod(nhms,10000)/100*60 + mod(nhms,100) ZERO = 0 call ESMF_ClockGet ( clock, currTime=CurrTime ,rc=STATUS ) ; VERIFY_(STATUS) call ESMF_ClockGet ( clock, StopTime=StopTime ,rc=STATUS ) ; VERIFY_(STATUS) call ESMF_ClockGet ( clock, Calendar=cal ,rc=STATUS ) ; VERIFY_(STATUS) call ESMF_TimeGet ( CurrTime, timeString=TimeString, rc=status ) ; VERIFY_(STATUS) read(timestring( 1: 4),'(i4.4)') year read(timestring( 6: 7),'(i2.2)') month read(timestring( 9:10),'(i2.2)') day read(timestring(12:13),'(i2.2)') hour read(timestring(15:16),'(i2.2)') minute ti = StopTime-CurrTime freq = nsecf( list%frequency ) call ESMF_TimeIntervalSet( Frequency, S=freq, calendar=cal, rc=status ) ; VERIFY_(STATUS) nsteps = ti/Frequency + 1 ! Get Global Horizontal Dimensions ! -------------------------------- call ESMF_StateGetField ( export(list%expSTATE(1)),trim(list%fields(1,1)),field,rc=status ) VERIFY_(STATUS) call ESMF_FieldGet ( field, grid, rc=status ) VERIFY_(STATUS) call ESMF_GridGet(GRID, dimCount=gridRank, rc=STATUS) VERIFY_(STATUS) if (gridRank == 3) then call ESMF_GridGet(GRID, horzRelLoc=ESMF_CELL_CENTER, & vertRelLoc=ESMF_CELL_CENTER, & globalCellCountPerDim=DIMS, RC=STATUS) else ! if (gridRank == 2) call ESMF_GridGet(GRID, horzRelLoc=ESMF_CELL_CENTER, & globalCellCountPerDim=DIMS, RC=STATUS) end if VERIFY_(STATUS) IM = DIMS(1) JM = DIMS(2) DLON = 360.0/ IM DLAT = 180.0/(JM-1) LONBEG = -180.0 + DLON*0.5 LATBEG = - 90.0 ! Compute Vertical Dimension for each Field (Augment nfield for VDIMS > LM) ! ------------------------------------------------------------------------- allocate( vdim(list%nfield) ) nfield = list%nfield do m = 1,list%nfield call ESMFL_StateGetFieldArray( export(list%expSTATE(m)),trim(list%fields(1,m)),array,status ) VERIFY_(STATUS) call ESMF_ArrayGet( array, RANK=rank, lbounds=lbounds, ubounds=ubounds, rc=status ) VERIFY_(STATUS) if( rank==2 ) vdim(m) = 0 if( rank==3 ) then vdim(m) = ubounds(3)-lbounds(3)+1 if( vdim(m).gt.LM ) nfield = nfield+1 endif enddo ! Create Grads Control File ! ------------------------- unit = GETFILE( trim(expid) // '.' // trim(list%filename) // '.ctl', form="formatted" ) if( GEOS_AM_I_ROOT() ) then print * if ( freq < 3600 ) then write(unit,201) trim(filename),trim(expdsc), & IM,LONBEG,DLON, JM,LATBEG,DLAT, LM, & nsteps, & hour,minute,day,months(month),year,& freq/60, nfield else if ( freq < 86400 ) then write(unit,202) trim(filename),trim(expdsc), & IM,LONBEG,DLON, JM,LATBEG,DLAT, LM, & nsteps, & hour,minute,day,months(month),year,& freq/3600, nfield else if ( freq < 30*86400 ) then write(unit,203) trim(filename),trim(expdsc), & IM,LONBEG,DLON, JM,LATBEG,DLAT, LM, & nsteps, & hour,minute,day,months(month),year,& freq/86400, nfield else write(unit,204) trim(filename),trim(expdsc), & IM,LONBEG,DLON, JM,LATBEG,DLAT, LM, & nsteps, & hour,minute,day,months(month),year,& freq/(30*86400), nfield endif do m=1,list%nfield if( vdim(m).le.LM ) then write(unit,102) trim(list%fields(1,m)),vdim(m),trim(list%fields(1,m)) else write(unit,102) trim(list%fields(1,m)),LM ,trim(list%fields(1,m)) if( trim(list%fields(1,m)).eq.'PLE' ) then write(unit,102) 'PS',ZERO,'PS' else write(unit,102) trim(list%fields(1,m)) // 's',ZERO,trim(list%fields(1,m)) // 's' endif endif enddo write(unit,103) endif call FREE_FILE( unit ) deallocate( vdim ) 201 format('dset ^',a,/, 'title ',a,/, & 'options sequential template big_endian',/, & 'undef 1e15',/, & 'xdef ',i3,' linear ',f8.3,2x,f8.3,/, & 'ydef ',i3,' linear ',f8.3,2x,f8.3,/, & 'zdef ',i3,' linear 1 1',/, & 'tdef ',i3,' linear ',i2.2,':',i2.2,'z',i2.2,a3,i4.4,3x,i2.2,'mn',/, & 'vars ',i3) 202 format('dset ^',a,/, 'title ',a,/, & 'options sequential template big_endian',/, & 'undef 1e15',/, & 'xdef ',i3,' linear ',f8.3,2x,f8.3,/, & 'ydef ',i3,' linear ',f8.3,2x,f8.3,/, & 'zdef ',i3,' linear 1 1',/, & 'tdef ',i3,' linear ',i2.2,':',i2.2,'z',i2.2,a3,i4.4,3x,i2.2,'hr',/, & 'vars ',i3) 203 format('dset ^',a,/, 'title ',a,/, & 'options sequential template big_endian',/, & 'undef 1e15',/, & 'xdef ',i3,' linear ',f8.3,2x,f8.3,/, & 'ydef ',i3,' linear ',f8.3,2x,f8.3,/, & 'zdef ',i3,' linear 1 1',/, & 'tdef ',i3,' linear ',i2.2,':',i2.2,'z',i2.2,a3,i4.4,3x,i2.2,'dy',/, & 'vars ',i3) 204 format('dset ^',a,/, 'title ',a,/, & 'options sequential template big_endian',/, & 'undef 1e15',/, & 'xdef ',i3,' linear ',f8.3,2x,f8.3,/, & 'ydef ',i3,' linear ',f8.3,2x,f8.3,/, & 'zdef ',i3,' linear 1 1',/, & 'tdef ',i3,' linear ',i2.2,':',i2.2,'z',i2.2,a3,i4.4,3x,i2.2,'mo',/, & 'vars ',i3) 102 format(a,i3,2x,'0',2x,"'",a,"'") 103 format('endvars') 104 format('dset ^',a,/, 'title ',a,/, & 'options sequential template big_endian',/, & 'undef 1e15',/, & 'xdef ',i3,' linear ',f8.3,2x,f8.3,/, & 'ydef ',i3,' linear ',f8.3,2x,f8.3,/, & 'zdef ',i3,' linear 1 1',/, & 'tdef ',i3,' linear ',i2.2,':',i2.2,'z',i2.2,a3,i4.4,3x,i2.2,'mn',/, & 'vars ',i3) RETURN_(ESMF_SUCCESS) end subroutine GEOS_GradsCtlWrite subroutine Clock_Init ( config,clock,Final_End_Time_Alarm,expid,expdsc,rc ) type(ESMF_Config) :: config type(ESMF_Clock), intent( out) :: clock type(ESMF_Alarm) :: Final_End_Time_Alarm character(len=*) :: expid character(len=*) :: expdsc integer, optional, intent( out) :: rc type(ESMF_Time) :: StartTime ! Initial Begin Time of Experiment type(ESMF_Time) :: StopTime ! Final Ending Time of Experiment type(ESMF_Time) :: CurrTime ! Current Time of Experiment type(ESMF_Time) :: SegTime ! Job Segment Ending Time of Experiment type(ESMF_Time) :: Time ! Current (temp only!) type(ESMF_TimeInterval) :: timeStep ! Model TimeStep type(ESMF_Calendar),save :: cal integer :: nymd,nhms ! Current Restart Time integer :: sec,status integer :: UNIT integer :: START_TIME(6), BEG_DATE(2) integer :: STOP_TIME(6), END_DATE(2) integer :: SGMT_TIME(6), JOB_DATE(2) integer :: CURR_TIME(6) integer :: JOB_SGMT(6) integer :: INTERVAL ! Read Clock Resource File ! ------------------------ call ESMF_ConfigGetAttribute( config, BEG_DATE, 2, label='BEG_DATE:', rc=status ) ; VERIFY_(STATUS) call ESMF_ConfigGetAttribute( config, END_DATE, 2, label='END_DATE:', rc=status ) ; VERIFY_(STATUS) call ESMF_ConfigGetAttribute( config, JOB_DATE, 2, label='JOB_SGMT:', rc=status ) ; VERIFY_(STATUS) call ESMF_ConfigGetAttribute( config, INTERVAL, label='RUN_DT:' , rc=status ) ; VERIFY_(STATUS) START_TIME(1) = BEG_DATE(1)/10000 START_TIME(2) = mod(BEG_DATE(1),10000)/100 START_TIME(3) = mod(BEG_DATE(1),100) START_TIME(4) = BEG_DATE(2)/10000 START_TIME(5) = mod(BEG_DATE(2),10000)/100 START_TIME(6) = mod(BEG_DATE(2),100) STOP_TIME(1) = END_DATE(1)/10000 STOP_TIME(2) = mod(END_DATE(1),10000)/100 STOP_TIME(3) = mod(END_DATE(1),100) STOP_TIME(4) = END_DATE(2)/10000 STOP_TIME(5) = mod(END_DATE(2),10000)/100 STOP_TIME(6) = mod(END_DATE(2),100) JOB_SGMT(1) = JOB_DATE(1)/10000 JOB_SGMT(2) = mod(JOB_DATE(1),10000)/100 JOB_SGMT(3) = mod(JOB_DATE(1),100) JOB_SGMT(4) = JOB_DATE(2)/10000 JOB_SGMT(5) = mod(JOB_DATE(2),10000)/100 JOB_SGMT(6) = mod(JOB_DATE(2),100) ! Read CAP Restart File for Current Time ! -------------------------------------- UNIT = GETFILE ( "cap_restart", form="formatted", ALL_PES=.true. ) if( GEOS_AM_I_ROOT() ) then print * print *, 'ExpID: ',trim(expid) print *, 'Descr: ',trim(expdsc) print * write(*,101) 'Initial Start_Time = ', beg_date write(*,101) ' Final Stop_Time = ', end_date write(*,101) ' Current Job_Sgmt = ', job_date write(*,102) ' RUN_DT = ', interval print * 101 format(a,i8.8,1x,i6.6) 102 format(a,i4) endif read(UNIT,100,err=999,end=999) nymd,nhms 100 format(i8.8,1x,i6.6) if( GEOS_AM_I_ROOT() ) then print *, 'Read CAP restart properly, Current Date = ',nymd print *, ' Current Time = ',nhms print * endif goto 1000 999 continue ! Initialize Restart Time with START_TIME nymd = START_TIME(1)*10000 & + START_TIME(2)*100 & + START_TIME(3) nhms = START_TIME(4)*10000 & + START_TIME(5)*100 & + START_TIME(6) if( GEOS_AM_I_ROOT() ) then print *, 'No CAP Restart, creating date from resource file, Start Date = ',nymd print *, ' Start Time = ',nhms print * endif 1000 continue call FREE_FILE (UNIT) ! Set CURR_TIME based on Current Restart Time ! ------------------------------------------- CURR_TIME(1) = nymd/10000 CURR_TIME(2) = mod(nymd,10000)/100 CURR_TIME(3) = mod(nymd,100) CURR_TIME(4) = nhms/10000 CURR_TIME(5) = mod(nhms,10000)/100 CURR_TIME(6) = mod(nhms,100) ! initialize calendar to be Gregorian type ! ---------------------------------------- cal = ESMF_CalendarCreate( "GregorianCalendar",ESMF_CAL_GREGORIAN,rc=status ) VERIFY_(STATUS) ! initialize start time for Alarm frequencies ! ------------------------------------------- call ESMF_TimeSet( StartTime, YY = START_TIME(1), & MM = START_TIME(2), & DD = START_TIME(3), & H = START_TIME(4), & M = START_TIME(5), & S = START_TIME(6), calendar=cal, rc=rc ) ! initialize final stop time ! -------------------------- call ESMF_TimeSet( StopTime, YY = STOP_TIME(1), & MM = STOP_TIME(2), & DD = STOP_TIME(3), & H = STOP_TIME(4), & M = STOP_TIME(5), & S = STOP_TIME(6), calendar=cal, rc=rc ) ! initialize current time ! ----------------------- call ESMF_TimeSet( CurrTime, YY = CURR_TIME(1), & MM = CURR_TIME(2), & DD = CURR_TIME(3), & H = CURR_TIME(4), & M = CURR_TIME(5), & S = CURR_TIME(6), calendar=cal, rc=rc ) ! initialize job segment stop time ! -------------------------------- call ESMF_TimeIntervalSet( timestep, YY = JOB_SGMT(1), & MM = JOB_SGMT(2), & D = JOB_SGMT(3), & H = JOB_SGMT(4), & M = JOB_SGMT(5), & S = JOB_SGMT(6), calendar=cal, rc=rc ) SegTime = CurrTime + timestep ! initialize model time step ! -------------------------- call ESMF_TimeIntervalSet( timeStep, S=INT(interval), rc=rc ) ! initialize the clock with the above values ! ------------------------------------------ if( segTime < stopTime ) then clock = ESMF_ClockCreate( "ApplClock",timeStep,StartTime,SegTime, rc=rc ) else clock = ESMF_ClockCreate( "ApplClock",timeStep,StartTime,StopTime, rc=rc ) endif call ESMF_ClockSet ( clock,CurrTime=CurrTime,rc=rc ) Final_End_Time_Alarm = ESMF_AlarmCreate ( clock=clock, RingTime=StopTime, rc=rc ) RETURN_(ESMF_SUCCESS) end subroutine Clock_Init subroutine get_DateStamp (clock,DateStamp,expid,rc) type (ESMF_Clock) :: clock integer, optional :: rc type(ESMF_Time) :: currentTime type(ESMF_TimeInterval) :: TimeStep character(len=ESMF_MAXSTR) :: TimeString integer :: secs character(len=ESMF_MAXSTR) :: TimeStamp character(len=ESMF_MAXSTR) :: DateStamp character(len=ESMF_MAXSTR) :: expid character :: String(ESMF_MAXSTR) character*4 year character*2 month character*2 day character*2 hour character*2 minute character*2 second equivalence ( string(01),TimeString ) equivalence ( string(01),year ) equivalence ( string(06),month ) equivalence ( string(09),day ) equivalence ( string(12),hour ) equivalence ( string(15),minute ) equivalence ( string(18),second ) call ESMF_ClockGet (clock, currTime=currentTime, rc=rc) call ESMF_TimeGet (currentTime, timeString=TimeString, rc=rc) call ESMF_ClockGet (clock, timeStep=TimeStep, rc=rc) call ESMF_TimeIntervalGet (TimeStep, S=secs, rc=rc) DateStamp = year // month // day // '_' // hour // minute // second // 'z' TimeStamp = ' Date: ' // year // '/' // month // '/' // day TimeStamp = trim(TimeStamp) // ' Time: ' // timestring(12:19) call WRITE_PARALLEL ( 'Expid: ' // trim(expid) // trim(TimeStamp) ) end subroutine get_DateStamp subroutine CAP_FINI ( layout,clock ) type(ESMF_DELayout), intent(in) :: layout type(ESMF_Clock), intent(inout) :: clock integer :: nymd,nhms ! Current Restart Time integer :: UNIT integer :: CURRENT_TIME(6) integer :: rc type(ESMF_Time) :: CurrentTime type(ESMF_Calendar) :: gregorianCalendar ! Retrieve Current Time for Cap Restart ! ------------------------------------- call ESMF_ClockGet ( clock, currTime=currentTime, rc=rc ) call ESMF_TimeGet ( CurrentTime, YY = CURRENT_TIME(1), & MM = CURRENT_TIME(2), & DD = CURRENT_TIME(3), & H = CURRENT_TIME(4), & M = CURRENT_TIME(5), & S = CURRENT_TIME(6), rc=rc ) nymd = CURRENT_TIME(1)*10000 & + CURRENT_TIME(2)*100 & + CURRENT_TIME(3) nhms = CURRENT_TIME(4)*10000 & + CURRENT_TIME(5)*100 & + CURRENT_TIME(6) ! Write CAP Restart File and Ending Time for Current Segment ! ---------------------------------------------------------- if( GEOS_AM_I_ROOT() ) then UNIT = GETFILE( "cap_restart", form="formatted" ) write(unit,100) nymd,nhms 100 format(i8.8,1x,i6.6) call FREE_FILE (UNIT) endif end subroutine CAP_FINI recursive subroutine GEOS_ExportStateGet(export, name, result, rc) type (ESMF_State), intent(IN ) :: export(:) character(len=*), intent(IN ) :: name type (ESMF_State), intent( OUT) :: result integer, intent( OUT) :: rc character(len=ESMF_MAXSTR), parameter :: IAm="GEOS_ExportStateGet" integer :: status integer :: n, i, ni, k, j character(len=ESMF_MAXSTR) :: sname type (ESMF_StateItemType), pointer :: ITEMTYPES(:) character(len=ESMF_MAXSTR ), pointer :: ITEMNAMES(:) type (ESMF_State), pointer :: exptmp(:) n = size(export) do i = 1, n call ESMF_StateGet(export(i), name=sname, itemcount = ni, rc=status) VERIFY_(STATUS) if (sname == trim(name) // '_Exports') then result = export(i) RETURN_(ESMF_SUCCESS) end if allocate(itemtypes(ni), itemnames(ni), stat=status) VERIFY_(STATUS) call ESMF_StateGet(export(i), itemnamelist=itemnames, stateitemtypelist = itemtypes, rc=status) VERIFY_(STATUS) j = 0 do k = 1, ni if (itemtypes(k) == ESMF_StateItem_State) then j = j+1 end if end do allocate(exptmp(j), stat=status) VERIFY_(STATUS) j = 0 do k = 1, ni if (itemtypes(k) == ESMF_StateItem_State) then j = j+1 call ESMF_StateGetState(export(i), itemnames(k), exptmp(j) , rc=status) VERIFY_(STATUS) end if end do call GEOS_ExportStateGet(exptmp, name, result, rc=status) deallocate(itemtypes, itemnames) deallocate(exptmp) if (status == ESMF_SUCCESS) return end do rc = ESMF_FAILURE return end subroutine GEOS_ExportStateGet function AppGridCreate(cf, vm, rc) result(grid) type(ESMF_Config), intent(INOUT) :: cf type (ESMF_VM), intent(IN ) :: VM integer, optional, intent(OUT) :: rc type (ESMF_Grid) :: grid ! Local vars integer :: status character(len=ESMF_MAXSTR), parameter :: IAm='AppGridCreate' integer :: IM_WORLD integer :: JM_WORLD integer :: LM integer :: L integer :: NX, NY integer, allocatable :: IMXY(:), JMXY(:) character(len=ESMF_MAXSTR) :: gridname real(ESMF_KIND_R8) :: minCoord(3) real(ESMF_KIND_R8) :: deltaX, deltaY, deltaZ real :: LON0, LAT0 ! grid create call ESMF_ConfigGetAttribute( cf, IM_WORLD, label ='IM:', rc = status ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute( cf, JM_WORLD, label ='JM:', rc = status ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute( cf, LM, label ='LM:', rc = status ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute( cf, NX, label ='NX:', rc = status ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute( cf, NY, label ='NY:', rc = status ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute ( cf, value=gridname, & label='GRIDNAME:', default='FVCORE_grid', rc=status ) VERIFY_(STATUS) ! IF(STATUS /= 39 ) THEN !ESMF_RC_NOT_FOUND ! VERIFY_(STATUS) ! ELSE ! gridname = 'FVCORE_grid' ! ENDIF ! Get the IMXY vector ! ------------------- allocate( imxy(0:nx-1) ) call GEOS_GET_LOCAL_DIMS ( IM_WORLD,imxy,nx ) ! Get the JMXY vector ! ------------------- allocate( jmxy(0:ny-1) ) call GEOS_GET_LOCAL_DIMS ( JM_WORLD,jmxy,ny ) deltaX = 2.0*GEOS_PI/IM_WORLD deltaY = GEOS_PI/(JM_WORLD-1) deltaZ = 1.0D0 minCoord(1) = -GEOS_PI -deltaX/2 minCoord(2) = -GEOS_PI/2-deltaY/2 minCoord(3) = deltaZ/2 layout = ESMF_DELayoutCreate(vm, deCountList=(/NX, NY/), rc=status) VERIFY_(STATUS) grid = ESMF_GridCreateHorzLatLonUni( & counts = (/IM_WORLD, JM_WORLD/), & minGlobalCoordPerDim=minCoord(1:2), & deltaPerDim=(/deltaX, deltaY /), & horzStagger=ESMF_Grid_Horz_Stagger_A, & periodic=(/ESMF_TRUE, ESMF_FALSE/), & name=gridname, rc=status) VERIFY_(STATUS) call ESMF_GridAddVertHeight(grid, & delta=(/(deltaZ, L=1,LM) /), & rc=status) VERIFY_(STATUS) call ESMF_GridDistribute(grid, & deLayout=layout, & countsPerDEDim1=imxy, & countsPerDEDim2=jmxy, & rc=status) VERIFY_(STATUS) deallocate(imxy) deallocate(jmxy) RETURN_(STATUS) end function AppGridCreate end Program Main