wrf_ESMFApp.F
References to this file elsewhere.
1 !WRF:DRIVER_LAYER:MAIN
2 !
3
4 !<DESCRIPTION>
5 ! Stand-alone ESMF Application Wrapper for WRF model. This file contains the
6 ! main program and creates a top level ESMF Gridded Component.
7 !
8 ! This source file is only built when ESMF coupling is used.
9 !
10 !</DESCRIPTION>
11
12
13 PROGRAM wrf_ESMFApp
14
15 !<DESCRIPTION>
16 ! Stand-alone ESMF Application Wrapper for WRF model. This is the main
17 ! program that creates a top level ESMF Gridded Component.
18 !
19 !</DESCRIPTION>
20
21 ! WRF registration routine
22 USE module_wrf_setservices, ONLY: WRF_register
23 ! ESMF module, defines all ESMF data types and procedures
24 USE ESMF_Mod
25 ! Not-yet-implemented ESMF features
26 USE module_esmf_extensions
27 ! Component-independent utilities
28 USE module_metadatautils, ONLY: GetTimesFromStates
29
30 IMPLICIT NONE
31
32 ! Local variables
33
34 ! Components
35 TYPE(ESMF_GridComp) :: WRFcompGridded ! WRF
36
37 ! State, Virtual Machine, and DELayout
38 TYPE(ESMF_VM) :: vm
39 TYPE(ESMF_State) :: importState, exportState
40
41 ! A clock, some times, and a time step
42 TYPE(ESMF_Clock) :: driverClock
43 TYPE(ESMF_Time) :: startTime
44 TYPE(ESMF_Time) :: stopTime
45 TYPE(ESMF_TimeInterval) :: couplingInterval
46
47 ! Return codes for error checks
48 INTEGER :: rc
49
50 ! Warn users that this is not yet ready for general use.
51 PRINT *, ' W A R N I N G '
52 PRINT *, ' ESMF COUPLING CAPABILITY IS EXPERIMENTAL AND UNSUPPORTED '
53 PRINT *, ' IN THIS VERSION OF WRF '
54 PRINT *, ' U S E A T Y O U R O W N R I S K '
55
56 ! This call includes everything that must be done before ESMF_Initialize()
57 ! is called.
58 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
59
60 ! Initialize ESMF, get the default Global VM, and set
61 ! the default calendar to be Gregorian.
62 CALL ESMF_Initialize( vm=vm, defaultCalendar=ESMF_CAL_GREGORIAN, rc=rc )
63 IF ( rc /= ESMF_SUCCESS ) THEN
64 CALL wrf_error_fatal( 'ESMF_Initialize failed' )
65 ENDIF
66 CALL ESMF_SetInitialized() ! eliminate this once ESMF does it internally
67 !TBH: these cause hangs on bluesky, PET* files never get written...
68 !TBH: CALL ESMF_LogSet( maxElements=1, verbose=ESMF_TRUE, flush=ESMF_TRUE, rc=rc )
69 !TBH: CALL ESMF_LogSet( maxElements=1, rc=rc )
70 !TBH: IF ( rc /= ESMF_SUCCESS ) THEN
71 !TBH: CALL wrf_error_fatal( 'ESMF_LogSet failed' )
72 !TBH: ENDIF
73
74 ! Create the top level Gridded Component, passing in the default VM.
75 WRFcompGridded = ESMF_GridCompCreate(vm, "WRF Model", rc=rc)
76 IF ( rc /= ESMF_SUCCESS ) THEN
77 CALL wrf_error_fatal( 'ESMF_GridCompCreate failed' )
78 ENDIF
79
80 ! Create empty import and export states
81 importState = ESMF_StateCreate("WRF Import State", statetype=ESMF_STATE_IMPORT, rc=rc)
82 IF ( rc /= ESMF_SUCCESS ) THEN
83 CALL wrf_error_fatal( 'ESMF_StateCreate(importState) failed' )
84 ENDIF
85 exportState = ESMF_StateCreate("WRF Export State", statetype=ESMF_STATE_EXPORT, rc=rc)
86 IF ( rc /= ESMF_SUCCESS ) THEN
87 CALL wrf_error_fatal( 'ESMF_StateCreate(exportState) failed' )
88 ENDIF
89
90 ! Create top-level clock. There is no way to create an "empty" clock, so
91 ! stuff in bogus values for start time, stop time, and time step and fix
92 ! them after "WRF Init" returns.
93 CALL ESMF_TimeSet(startTime, yy=2000, mm=1, dd=1, &
94 h=0, m=0, s=0, rc=rc)
95 IF ( rc /= ESMF_SUCCESS ) THEN
96 CALL wrf_error_fatal( 'ESMF_TimeSet(startTime) failed' )
97 ENDIF
98 CALL ESMF_TimeSet(stopTime, yy=2000, mm=1, dd=1, &
99 h=12, m=0, s=0, rc=rc)
100 IF ( rc /= ESMF_SUCCESS ) THEN
101 CALL wrf_error_fatal( 'ESMF_TimeSet(stopTime) failed' )
102 ENDIF
103 CALL ESMF_TimeIntervalSet(couplingInterval, s=2, rc=rc)
104 IF ( rc /= ESMF_SUCCESS ) THEN
105 CALL wrf_error_fatal( 'ESMF_TimeIntervalSet(couplingInterval) failed' )
106 ENDIF
107 driverClock = ESMF_ClockCreate(timeStep=couplingInterval, startTime=startTime, &
108 stopTime=stopTime, rc=rc)
109 IF ( rc /= ESMF_SUCCESS ) THEN
110 CALL wrf_error_fatal( 'ESMF_ClockCreate failed' )
111 ENDIF
112
113 ! Register the top level Gridded Component
114 CALL ESMF_GridCompSetServices(WRFcompGridded, WRF_register, rc)
115 IF ( rc /= ESMF_SUCCESS ) THEN
116 CALL wrf_error_fatal( 'ESMF_GridCompSetServices(WRFcompGridded) failed' )
117 ENDIF
118
119 ! Init, Run, and Finalize section
120 ! Phase 1 init returns WRF time and decomposition information as
121 ! exportState metadata.
122 CALL ESMF_GridCompInitialize(WRFcompGridded, importState, exportState, &
123 driverClock, phase=1, rc=rc)
124 IF ( rc /= ESMF_SUCCESS ) THEN
125 CALL wrf_error_fatal( 'ESMF_GridCompInitialize(WRFcompGridded phase 1) failed' )
126 ENDIF
127
128 ! For now, use settings from WRF component intialization to set up
129 ! top-level clock. Per suggestion from ESMF Core team, these are passed
130 ! back from "WRF init" as attributes on exportState.
131 CALL GetTimesFromStates( exportState, startTime, stopTime, couplingInterval )
132 ! update driver clock
133 CALL ESMF_ClockDestroy(driverClock, rc)
134 IF ( rc /= ESMF_SUCCESS ) THEN
135 CALL wrf_error_fatal( 'ESMF_ClockDestroy failed' )
136 ENDIF
137 driverClock = ESMF_ClockCreate(timeStep=couplingInterval, startTime=startTime, &
138 stopTime=stopTime, rc=rc)
139 IF ( rc /= ESMF_SUCCESS ) THEN
140 CALL wrf_error_fatal( 'ESMF_ClockCreate(driverClock) failed' )
141 ENDIF
142 CALL wrf_clockprint ( 150, driverClock, 'driverClock before phase 2 WRF init' )
143
144 ! Phase 2 init sets up WRF importState and exportState.
145 CALL ESMF_GridCompInitialize(WRFcompGridded, importState, exportState, &
146 driverClock, phase=2, rc=rc)
147 IF ( rc /= ESMF_SUCCESS ) THEN
148 CALL wrf_error_fatal( 'ESMF_GridCompInitialize(WRFcompGridded phase 2) failed' )
149 ENDIF
150
151 CALL wrf_debug ( 150, 'wrf_ESMFApp: begin time stepping...' )
152 ! main time-stepping loop
153 DO WHILE ( .NOT. ESMF_ClockIsStopTime(driverClock, rc) )
154
155 IF ( rc /= ESMF_SUCCESS ) THEN
156 CALL wrf_error_fatal( 'ESMF_ClockIsStopTime failed' )
157 ENDIF
158
159 ! Run WRF
160 CALL wrf_debug ( 150, 'wrf_ESMFApp: calling ESMF_GridCompRun(WRFcompGridded)...' )
161 CALL ESMF_GridCompRun(WRFcompGridded, importState, exportState, &
162 driverClock, rc=rc)
163 IF ( rc /= ESMF_SUCCESS ) THEN
164 CALL wrf_error_fatal( 'ESMF_GridCompRun failed' )
165 ENDIF
166 CALL wrf_debug ( 150, 'wrf_ESMFApp: back from ESMF_GridCompRun(WRFcompGridded)...' )
167
168 ! advance clock to next coupling time step
169 CALL ESMF_ClockAdvance( driverClock, rc=rc )
170 IF ( rc /= ESMF_SUCCESS ) THEN
171 CALL wrf_error_fatal( 'ESMF_ClockAdvance failed' )
172 ENDIF
173 CALL wrf_clockprint ( 150, driverClock, 'driverClock after ESMF_ClockAdvance' )
174
175 ENDDO
176 CALL wrf_debug ( 150, 'wrf_ESMFApp: done time stepping...' )
177
178 CALL wrf_debug ( 150, 'wrf_ESMFApp: calling ESMF_GridCompFinalize(WRFcompGridded)...' )
179 ! clean up WRF
180 CALL ESMF_GridCompFinalize(WRFcompGridded, importState, exportState, &
181 driverClock, rc=rc)
182 IF ( rc /= ESMF_SUCCESS ) THEN
183 CALL wrf_error_fatal( 'ESMF_GridCompFinalize failed' )
184 ENDIF
185 CALL wrf_debug ( 150, 'wrf_ESMFApp: back from ESMF_GridCompFinalize(WRFcompGridded)...' )
186
187 ! Clean up
188
189 CALL wrf_debug ( 150, 'wrf_ESMFApp: cleaning up ESMF objects...' )
190 CALL ESMF_GridCompDestroy(WRFcompGridded, rc)
191 IF ( rc /= ESMF_SUCCESS ) THEN
192 CALL wrf_error_fatal( 'ESMF_GridCompDestroy failed' )
193 ENDIF
194 CALL ESMF_StateDestroy(importState, rc)
195 IF ( rc /= ESMF_SUCCESS ) THEN
196 CALL wrf_error_fatal( 'ESMF_StateDestroy(importState) failed' )
197 ENDIF
198 CALL ESMF_StateDestroy(exportState, rc)
199 IF ( rc /= ESMF_SUCCESS ) THEN
200 CALL wrf_error_fatal( 'ESMF_StateDestroy(exportState) failed' )
201 ENDIF
202 CALL ESMF_ClockDestroy(driverClock, rc)
203 IF ( rc /= ESMF_SUCCESS ) THEN
204 CALL wrf_error_fatal( 'ESMF_Destroy(driverClock) failed' )
205 ENDIF
206
207 CALL wrf_debug ( 150, 'wrf_ESMFApp: calling ESMF_Finalize()...' )
208 CALL ESMF_Finalize( rc=rc )
209 CALL wrf_debug ( 150, 'wrf_ESMFApp: back from ESMF_Finalize()...' )
210
211 END PROGRAM wrf_ESMFApp
212
213