source: trunk/WRF.COMMON/WRFV2/external/io_esmf/io_esmf.F90 @ 3567

Last change on this file since 3567 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 73.3 KB
Line 
1
2MODULE module_ext_esmf
3
4  USE ESMF_Mod
5  USE module_esmf_extensions
6
7  IMPLICIT NONE
8
9  TYPE grid_ptr
10    TYPE(ESMF_Grid), POINTER :: ptr
11    ! use these for error-checking for now...
12    INTEGER :: ide_save
13    INTEGER :: jde_save
14    INTEGER :: kde_save
15    LOGICAL :: in_use
16  END TYPE grid_ptr
17
18  ! TBH:  should package this state into an object... 
19  INTEGER, PARAMETER :: int_num_handles = 99
20  LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,       &
21                                         opened_for_write, opened_for_read, &
22                                         int_handle_in_use
23  TYPE(grid_ptr) :: grid(int_num_handles)
24
25  ! convenience...
26  CHARACTER (256) :: msg
27
28#include "wrf_io_flags.h"
29#include "wrf_status_codes.h"
30
31  CONTAINS
32
33    LOGICAL FUNCTION int_valid_handle( handle )
34      IMPLICIT NONE
35      INTEGER, INTENT(IN) ::  handle
36      int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
37    END FUNCTION int_valid_handle
38
39    SUBROUTINE int_get_fresh_handle( retval )
40      INTEGER i, retval
41
42      retval = -1
43! dont use first 8 handles
44      DO i = 8, int_num_handles
45        IF ( .NOT. int_handle_in_use(i) )  THEN
46          retval = i
47          GOTO 33
48        ENDIF
49      ENDDO
5033    CONTINUE
51      IF ( retval < 0 )  THEN
52        CALL wrf_error_fatal( "io_esmf.F90: int_get_fresh_handle() out of handles")
53      ENDIF
54      int_handle_in_use(retval) = .TRUE.
55    END SUBROUTINE int_get_fresh_handle
56
57! parse comma separated list of VARIABLE=VALUE strings and return the
58! value for the matching variable if such exists, otherwise return
59! the empty string
60SUBROUTINE get_value ( varname , str , retval )
61  IMPLICIT NONE
62  CHARACTER*(*) ::    varname
63  CHARACTER*(*) ::    str
64  CHARACTER*(*) ::    retval
65
66  CHARACTER (128) varstr, tstr
67  INTEGER i,j,n,varstrn
68  LOGICAL nobreak, nobreakouter
69
70  varstr = TRIM(varname)//"="
71  varstrn = len(TRIM(varstr))
72  n = len(TRIM(str))
73  retval = ""
74  i = 1
75  nobreakouter = .TRUE.
76  DO WHILE ( nobreakouter )
77    j = 1
78    nobreak = .TRUE.
79    tstr = ""
80    DO WHILE ( nobreak )
81      nobreak = .FALSE.
82      IF ( i .LE. n ) THEN
83        IF (str(i:i) .NE. ',' ) THEN
84           tstr(j:j) = str(i:i)
85           nobreak = .TRUE.
86        ENDIF
87      ENDIF
88      j = j + 1
89      i = i + 1
90    ENDDO
91    IF ( i .GT. n ) nobreakouter = .FALSE.
92    IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
93      retval(1:) = TRIM(tstr(varstrn+1:))
94      nobreakouter = .FALSE.
95    ENDIF
96  ENDDO
97  RETURN
98END SUBROUTINE get_value
99
100
101    !--- ioinit
102    SUBROUTINE init_module_ext_esmf
103      IMPLICIT NONE
104      INTEGER :: i
105      DO i = 1, int_num_handles
106        WRITE( msg,* ) 'init_module_ext_esmf:  calling ioesmf_nullify_grid(',i,')'
107        CALL wrf_debug ( 5, TRIM(msg) )
108        CALL ioesmf_nullify_grid( i )
109      ENDDO
110      RETURN
111    END SUBROUTINE init_module_ext_esmf
112
113
114  ! allgather for integers, ESMF_style (since ESMF does not do this yet)
115  SUBROUTINE GatherIntegerScalars_ESMF( inval, pe, numprocs, outvals )
116    INTEGER, INTENT(IN   ) :: inval                 ! input scalar on this task
117    INTEGER, INTENT(IN   ) :: pe                    ! task id
118    INTEGER, INTENT(IN   ) :: numprocs              ! number of tasks
119    INTEGER, INTENT(  OUT) :: outvals(0:numprocs-1) ! gathered output vector
120    ! Local declarations
121    TYPE(ESMF_VM) :: vm
122    INTEGER(ESMF_KIND_I4) :: allSnd(0:numprocs-1)
123    INTEGER(ESMF_KIND_I4) :: allRcv(0:numprocs-1)
124    INTEGER :: rc
125
126    ! get current ESMF virtual machine for communication
127    CALL ESMF_VMGetCurrent(vm, rc)
128    IF ( rc /= ESMF_SUCCESS ) THEN
129      WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
130                     __FILE__ ,                    &
131                     ', line',                     &
132                     __LINE__
133      CALL wrf_error_fatal ( msg )
134    ENDIF
135    allSnd = 0_ESMF_KIND_I4
136    allSnd(pe) = inval
137    ! Hack due to lack of ESMF_VMAllGather(). 
138    CALL ESMF_VMAllReduce(vm, allSnd, allRcv, numprocs, ESMF_SUM, rc=rc )
139    IF ( rc /= ESMF_SUCCESS ) THEN
140      WRITE( msg,* ) 'Error in ESMF_VMAllReduce', &
141                     __FILE__ ,                     &
142                     ', line',                      &
143                     __LINE__
144      CALL wrf_error_fatal ( msg )
145    ENDIF
146    outvals = allRcv
147
148  END SUBROUTINE GatherIntegerScalars_ESMF
149
150
151END MODULE module_ext_esmf
152
153
154
155  ! Indexes for non-staggered variables come in at one-less than
156  ! domain dimensions, but io_esmf is currently hacked to use full
157  ! domain spec, so adjust if not staggered. 
158  ! $$$ TBD:  remove this hackery once ESMF can support staggered
159  ! $$$ TBD:  grids in regional models
160  SUBROUTINE ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
161                                 DomainEndFull, PatchEndFull )
162    IMPLICIT NONE
163    INTEGER,       INTENT(IN   ) :: numdims
164    INTEGER,       INTENT(IN   ) :: DomainEnd(numdims)
165    INTEGER,       INTENT(IN   ) :: PatchEnd(numdims)
166    CHARACTER*(*), INTENT(IN   ) :: Stagger
167    INTEGER,       INTENT(  OUT) :: DomainEndFull(numdims)
168    INTEGER,       INTENT(  OUT) :: PatchEndFull(numdims)
169    LOGICAL, EXTERNAL :: has_char
170    DomainEndFull(1:numdims) = DomainEnd(1:numdims)
171    IF ( .NOT. has_char( Stagger, 'x' ) ) DomainEndFull(1) = DomainEndFull(1) + 1
172    IF ( .NOT. has_char( Stagger, 'y' ) ) DomainEndFull(2) = DomainEndFull(2) + 1
173    PatchEndFull(1:numdims) = PatchEnd(1:numdims)
174    IF ( .NOT. has_char( Stagger, 'x' ) ) THEN
175      IF ( DomainEnd(1) == PatchEnd(1) ) PatchEndFull(1) = DomainEndFull(1)
176    ENDIF
177    IF ( .NOT. has_char( Stagger, 'y' ) ) THEN
178      IF ( DomainEnd(2) == PatchEnd(2) ) PatchEndFull(2) = DomainEndFull(2)
179    ENDIF
180  END SUBROUTINE ioesmf_endfullhack
181
182
183  ! Create the ESMF_Grid associated with index DataHandle. 
184  ! TBH:  Note that periodicity is not supported by this interface.  If
185  ! TBH:  periodicity is needed, pass in via SysDepInfo in the call to
186  ! TBH:  ext_esmf_ioinit(). 
187  ! TBH:  Note that lat/lon coordinates are not supported by this interface
188  ! TBH:  since general curvilinear coordindates (needed for map projections
189  ! TBH:  used by WRF such as polar stereographic, mercator, lambert conformal)
190  ! TBH:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported,
191  ! TBH:  add them via the "sieve" method used in ../io_mcel/. 
192  SUBROUTINE ioesmf_create_grid( DataHandle, numdims,    &
193                                 MemoryOrder, Stagger,   &
194                                 DomainStart, DomainEnd, &
195                                 MemoryStart, MemoryEnd, &
196                                 PatchStart, PatchEnd )
197    USE module_ext_esmf
198    IMPLICIT NONE
199    INTEGER,       INTENT(IN   ) :: DataHandle
200    INTEGER,       INTENT(IN   ) :: numdims
201    CHARACTER*(*), INTENT(IN   ) :: MemoryOrder            ! not used yet
202    CHARACTER*(*), INTENT(IN   ) :: Stagger
203    INTEGER,       INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
204    INTEGER,       INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
205    INTEGER,       INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
206    INTEGER :: DomainEndFull(numdims)
207    INTEGER :: PatchEndFull(numdims)
208
209    WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  begin, DataHandle = ', DataHandle
210    CALL wrf_debug ( 5, TRIM(msg) )
211    ! For now, blindly create a new grid if it does not already exist for
212    ! this DataHandle
213! TBH:  Note that this approach will result in duplicate ESMF_Grids when
214! TBH:  io_esmf is used for input and output.  The first ESMF_Grid will
215! TBH:  be associated with the input handle and the second will be associated
216! TBH:  with the output handle. 
217    IF ( .NOT. grid( DataHandle )%in_use ) THEN
218      IF ( ASSOCIATED( grid( DataHandle )%ptr ) ) THEN
219        CALL wrf_error_fatal ( 'ASSERTION ERROR:  grid(',DataHandle,') should be NULL' )
220      ENDIF
221      IF ( numdims /= 2 ) THEN
222        CALL wrf_error_fatal ( 'ERROR:  only 2D arrays supported so far with io_esmf' )
223      ELSE
224        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  creating grid(',DataHandle,')%ptr'
225        CALL wrf_debug ( 5, TRIM(msg) )
226        ALLOCATE( grid( DataHandle )%ptr )
227        grid( DataHandle )%in_use = .TRUE.
228        ! The non-staggered variables come in at one-less than
229        ! domain dimensions, but io_esmf is currently hacked to use full
230        ! domain spec, so adjust if not staggered. 
231        ! $$$ TBD:  remove this hackery once ESMF can support staggered
232        ! $$$ TBD:  grids in regional models
233        CALL ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
234                                 DomainEndFull, PatchEndFull )
235! $$$ TBD:  at the moment this is hard-coded for 2D arrays
236! $$$ TBD:  use MemoryOrder to set these properly!
237! $$$ TBD:  also, set these once only
238! $$$ TBD:  maybe even rip this out since it depends on a hack in input_wrf.F ...
239        grid( DataHandle )%ide_save = DomainEndFull(1)
240        grid( DataHandle )%jde_save = DomainEndFull(2)
241        grid( DataHandle )%kde_save = 1
242        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  DomainEndFull = ', DomainEndFull
243        CALL wrf_debug ( 5, TRIM(msg) )
244        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  PatchEndFull = ', PatchEndFull
245        CALL wrf_debug ( 5, TRIM(msg) )
246        CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  Calling ioesmf_create_grid_int()' )
247        CALL ioesmf_create_grid_int( grid( DataHandle )%ptr,     &
248                              numdims,                    &
249                              DomainStart, DomainEndFull, &
250                              MemoryStart, MemoryEnd,     &
251                              PatchStart, PatchEndFull )
252        CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  back from ioesmf_create_grid_int()' )
253        WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  done creating grid(',DataHandle,')%ptr'
254        CALL wrf_debug ( 5, TRIM(msg) )
255      ENDIF
256    ENDIF
257    WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  end'
258    CALL wrf_debug ( 5, TRIM(msg) )
259
260  END SUBROUTINE ioesmf_create_grid
261
262
263
264  ! Create an ESMF_Grid that matches a WRF decomposition. 
265  ! TBH:  Note that periodicity is not supported by this interface.  If
266  ! TBH:  periodicity is needed, pass in via SysDepInfo in the call to
267  ! TBH:  ext_esmf_ioinit(). 
268  ! TBH:  Note that lat/lon coordinates are not supported by this interface
269  ! TBH:  since general curvilinear coordindates (needed for map projections
270  ! TBH:  used by WRF such as polar stereographic, mercator, lambert conformal)
271  ! TBH:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported,
272  ! TBH:  add them via the "sieve" method used in ../io_mcel/. 
273  ! $$$ TBD:  Note that DomainEnd and PatchEnd must currently include "extra"
274  ! $$$ TBD:  points for non-periodic staggered arrays.  It may be possible to
275  ! $$$ TBD:  remove this hackery once ESMF can support staggered
276  ! $$$ TBD:  grids in regional models. 
277  SUBROUTINE ioesmf_create_grid_int( esmfgrid, numdims,      &
278                              DomainStart, DomainEnd, &
279                              MemoryStart, MemoryEnd, &
280                              PatchStart, PatchEnd )
281    USE module_ext_esmf
282    IMPLICIT NONE
283    TYPE(ESMF_Grid), INTENT(INOUT) :: esmfgrid
284    INTEGER,         INTENT(IN   ) :: numdims
285    INTEGER,         INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
286    INTEGER,         INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
287    INTEGER,         INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
288    ! Local declarations
289    INTEGER :: numprocs     ! total number of tasks
290    INTEGER, ALLOCATABLE :: ipatchStarts(:), jpatchStarts(:)
291    INTEGER :: numprocsX    ! number of tasks in "i" dimension
292    INTEGER :: numprocsY    ! number of tasks in "j" dimension
293    INTEGER, ALLOCATABLE :: permuteTasks(:)
294    INTEGER :: globalXcount ! staggered domain count in "i" dimension
295    INTEGER :: globalYcount ! staggered domain count in "j" dimension
296    INTEGER :: myXstart     ! task-local start in "i" dimension
297    INTEGER :: myYstart     ! task-local start in "j" dimension
298    INTEGER :: myXend       ! staggered task-local end in "i" dimension
299    INTEGER :: myYend       ! staggered task-local end in "j" dimension
300    INTEGER, ALLOCATABLE :: allXStart(:)
301    INTEGER, ALLOCATABLE :: allXCount(:)
302    INTEGER, ALLOCATABLE :: dimXCount(:)
303    INTEGER, ALLOCATABLE :: allYStart(:)
304    INTEGER, ALLOCATABLE :: allYCount(:)
305    INTEGER, ALLOCATABLE :: dimYCount(:)
306    REAL(ESMF_KIND_R8), ALLOCATABLE :: coordX(:)
307    REAL(ESMF_KIND_R8), ALLOCATABLE :: coordY(:)
308    INTEGER, ALLOCATABLE :: cellCounts(:,:)
309    INTEGER, ALLOCATABLE :: globalStarts(:,:)
310    INTEGER :: rc
311    INTEGER :: myXcount      ! task-local count in "i" dimension
312    INTEGER :: myYcount      ! task-local count in "j" dimension
313    INTEGER :: globalCellCounts(2)
314    INTEGER :: numprocsXY(2)
315    INTEGER :: myPE, i, j, pe, is, ie, js, je, is_min, js_min, ie_max, je_max
316    INTEGER :: ips, ipe, jps, jpe, ids, ide, jds, jde
317    TYPE(ESMF_VM) :: vm
318    TYPE(ESMF_DELayout) :: taskLayout
319    CHARACTER (32) :: gridname
320    INTEGER, SAVE :: gridID = 0
321
322      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  begin...' )
323      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numdims = ',numdims
324      CALL wrf_debug ( 5 , TRIM(msg) )
325      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainStart = ',DomainStart(1:numdims)
326      CALL wrf_debug ( 5 , TRIM(msg) )
327      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainEnd = ',DomainEnd(1:numdims)
328      CALL wrf_debug ( 5 , TRIM(msg) )
329      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryStart = ',MemoryStart(1:numdims)
330      CALL wrf_debug ( 5 , TRIM(msg) )
331      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryEnd = ',MemoryEnd(1:numdims)
332      CALL wrf_debug ( 5 , TRIM(msg) )
333      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchStart = ',PatchStart(1:numdims)
334      CALL wrf_debug ( 5 , TRIM(msg) )
335      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchEnd = ',PatchEnd(1:numdims)
336      CALL wrf_debug ( 5 , TRIM(msg) )
337      ! First, determine number of tasks and number of tasks in each decomposed
338      ! dimension (ESMF 2.2.0 is restricted to simple task layouts)
339      ! get current ESMF virtual machine and inquire... 
340      CALL ESMF_VMGetCurrent(vm, rc)
341      IF ( rc /= ESMF_SUCCESS ) THEN
342        WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
343                       __FILE__ ,                    &
344                       ', line',                     &
345                       __LINE__
346        CALL wrf_error_fatal ( msg )
347      ENDIF
348      ! TBH:  Note (PET==MPI process) assumption here.  This is OK in ESMF
349      ! TBH:  2.2.0 but may change in a future ESMF release.  If so, we will
350      ! TBH:  need another way to do this.  May want to grab mpiCommunicator
351      ! TBH:  instead and ask it directly for number of MPI tasks.  Of course,
352      ! TBH:  what if this is a serial run? 
353      CALL ESMF_VMGet(vm, petCount=numprocs, localPet=myPE, rc=rc)
354      IF ( rc /= ESMF_SUCCESS ) THEN
355        WRITE( msg,* ) 'Error in ESMF_VMGet', &
356                       __FILE__ ,             &
357                       ', line',              &
358                       __LINE__
359        CALL wrf_error_fatal ( msg )
360      ENDIF
361      ALLOCATE( ipatchStarts(0:numprocs-1), jpatchStarts(0:numprocs-1) )
362      CALL GatherIntegerScalars_ESMF(PatchStart(1), myPE, numprocs, ipatchStarts)
363      CALL GatherIntegerScalars_ESMF(PatchStart(2), myPE, numprocs, jpatchStarts)
364      numprocsX = 0
365      numprocsY = 0
366      DO pe = 0, numprocs-1
367        IF ( PatchStart(1) == ipatchStarts(pe) ) THEN
368          numprocsX = numprocsX + 1
369        ENDIF
370        IF ( PatchStart(2) == jpatchStarts(pe) ) THEN
371          numprocsY = numprocsY + 1
372        ENDIF
373      ENDDO
374      DEALLOCATE( ipatchStarts, jpatchStarts )
375      ! sanity check
376      IF ( numprocs /= numprocsX*numprocsY ) THEN
377        CALL wrf_error_fatal ( 'ASSERTION FAILED:  numprocs /= numprocsX*numprocsY' )
378      ENDIF
379      ! Next, create ESMF_DELayout
380      numprocsXY = (/ numprocsX, numprocsY /)
381      ! transpose tasks to match RSL
382      ! TBH:  1-to-1 DE to PET mapping is assumed below... 
383      ALLOCATE( permuteTasks(0:numprocs-1) )
384      pe = 0
385      DO j = 0, numprocsY-1
386        DO i = 0, numprocsX-1
387! (/ 0 2 1 3 /)
388        permuteTasks(pe) = (i*numprocsY) + j
389! (/ 0 1 2 3 /)
390!        permuteTasks(pe) = pe
391        pe = pe + 1
392        ENDDO
393      ENDDO
394!$$$DEBUG
395!      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_VMPrint' )
396!      CALL ESMF_VMPrint( vm=vm, rc=rc )
397!      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_VMPrint' )
398!$$$END DEBUG
399      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numprocsXY = ',numprocsXY
400      CALL wrf_debug ( 5 , TRIM(msg) )
401      WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  permuteTasks = ',permuteTasks
402      CALL wrf_debug ( 5 , TRIM(msg) )
403      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutCreate' )
404      taskLayout = ESMF_DELayoutCreate( vm, numprocsXY, petList=permuteTasks, rc=rc )
405      IF ( rc /= ESMF_SUCCESS ) THEN
406        WRITE( msg,* ) 'Error in ESMF_DELayoutCreate', &
407                       __FILE__ ,                      &
408                       ', line',                       &
409                       __LINE__
410        CALL wrf_error_fatal ( msg )
411      ENDIF
412      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutCreate' )
413      DEALLOCATE( permuteTasks )
414!$$$DEBUG
415      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 1' )
416      CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
417      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 1' )
418!$$$END DEBUG
419      ! Compute indices for staggered grids because ESMF does not yet support addition of
420      ! extra data points for staggered dimensions as is common in regional models. 
421      ! $$$ TBD:  Remove this hack once ESMF can handle it. 
422      ! the [ij][dp][se] bits are for convenience... 
423      ids = DomainStart(1); ide = DomainEnd(1);
424      jds = DomainStart(2); jde = DomainEnd(2);
425      ips = PatchStart(1);  ipe = PatchEnd(1);
426      jps = PatchStart(2);  jpe = PatchEnd(2);
427      globalXcount = ide - ids + 1
428      globalYcount = jde - jds + 1
429      ! task-local numbers of points in patch for staggered arrays
430      myXstart = ips
431      myYstart = jps
432      ! staggered-only for now
433      myXend = ipe
434      myYend = jpe
435!      myXend = min(ipe, ide-1)
436!      myYend = min(jpe, jde-1)
437      myXcount = myXend - myXstart + 1
438      myYcount = myYend - myYstart + 1
439!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     ips = ', ips
440!      CALL wrf_debug ( 5 , TRIM(msg) )
441!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     ipe = ', min(ipe, ide-1)
442!      CALL wrf_debug ( 5 , TRIM(msg) )
443!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered i count = ', myXCount
444!      CALL wrf_debug ( 5 , TRIM(msg) )
445!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     jps = ', jps
446!      CALL wrf_debug ( 5 , TRIM(msg) )
447!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered     jpe = ', min(jpe, jde-1)
448!      CALL wrf_debug ( 5 , TRIM(msg) )
449!      WRITE( msg,* ) 'DEBUG:  WRF non-staggered j count = ', myYCount
450!      CALL wrf_debug ( 5 , TRIM(msg) )
451      WRITE( msg,* ) 'DEBUG:  WRF     staggered     ips = ', ips
452      CALL wrf_debug ( 5 , TRIM(msg) )
453      WRITE( msg,* ) 'DEBUG:  WRF     staggered     ipe = ', ipe
454      CALL wrf_debug ( 5 , TRIM(msg) )
455      WRITE( msg,* ) 'DEBUG:  WRF     staggered i count = ', ipe-ips+1
456      CALL wrf_debug ( 5 , TRIM(msg) )
457      WRITE( msg,* ) 'DEBUG:  WRF     staggered     jps = ', jps
458      CALL wrf_debug ( 5 , TRIM(msg) )
459      WRITE( msg,* ) 'DEBUG:  WRF     staggered     jpe = ', jpe
460      CALL wrf_debug ( 5 , TRIM(msg) )
461      WRITE( msg,* ) 'DEBUG:  WRF     staggered j count = ', jpe-jps+1
462      CALL wrf_debug ( 5 , TRIM(msg) )
463      ! gather task-local information on all tasks since
464      ! ESMF_GridDistribute[Block] interface require global knowledge to set up
465      ! decompositions (@#$%)
466      ! Recall that coordX and coordY are coordinates of *vertices*, not cell centers. 
467      ! Thus they must be 1 bigger than the number of cells. 
468      ALLOCATE( allXStart(0:numprocs-1),  allXCount(0:numprocs-1),  &
469                allYStart(0:numprocs-1),  allYCount(0:numprocs-1),  &
470                dimXCount(0:numprocsX-1), dimYCount(0:numprocsY-1), &
471                coordX(globalXcount+1),   coordY(globalYcount+1) )
472      CALL GatherIntegerScalars_ESMF(myXcount, myPE, numprocs, allXCount)
473      CALL GatherIntegerScalars_ESMF(myXstart, myPE, numprocs, allXStart)
474      CALL GatherIntegerScalars_ESMF(myYcount, myPE, numprocs, allYCount)
475      CALL GatherIntegerScalars_ESMF(myYstart, myPE, numprocs, allYStart)
476
477      ! HACK:  ESMF does not yet support mercator, polar-stereographic, or
478      ! HACK:  lambert-conformal projections.  Therefore, we're using fake
479      ! HACK:  coordinates here.  This means that WRF will either have to
480      ! HACK:  couple to models that run on the same coorindate such that
481      ! HACK:  grid points are co-located or something else will have to
482      ! HACK:  perform the inter-grid interpolation computations.  Replace
483      ! HACK:  this once ESMF is upgraded to support the above map
484      ! HACK:  projections (via general curvilinear coordinates). 
485      CALL wrf_message( 'WARNING:  Using artificial coordinates for ESMF coupling.' )
486      CALL wrf_message( 'WARNING:  ESMF coupling interpolation will be incorrect' )
487      CALL wrf_message( 'WARNING:  unless grid points in the coupled components' )
488      CALL wrf_message( 'WARNING:  are co-located.  This limitation will be removed' )
489      CALL wrf_message( 'WARNING:  once ESMF coupling supports generalized' )
490      CALL wrf_message( 'WARNING:  curvilinear coordintates needed to represent' )
491      CALL wrf_message( 'WARNING:  common map projections used by WRF and other' )
492      CALL wrf_message( 'WARNING:  regional models.' )
493      ! Note that ESMF defines coordinates at *vertices*
494      coordX(1) = 0.0
495      DO i = 2, SIZE(coordX)
496        coordX(i) = coordX(i-1) + 1.0
497      ENDDO
498      coordY(1) = 0.0
499      DO j = 2, SIZE(coordY)
500        coordY(j) = coordY(j-1) + 1.0
501      ENDDO
502      ! Create an ESMF_Grid
503      ! For now we create only a 2D grid suitable for simple coupling of 2D
504      ! surface fields.  Later, create and subset one or more 3D grids. 
505!TBH $$$:  NOTE that we'll have to use ESMF_GRID_HORZ_STAGGER_E_?? for NMM. 
506!TBH $$$:  E-grid is not yet supported by ESMF.  Eventually pass staggering
507!TBH $$$:  info into this routine.  For now, hard-code it for WRF-ARW. 
508      gridID = gridID + 1
509      WRITE ( gridname,'(a,i0)' ) 'WRF_grid_', gridID
510!$$$DEBUG
511CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridCreateHorzXY()' )
512WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordX) = ', SIZE(coordX)
513CALL wrf_debug ( 5 , TRIM(msg) )
514WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordY) = ', SIZE(coordY)
515CALL wrf_debug ( 5 , TRIM(msg) )
516DO i = 1, SIZE(coordX)
517  WRITE( msg,* ) 'DEBUG WRF:  coord1(',i,') = ', coordX(i)
518  CALL wrf_debug ( 5 , TRIM(msg) )
519ENDDO
520DO j = 1, SIZE(coordY)
521  WRITE( msg,* ) 'DEBUG WRF:  coord2(',j,') = ', coordY(j)
522  CALL wrf_debug ( 5 , TRIM(msg) )
523ENDDO
524WRITE( msg,* ) 'DEBUG WRF:  horzstagger = ', ESMF_GRID_HORZ_STAGGER_C_SW
525CALL wrf_debug ( 5 , TRIM(msg) )
526WRITE( msg,* ) 'DEBUG WRF:  name = ', TRIM(gridname)
527CALL wrf_debug ( 5 , TRIM(msg) )
528!$$$END DEBUG
529      esmfgrid = ESMF_GridCreateHorzXY(                     &
530                   coord1=coordX, coord2=coordY,            &
531                   horzstagger=ESMF_GRID_HORZ_STAGGER_C_SW, &
532! use this for 3D Grids once it is stable
533!                  coordorder=ESMF_COORD_ORDER_XZY,         &
534                   name=TRIM(gridname), rc=rc )
535      IF ( rc /= ESMF_SUCCESS ) THEN
536        WRITE( msg,* ) 'Error in ESMF_GridCreateHorzXY', &
537                       __FILE__ ,                        &
538                       ', line',                         &
539                       __LINE__
540        CALL wrf_error_fatal ( msg )
541      ENDIF
542CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridCreateHorzXY()' )
543      ! distribute the ESMF_Grid
544      ! ignore repeated values
545      is_min = MINVAL(allXStart)
546      js_min = MINVAL(allYStart)
547      i = 0
548      j = 0
549      WRITE( msg,* ) 'DEBUG:  is_min = ',is_min,'  allXStart = ',allXStart
550      CALL wrf_debug ( 5 , TRIM(msg) )
551      WRITE( msg,* ) 'DEBUG:  js_min = ',js_min,'  allYStart = ',allYStart
552      CALL wrf_debug ( 5 , TRIM(msg) )
553      WRITE( msg,* ) 'DEBUG:  allXCount = ',allXCount
554      CALL wrf_debug ( 5 , TRIM(msg) )
555      WRITE( msg,* ) 'DEBUG:  allYCount = ',allYCount
556      CALL wrf_debug ( 5 , TRIM(msg) )
557      DO pe = 0, numprocs-1
558        IF (allXStart(pe) == is_min) THEN
559          IF (j >= numprocsY) THEN
560            WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreateHorzXY', &
561                           __FILE__ ,                                   &
562                           ', line',                                    &
563                           __LINE__
564            CALL wrf_error_fatal ( msg )
565          ENDIF
566      WRITE( msg,* ) 'DEBUG:  dimYCount(',j,') == allYCount(',pe,')'
567      CALL wrf_debug ( 5 , TRIM(msg) )
568          dimYCount(j) = allYCount(pe)
569          j = j + 1
570        ENDIF
571        IF (allYStart(pe) == js_min) THEN
572          IF (i >= numprocsX) THEN
573            WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreateHorzXY', &
574                           __FILE__ ,                                   &
575                           ', line',                                    &
576                           __LINE__
577            CALL wrf_error_fatal ( msg )
578          ENDIF
579      WRITE( msg,* ) 'DEBUG:  dimXCount(',i,') == allXCount(',pe,')'
580      CALL wrf_debug ( 5 , TRIM(msg) )
581          dimXCount(i) = allXCount(pe)
582          i = i + 1
583        ENDIF
584      ENDDO
585      WRITE( msg,* ) 'DEBUG:  i = ',i,'  dimXCount = ',dimXCount
586      CALL wrf_debug ( 5 , TRIM(msg) )
587      WRITE( msg,* ) 'DEBUG:  j = ',j,'  dimYCount = ',dimYCount
588      CALL wrf_debug ( 5 , TRIM(msg) )
589!$$$DEBUG
590      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 2' )
591      CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
592      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 2' )
593!$$$END DEBUG
594! $$$  crashes here with "-g" ...
595      CALL ESMF_GridDistribute( esmfgrid,                  &
596                                delayout=taskLayout,       &
597                                countsPerDEDim1=dimXCount, &
598                                countsPerDEDim2=dimYCount, &
599                                rc=rc )
600      IF ( rc /= ESMF_SUCCESS ) THEN
601        WRITE( msg,* ) 'Error in ESMF_GridDistribute ', &
602                       __FILE__ ,                       &
603                       ', line ',                       &
604                       __LINE__ ,                       &
605                       ', error code = ',rc
606        CALL wrf_error_fatal ( msg )
607      ENDIF
608CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridValidate()' )
609      CALL ESMF_GridValidate( esmfgrid, rc=rc )
610      IF ( rc /= ESMF_SUCCESS ) THEN
611        WRITE( msg,* ) 'Error in ESMF_GridValidate ',   &
612                       __FILE__ ,                       &
613                       ', line ',                       &
614                       __LINE__ ,                       &
615                       ', error code = ',rc
616! TBH:  debugging error exit here... 
617        CALL wrf_error_fatal ( msg )
618      ENDIF
619CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridValidate()' )
620      DEALLOCATE( allXStart, allXCount, allYStart, allYCount, &
621                  dimXCount, dimYCount, coordX, coordY )
622
623      ! Print out the ESMF decomposition info for debug comparison with WRF
624      ! decomposition info. 
625      ALLOCATE( cellCounts(0:numprocs-1,2), globalStarts(0:numprocs-1,2) )
626
627!      CALL ESMF_GridGet( esmfgrid,                               &
628!                         horzrelloc=ESMF_CELL_CENTER,            &
629!                         globalStartPerDEPerDim=globalStarts,    &
630!                         cellCountPerDEPerDim=cellCounts,        &
631!                         globalCellCountPerDim=globalCellCounts, &
632!                         rc=rc )
633!      IF ( rc /= ESMF_SUCCESS ) THEN
634!        WRITE( msg,* ) 'Error in ESMF_GridGet', &
635!                       __FILE__ ,               &
636!                       ', line',                &
637!                       __LINE__
638!        CALL wrf_error_fatal ( msg )
639!      ENDIF
640! note that global indices in ESMF_Grid always start at zero
641!      WRITE( msg,* ) 'DEBUG:  ESMF task-id = ',myPE
642!      CALL wrf_debug ( 5 , TRIM(msg) )
643!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     ips = ',1+globalStarts(myPE,1)
644!      CALL wrf_debug ( 5 , TRIM(msg) )
645!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     ipe = ',1+globalStarts(myPE,1) + cellCounts(myPE,1) - 1
646!      CALL wrf_debug ( 5 , TRIM(msg) )
647!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered i count = ',  cellCounts(myPE,1)
648!      CALL wrf_debug ( 5 , TRIM(msg) )
649!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     jps = ',1+globalStarts(myPE,2)
650!      CALL wrf_debug ( 5 , TRIM(msg) )
651!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered     jpe = ',1+globalStarts(myPE,2) + cellCounts(myPE,2) - 1
652!      CALL wrf_debug ( 5 , TRIM(msg) )
653!      WRITE( msg,* ) 'DEBUG:  ESMF non-staggered j count = ',  cellCounts(myPE,2)
654!      CALL wrf_debug ( 5 , TRIM(msg) )
655!      is_min = globalStarts(0,1)
656!      js_min = globalStarts(0,2)
657!      ie_max = globalStarts(0,1) + cellCounts(0,1) - 1
658!      je_max = globalStarts(0,2) + cellCounts(0,2) - 1
659!      DO pe = 1, (numprocsX*numprocsY)-1
660!        js = globalStarts(pe,2)
661!        je = globalStarts(pe,2) + cellCounts(pe,2) - 1
662!        IF ( js < js_min ) js_min = js
663!        IF ( je > je_max ) je_max = je
664!        is = globalStarts(pe,1)
665!        ie = globalStarts(pe,1) + cellCounts(pe,1) - 1
666!        IF ( is < is_min ) is_min = is
667!        IF ( ie > ie_max ) ie_max = ie
668!      ENDDO
669
670      ! extract information about staggered grids for debugging
671      CALL ESMF_GridGet( esmfgrid,                               &
672                         horzrelloc=ESMF_CELL_WFACE,             &
673                         globalStartPerDEPerDim=globalStarts,    &
674                         cellCountPerDEPerDim=cellCounts,        &
675                         globalCellCountPerDim=globalCellCounts, &
676                         rc=rc )
677      IF ( rc /= ESMF_SUCCESS ) THEN
678        WRITE( msg,* ) 'Error in ESMF_GridGet', &
679                       __FILE__ ,               &
680                       ', line',                &
681                       __LINE__
682        CALL wrf_error_fatal ( msg )
683      ENDIF
684! note that global indices in ESMF_Grid always start at zero
685      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ips = ',1+globalStarts(myPE,1)
686      CALL wrf_debug ( 5 , TRIM(msg) )
687      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ipe = ',1+globalStarts(myPE,1) + cellCounts(myPE,1) - 1
688      CALL wrf_debug ( 5 , TRIM(msg) )
689      WRITE( msg,* ) 'DEBUG:  ESMF     staggered i count = ',  cellCounts(myPE,1)
690      CALL wrf_debug ( 5 , TRIM(msg) )
691      CALL ESMF_GridGet( esmfgrid,                               &
692                         horzrelloc=ESMF_CELL_SFACE,             &
693                         globalStartPerDEPerDim=globalStarts,    &
694                         cellCountPerDEPerDim=cellCounts,        &
695                         globalCellCountPerDim=globalCellCounts, &
696                         rc=rc )
697      IF ( rc /= ESMF_SUCCESS ) THEN
698        WRITE( msg,* ) 'Error in ESMF_GridGet', &
699                       __FILE__ ,               &
700                       ', line',                &
701                       __LINE__
702        CALL wrf_error_fatal ( msg )
703      ENDIF
704! note that global indices in ESMF_Grid always start at zero
705      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jps = ',1+globalStarts(myPE,2)
706      CALL wrf_debug ( 5 , TRIM(msg) )
707      WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jpe = ',1+globalStarts(myPE,2) + cellCounts(myPE,2) - 1
708      CALL wrf_debug ( 5 , TRIM(msg) )
709      WRITE( msg,* ) 'DEBUG:  ESMF     staggered j count = ',  cellCounts(myPE,2)
710      CALL wrf_debug ( 5 , TRIM(msg) )
711
712      DEALLOCATE( cellCounts, globalStarts )
713
714      CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid BEGIN...' )
715      CALL ESMF_GridPrint( esmfgrid, rc=rc )
716      IF ( rc /= ESMF_SUCCESS ) THEN
717        WRITE( msg,* ) 'Error in ESMF_GridPrint', &
718                       __FILE__ ,                        &
719                       ', line',                         &
720                       __LINE__
721        CALL wrf_error_fatal ( msg )
722      ENDIF
723      CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid END' )
724
725      CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  returning...' )
726
727  END SUBROUTINE ioesmf_create_grid_int
728
729
730
731  ! Destroy the ESMF_Grid associated with index DataHandle. 
732  ! grid( DataHandle )%ptr is DEALLOCATED (NULLIFIED)
733  SUBROUTINE ioesmf_destroy_grid( DataHandle )
734    USE module_ext_esmf
735    IMPLICIT NONE
736    INTEGER, INTENT(IN   ) :: DataHandle
737    ! Local declarations
738    INTEGER :: id, rc
739    TYPE(ESMF_DELayout) :: taskLayout
740    LOGICAL :: noneLeft
741    IF ( grid( DataHandle )%in_use ) THEN
742WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) begin...'
743CALL wrf_debug ( 5 , TRIM(msg) )
744      CALL ESMF_GridGet( grid( DataHandle )%ptr, delayout=taskLayout, rc=rc )
745      IF ( rc /= ESMF_SUCCESS ) THEN
746        WRITE( msg,* ) 'Error in ESMF_GridGet', &
747                       __FILE__ ,               &
748                       ', line',                &
749                       __LINE__
750        CALL wrf_error_fatal ( msg )
751      ENDIF
752      ! I "know" I created this...  (not really, but ESMF cannot tell me!)
753      CALL ESMF_DELayoutDestroy( taskLayout, rc=rc )
754      IF ( rc /= ESMF_SUCCESS ) THEN
755        WRITE( msg,* ) 'Error in ESMF_DELayoutDestroy', &
756                       __FILE__ ,                       &
757                       ', line',                        &
758                       __LINE__
759        CALL wrf_error_fatal ( msg )
760      ENDIF
761      CALL ESMF_GridDestroy( grid( DataHandle )%ptr, rc=rc )
762      IF ( rc /= ESMF_SUCCESS ) THEN
763        WRITE( msg,* ) 'Error in ESMF_GridDestroy', &
764                       __FILE__ ,                   &
765                       ', line',                    &
766                       __LINE__
767        CALL wrf_error_fatal ( msg )
768      ENDIF
769      DEALLOCATE( grid( DataHandle )%ptr )
770      CALL ioesmf_nullify_grid( DataHandle )
771WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) end'
772CALL wrf_debug ( 5 , TRIM(msg) )
773    ENDIF
774
775  END SUBROUTINE ioesmf_destroy_grid
776
777
778  ! Nullify the grid_ptr associated with index DataHandle. 
779  ! grid( DataHandle )%ptr must not be associated
780  ! DataHandle must be in a valid range
781  SUBROUTINE ioesmf_nullify_grid( DataHandle )
782    USE module_ext_esmf
783    IMPLICIT NONE
784    INTEGER, INTENT(IN   ) :: DataHandle
785    NULLIFY( grid( DataHandle )%ptr )
786    grid( DataHandle )%in_use = .FALSE.
787    grid( DataHandle )%ide_save = 0
788    grid( DataHandle )%jde_save = 0
789    grid( DataHandle )%kde_save = 0
790  END SUBROUTINE ioesmf_nullify_grid
791
792
793!$$$here...  use generic explicit interfaces?  if not, why not? 
794 !$$$ remove duplication!
795 SUBROUTINE ioesmf_extract_data_real( data_esmf_real, Field,      &
796                                      ips, ipe, jps, jpe, kps, kpe, &
797                                      ims, ime, jms, jme, kms, kme )
798   USE module_ext_esmf
799   IMPLICIT NONE
800   INTEGER,            INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
801   INTEGER,            INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
802   REAL(ESMF_KIND_R4), INTENT(IN   ) :: data_esmf_real( ips:ipe, jps:jpe )
803   REAL,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
804   Field( ips:ipe, jps:jpe, kms ) = data_esmf_real( ips:ipe, jps:jpe )
805 END SUBROUTINE ioesmf_extract_data_real
806
807
808 !$$$ remove duplication!
809 SUBROUTINE ioesmf_extract_data_int( data_esmf_int, Field,         &
810                                     ips, ipe, jps, jpe, kps, kpe, &
811                                     ims, ime, jms, jme, kms, kme )
812   USE module_ext_esmf
813   IMPLICIT NONE
814   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
815   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
816   INTEGER(ESMF_KIND_I4), INTENT(IN   ) :: data_esmf_int( ips:ipe, jps:jpe )
817   INTEGER,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
818   Field( ips:ipe, jps:jpe, kms ) = data_esmf_int( ips:ipe, jps:jpe )
819 END SUBROUTINE ioesmf_extract_data_int
820
821
822 !$$$ remove duplication!
823 SUBROUTINE ioesmf_insert_data_real( Field, data_esmf_real,        &
824                                     ips, ipe, jps, jpe, kps, kpe, &
825                                     ims, ime, jms, jme, kms, kme )
826   USE module_ext_esmf
827   IMPLICIT NONE
828   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
829   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
830   REAL,                  INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
831   REAL(ESMF_KIND_R4),    INTENT(  OUT) :: data_esmf_real( ips:ipe, jps:jpe )
832   ! $$$ TBD:  Remove this hack once we no longer have to store non-staggered
833   ! $$$ TBD:  arrays in space dimensioned for staggered arrays. 
834   data_esmf_real = 0.0_ESMF_KIND_R4
835   data_esmf_real( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
836 END SUBROUTINE ioesmf_insert_data_real
837
838
839 !$$$ remove duplication!
840 SUBROUTINE ioesmf_insert_data_int( Field, data_esmf_int,         &
841                                    ips, ipe, jps, jpe, kps, kpe, &
842                                    ims, ime, jms, jme, kms, kme )
843   USE module_ext_esmf
844   IMPLICIT NONE
845   INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
846   INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
847   INTEGER,               INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
848   INTEGER(ESMF_KIND_I4), INTENT(  OUT) :: data_esmf_int( ips:ipe, jps:jpe )
849   ! $$$ TBD:  Remove this hack once we no longer have to store non-staggered
850   ! $$$ TBD:  arrays in space dimensioned for staggered arrays. 
851   data_esmf_int = 0.0_ESMF_KIND_I4
852   data_esmf_int( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
853 END SUBROUTINE ioesmf_insert_data_int
854
855
856!--------------
857
858SUBROUTINE ext_esmf_ioinit( SysDepInfo, Status )
859  USE module_ext_esmf
860  IMPLICIT NONE
861  CHARACTER*(*), INTENT(IN) :: SysDepInfo
862  INTEGER Status
863  CALL init_module_ext_esmf
864  Status = 0
865END SUBROUTINE ext_esmf_ioinit
866
867!--- open_for_read
868SUBROUTINE ext_esmf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
869                                    DataHandle , Status )
870  USE module_ext_esmf
871  IMPLICIT NONE
872  CHARACTER*(*) :: FileName
873  INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
874  CHARACTER*(*) :: SysDepInfo
875  INTEGER ,       INTENT(OUT) :: DataHandle
876  INTEGER ,       INTENT(OUT) :: Status
877  CALL wrf_message('ext_esmf_open_for_read not supported yet')
878  Status = WRF_WARN_NOTSUPPORTED
879  RETURN 
880END SUBROUTINE ext_esmf_open_for_read
881
882
883!--- inquire_opened
884SUBROUTINE ext_esmf_inquire_opened ( DataHandle, FileName , FileStatus, Status )
885  USE module_ext_esmf
886  IMPLICIT NONE
887  INTEGER ,       INTENT(IN)  :: DataHandle
888  CHARACTER*(*) :: FileName
889  INTEGER ,       INTENT(OUT) :: FileStatus
890  INTEGER ,       INTENT(OUT) :: Status
891
892  Status = 0
893
894  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  begin, DataHandle = ', DataHandle
895  CALL wrf_debug ( 5 , TRIM(msg) )
896  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_valid_handle(',DataHandle,') = ', &
897                 int_valid_handle( DataHandle )
898  CALL wrf_debug ( 5 , TRIM(msg) )
899  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_handle_in_use(',DataHandle,') = ', &
900                 int_handle_in_use( DataHandle )
901  CALL wrf_debug ( 5 , TRIM(msg) )
902  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_read(',DataHandle,') = ', &
903                 opened_for_read( DataHandle )
904  CALL wrf_debug ( 5 , TRIM(msg) )
905  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_read(',DataHandle,') = ', &
906                 okay_to_read( DataHandle )
907  CALL wrf_debug ( 5 , TRIM(msg) )
908  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_write(',DataHandle,') = ', &
909                 opened_for_write( DataHandle )
910  CALL wrf_debug ( 5 , TRIM(msg) )
911  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_write(',DataHandle,') = ', &
912                 okay_to_write( DataHandle )
913  CALL wrf_debug ( 5 , TRIM(msg) )
914
915!$$$ need to cache file name and match with FileName argument and return
916!$$$ FileStatus = WRF_FILE_NOT_OPENED if they do not match
917
918  FileStatus = WRF_FILE_NOT_OPENED
919  IF ( int_valid_handle( DataHandle ) ) THEN
920    IF ( int_handle_in_use( DataHandle ) ) THEN
921      IF ( opened_for_read ( DataHandle ) ) THEN
922        IF ( okay_to_read( DataHandle ) ) THEN
923           FileStatus = WRF_FILE_OPENED_FOR_READ
924        ELSE
925           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
926        ENDIF
927      ELSE IF ( opened_for_write( DataHandle ) ) THEN
928        IF ( okay_to_write( DataHandle ) ) THEN
929           FileStatus = WRF_FILE_OPENED_FOR_WRITE
930        ELSE
931           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
932        ENDIF
933      ELSE
934        FileStatus = WRF_FILE_NOT_OPENED
935      ENDIF
936    ENDIF
937    WRITE( msg,* ) 'ERROR ext_esmf_inquire_opened:  file handle ',DataHandle,' is invalid'
938    CALL wrf_error_fatal ( TRIM(msg) )
939  ENDIF
940
941  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  end, FileStatus = ', FileStatus
942  CALL wrf_debug ( 5 , TRIM(msg) )
943
944  Status = 0
945 
946  RETURN
947END SUBROUTINE ext_esmf_inquire_opened
948
949!--- inquire_filename
950SUBROUTINE ext_esmf_inquire_filename ( DataHandle, FileName , FileStatus, Status )
951  USE module_ext_esmf
952  IMPLICIT NONE
953  INTEGER ,       INTENT(IN)  :: DataHandle
954  CHARACTER*(*) :: FileName
955  INTEGER ,       INTENT(OUT) :: FileStatus
956  INTEGER ,       INTENT(OUT) :: Status
957  CHARACTER *80   SysDepInfo
958  Status = 0
959
960  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  begin, DataHandle = ', DataHandle
961  CALL wrf_debug ( 5 , TRIM(msg) )
962  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_valid_handle(',DataHandle,') = ', &
963                 int_valid_handle( DataHandle )
964  CALL wrf_debug ( 5 , TRIM(msg) )
965  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_handle_in_use(',DataHandle,') = ', &
966                 int_handle_in_use( DataHandle )
967  CALL wrf_debug ( 5 , TRIM(msg) )
968  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_read(',DataHandle,') = ', &
969                 opened_for_read( DataHandle )
970  CALL wrf_debug ( 5 , TRIM(msg) )
971  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_read(',DataHandle,') = ', &
972                 okay_to_read( DataHandle )
973  CALL wrf_debug ( 5 , TRIM(msg) )
974  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_write(',DataHandle,') = ', &
975                 opened_for_write( DataHandle )
976  CALL wrf_debug ( 5 , TRIM(msg) )
977  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_write(',DataHandle,') = ', &
978                 okay_to_write( DataHandle )
979  CALL wrf_debug ( 5 , TRIM(msg) )
980
981!$$$ need to cache file name and return via FileName argument
982
983  FileStatus = WRF_FILE_NOT_OPENED
984  IF ( int_valid_handle( DataHandle ) ) THEN
985    IF ( int_handle_in_use( DataHandle ) ) THEN
986      IF ( opened_for_read ( DataHandle ) ) THEN
987        IF ( okay_to_read( DataHandle ) ) THEN
988           FileStatus = WRF_FILE_OPENED_FOR_READ
989        ELSE
990           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
991        ENDIF
992      ELSE IF ( opened_for_write( DataHandle ) ) THEN
993        IF ( okay_to_write( DataHandle ) ) THEN
994           FileStatus = WRF_FILE_OPENED_FOR_WRITE
995        ELSE
996           FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
997        ENDIF
998      ELSE
999        FileStatus = WRF_FILE_NOT_OPENED
1000      ENDIF
1001    ENDIF
1002    WRITE( msg,* ) 'ERROR ext_esmf_inquire_filename:  file handle ',DataHandle,' is invalid'
1003    CALL wrf_error_fatal ( TRIM(msg) )
1004  ENDIF
1005
1006  WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  end, FileStatus = ', FileStatus
1007  CALL wrf_debug ( 5 , TRIM(msg) )
1008
1009  Status = 0
1010  RETURN
1011END SUBROUTINE ext_esmf_inquire_filename
1012
1013!--- sync
1014SUBROUTINE ext_esmf_iosync ( DataHandle, Status )
1015  USE module_ext_esmf
1016  IMPLICIT NONE
1017  INTEGER ,       INTENT(IN)  :: DataHandle
1018  INTEGER ,       INTENT(OUT) :: Status
1019  Status = 0
1020  RETURN
1021END SUBROUTINE ext_esmf_iosync
1022
1023!--- close
1024SUBROUTINE ext_esmf_ioclose ( DataHandle, Status )
1025  USE module_ext_esmf
1026  IMPLICIT NONE
1027  INTEGER DataHandle, Status
1028  ! locals
1029  TYPE state_ptr
1030    TYPE(ESMF_State), POINTER :: stateptr
1031  END TYPE state_ptr
1032  TYPE(state_ptr) :: states(2)
1033  TYPE(ESMF_State), POINTER :: state
1034  INTEGER :: numItems, numFields, i, istate
1035  TYPE(ESMF_StateItemType), ALLOCATABLE :: itemTypes(:)
1036  TYPE(ESMF_Field) :: tmpField
1037  REAL, POINTER :: tmp_ptr(:,:)
1038  CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
1039  CHARACTER (len=ESMF_MAXSTR) :: str
1040  INTEGER :: rc
1041
1042! TODO:  The code below hangs with this error message: 
1043! TODO:  "ext_esmf_ioclose:  ESMF_FieldGetDataPointer( LANDMASK) failed"
1044! TODO:  Fix this so ESMF objects actually get destroyed to avoid memory
1045! TODO:  leaks and other extraordinary nastiness. 
1046  CALL wrf_debug( 5, 'ext_esmf_ioclose:  WARNING:  not destroying ESMF objects' )
1047#if 0
1048  ! $$$ Need to upgrade this to use nested ESMF_States if we want support
1049  ! $$$ more than one auxin and one auxhist stream for ESMF. 
1050  IF ( int_valid_handle (DataHandle) ) THEN
1051    IF ( int_handle_in_use( DataHandle ) ) THEN
1052      ! Iterate through importState *and* exportState, find each ESMF_Field,
1053      ! extract its data pointer and deallocate it, then destroy the
1054      ! ESMF_Field. 
1055      CALL ESMF_ImportStateGetCurrent(states(1)%stateptr, rc)
1056      IF ( rc /= ESMF_SUCCESS ) THEN
1057        CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ImportStateGetCurrent failed' )
1058      ENDIF
1059      CALL ESMF_ExportStateGetCurrent(states(2)%stateptr, rc)
1060      IF ( rc /= ESMF_SUCCESS ) THEN
1061        CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ExportStateGetCurrent failed' )
1062      ENDIF
1063      DO istate=1, 2
1064        state => states(istate)%stateptr   ! all this to avoid assignment (@#$%)
1065        ! Since there are no convenient iterators for ESMF_State (@#$%),
1066        ! write a lot of code...
1067        ! Figure out how many items are in the ESMF_State
1068        CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
1069        IF ( rc /= ESMF_SUCCESS) THEN
1070          CALL wrf_error_fatal ( 'ext_esmf_ioclose:  ESMF_StateGet(numItems) failed' )
1071        ENDIF
1072        ! allocate an array to hold the types of all items
1073        ALLOCATE( itemTypes(numItems) )
1074        ! allocate an array to hold the names of all items
1075        ALLOCATE( itemNames(numItems) )
1076        ! get the item types and names
1077        CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
1078                           itemNameList=itemNames, rc=rc)
1079        IF ( rc /= ESMF_SUCCESS) THEN
1080          WRITE(str,*) 'ext_esmf_ioclose:  ESMF_StateGet itemTypes failed with rc = ', rc
1081          CALL wrf_error_fatal ( str )
1082        ENDIF
1083        ! count how many items are ESMF_Fields
1084        numFields = 0
1085        DO i=1,numItems
1086          IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
1087            numFields = numFields + 1
1088          ENDIF
1089        ENDDO
1090        IF ( numFields > 0) THEN
1091          ! finally, extract nested ESMF_Fields by name, if there are any
1092          ! (should be able to do this by index at least -- @#%$)
1093          DO i=1,numItems
1094            IF ( itemTypes(i) == ESMF_STATEITEM_FIELD ) THEN
1095              CALL ESMF_StateGetField( state, TRIM(itemNames(i)), &
1096                                       tmpField, rc=rc )
1097              IF ( rc /= ESMF_SUCCESS) THEN
1098                WRITE(str,*) 'ext_esmf_ioclose:  ESMF_StateGetField(',TRIM(itemNames(i)),') failed'
1099                CALL wrf_error_fatal ( str )
1100              ENDIF
1101              ! destroy pointer in field
1102              CALL ESMF_FieldGetDataPointer( tmpField, tmp_ptr, rc=rc )
1103              IF (rc /= ESMF_SUCCESS) THEN
1104                WRITE( str , * )                                   &
1105                  'ext_esmf_ioclose:  ESMF_FieldGetDataPointer( ', &
1106                  TRIM(itemNames(i)),') failed'
1107                CALL wrf_error_fatal ( TRIM(str) )
1108              ENDIF
1109              DEALLOCATE( tmp_ptr )
1110              ! destroy field
1111              CALL ESMF_FieldDestroy( tmpField, rc=rc )
1112              IF (rc /= ESMF_SUCCESS) THEN
1113                WRITE( str , * )                            &
1114                  'ext_esmf_ioclose:  ESMF_FieldDestroy( ', &
1115                  TRIM(itemNames(i)),') failed'
1116                CALL wrf_error_fatal ( TRIM(str) )
1117              ENDIF
1118            ENDIF
1119          ENDDO
1120        ENDIF
1121        ! deallocate locals
1122        DEALLOCATE( itemTypes )
1123        DEALLOCATE( itemNames )
1124      ENDDO
1125      ! destroy ESMF_Grid associated with DataHandle
1126      CALL ioesmf_destroy_grid( DataHandle )
1127    ENDIF
1128  ENDIF
1129#endif
1130  Status = 0
1131  RETURN
1132END SUBROUTINE ext_esmf_ioclose
1133
1134!--- ioexit
1135SUBROUTINE ext_esmf_ioexit( Status )
1136  USE module_ext_esmf
1137  IMPLICIT NONE
1138  INTEGER ,       INTENT(OUT) :: Status
1139  INTEGER :: i
1140  Status = 0
1141! TODO:  The code below causes ext_ncd_ioclose() to fail in the
1142! TODO:  SST component for reasons as-yet unknown. 
1143! TODO:  Fix this so ESMF objects actually get destroyed to avoid memory
1144! TODO:  leaks and other extraordinary nastiness. 
1145  CALL wrf_debug( 5, 'ext_esmf_ioexit:  WARNING:  not destroying ESMF objects' )
1146#if 0
1147  DO i = 1, int_num_handles
1148    ! close any remaining open DataHandles
1149    CALL ext_esmf_ioclose ( i, Status )
1150    ! destroy ESMF_Grid for this DataHandle
1151    CALL ioesmf_destroy_grid( i )
1152  ENDDO
1153  CALL wrf_debug ( 5 , &
1154    'ext_esmf_ioexit:  DEBUG:  done cleaning up ESMF objects' )
1155#endif
1156  RETURN 
1157END SUBROUTINE ext_esmf_ioexit
1158
1159!--- get_next_time
1160SUBROUTINE ext_esmf_get_next_time ( DataHandle, DateStr, Status )
1161  USE module_ext_esmf
1162  IMPLICIT NONE
1163  INTEGER ,       INTENT(IN)  :: DataHandle
1164  CHARACTER*(*) :: DateStr
1165  INTEGER ,       INTENT(OUT) :: Status
1166  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1167    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_next_time: invalid data handle" )
1168  ENDIF
1169  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1170    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_next_time: DataHandle not opened" )
1171  ENDIF
1172  CALL wrf_message( "ext_esmf_get_next_time() not supported yet")
1173  Status = WRF_WARN_NOTSUPPORTED
1174  RETURN
1175END SUBROUTINE ext_esmf_get_next_time
1176
1177!--- set_time
1178SUBROUTINE ext_esmf_set_time ( DataHandle, DateStr, Status )
1179  USE module_ext_esmf
1180  IMPLICIT NONE
1181  INTEGER ,       INTENT(IN)  :: DataHandle
1182  CHARACTER*(*) :: DateStr
1183  INTEGER ,       INTENT(OUT) :: Status
1184  CALL wrf_message( "ext_esmf_set_time() not supported yet")
1185  Status = WRF_WARN_NOTSUPPORTED
1186  RETURN
1187END SUBROUTINE ext_esmf_set_time
1188
1189!--- get_var_info
1190SUBROUTINE ext_esmf_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
1191                                   DomainStart , DomainEnd , WrfType, Status )
1192  USE module_ext_esmf
1193  IMPLICIT NONE
1194  integer               ,intent(in)     :: DataHandle
1195  character*(*)         ,intent(in)     :: VarName
1196  integer               ,intent(out)    :: NDim
1197  character*(*)         ,intent(out)    :: MemoryOrder
1198  character*(*)         ,intent(out)    :: Stagger
1199  integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
1200  integer               ,intent(out)    :: WrfType
1201  integer               ,intent(out)    :: Status
1202
1203  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1204    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_var_info: invalid data handle" )
1205  ENDIF
1206  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1207    CALL wrf_error_fatal("io_esmf.F90: ext_esmf_get_var_info: DataHandle not opened" )
1208  ENDIF
1209  CALL wrf_message( "ext_esmf_get_var_info() not supported yet")
1210  Status = WRF_WARN_NOTSUPPORTED
1211  RETURN
1212END SUBROUTINE ext_esmf_get_var_info
1213
1214!--- get_next_var
1215SUBROUTINE ext_esmf_get_next_var ( DataHandle, VarName, Status )
1216  USE module_ext_esmf
1217  IMPLICIT NONE
1218  INTEGER ,       INTENT(IN)  :: DataHandle
1219  CHARACTER*(*) :: VarName
1220  INTEGER ,       INTENT(OUT) :: Status
1221
1222  IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1223    CALL wrf_error_fatal("external/io_esmf/io_esmf.F90: ext_esmf_get_next_var: invalid data handle" )
1224  ENDIF
1225  IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1226    CALL wrf_error_fatal("external/io_esmf/io_esmf.F90: ext_esmf_get_next_var: DataHandle not opened" )
1227  ENDIF
1228  CALL wrf_message( "ext_esmf_get_next_var() not supported yet")
1229  Status = WRF_WARN_NOTSUPPORTED
1230  RETURN
1231END SUBROUTINE ext_esmf_get_next_var
1232
1233!--- get_dom_ti_real
1234SUBROUTINE ext_esmf_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
1235  USE module_ext_esmf
1236  IMPLICIT NONE
1237  INTEGER ,       INTENT(IN)  :: DataHandle
1238  CHARACTER*(*) :: Element
1239  real ,            INTENT(IN) :: Data(*)
1240  INTEGER ,       INTENT(IN)  :: Count
1241  INTEGER ,       INTENT(OUT) :: Outcount
1242  INTEGER ,       INTENT(OUT) :: Status
1243  CALL wrf_message( "ext_esmf_get_dom_ti_real() not supported yet")
1244  Status = WRF_WARN_NOTSUPPORTED
1245  RETURN
1246END SUBROUTINE ext_esmf_get_dom_ti_real
1247
1248!--- put_dom_ti_real
1249SUBROUTINE ext_esmf_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
1250  USE module_ext_esmf
1251  IMPLICIT NONE
1252  INTEGER ,       INTENT(IN)  :: DataHandle
1253  CHARACTER*(*) :: Element
1254  real ,            INTENT(IN) :: Data(*)
1255  INTEGER ,       INTENT(IN)  :: Count
1256  INTEGER ,       INTENT(OUT) :: Status
1257  CALL wrf_message( "ext_esmf_put_dom_ti_real() not supported yet")
1258  Status = WRF_WARN_NOTSUPPORTED
1259  RETURN
1260END SUBROUTINE ext_esmf_put_dom_ti_real
1261
1262!--- get_dom_ti_double
1263SUBROUTINE ext_esmf_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
1264  USE module_ext_esmf
1265  IMPLICIT NONE
1266  INTEGER ,       INTENT(IN)  :: DataHandle
1267  CHARACTER*(*) :: Element
1268  real*8 ,            INTENT(OUT) :: Data(*)
1269  INTEGER ,       INTENT(IN)  :: Count
1270  INTEGER ,       INTENT(OUT)  :: OutCount
1271  INTEGER ,       INTENT(OUT) :: Status
1272  CALL wrf_message('ext_esmf_get_dom_ti_double not supported yet')
1273  Status = WRF_WARN_NOTSUPPORTED
1274  RETURN
1275END SUBROUTINE ext_esmf_get_dom_ti_double
1276
1277!--- put_dom_ti_double
1278SUBROUTINE ext_esmf_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
1279  USE module_ext_esmf
1280  IMPLICIT NONE
1281  INTEGER ,       INTENT(IN)  :: DataHandle
1282  CHARACTER*(*) :: Element
1283  real*8 ,            INTENT(IN) :: Data(*)
1284  INTEGER ,       INTENT(IN)  :: Count
1285  INTEGER ,       INTENT(OUT) :: Status
1286  CALL wrf_message('ext_esmf_put_dom_ti_double not supported yet')
1287  Status = WRF_WARN_NOTSUPPORTED
1288  RETURN
1289END SUBROUTINE ext_esmf_put_dom_ti_double
1290
1291!--- get_dom_ti_integer
1292SUBROUTINE ext_esmf_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
1293  USE module_ext_esmf
1294  IMPLICIT NONE
1295  INTEGER ,       INTENT(IN)  :: DataHandle
1296  CHARACTER*(*) :: Element
1297  integer ,            INTENT(OUT) :: Data(*)
1298  INTEGER ,       INTENT(IN)  :: Count
1299  INTEGER ,       INTENT(OUT)  :: OutCount
1300  INTEGER ,       INTENT(OUT) :: Status
1301
1302  Status = 0
1303  IF      ( Element == 'WEST-EAST_GRID_DIMENSION' ) THEN
1304    Data(1) = grid( DataHandle )%ide_save
1305    Outcount = 1
1306  ELSE IF ( Element == 'SOUTH-NORTH_GRID_DIMENSION' ) THEN
1307    Data(1) = grid( DataHandle )%jde_save
1308    Outcount = 1
1309  ELSE IF ( Element == 'BOTTOM-TOP_GRID_DIMENSION' ) THEN
1310    Data(1) = grid( DataHandle )%kde_save
1311    Outcount = 1
1312  ELSE
1313    CALL wrf_message('ext_esmf_get_dom_ti_integer not fully supported yet')
1314    Status = WRF_WARN_NOTSUPPORTED
1315  ENDIF
1316
1317  RETURN
1318END SUBROUTINE ext_esmf_get_dom_ti_integer
1319
1320!--- put_dom_ti_integer
1321SUBROUTINE ext_esmf_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
1322  USE module_ext_esmf
1323  IMPLICIT NONE
1324  INTEGER ,       INTENT(IN)  :: DataHandle
1325  CHARACTER*(*) :: Element
1326  INTEGER ,       INTENT(IN) :: Data(*)
1327  INTEGER ,       INTENT(IN)  :: Count
1328  INTEGER ,       INTENT(OUT) :: Status
1329  CALL wrf_message('ext_esmf_put_dom_ti_integer not supported yet')
1330  Status = WRF_WARN_NOTSUPPORTED
1331  RETURN
1332END SUBROUTINE ext_esmf_put_dom_ti_integer
1333
1334!--- get_dom_ti_logical
1335SUBROUTINE ext_esmf_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
1336  USE module_ext_esmf
1337  IMPLICIT NONE
1338  INTEGER ,       INTENT(IN)  :: DataHandle
1339  CHARACTER*(*) :: Element
1340  logical ,            INTENT(OUT) :: Data(*)
1341  INTEGER ,       INTENT(IN)  :: Count
1342  INTEGER ,       INTENT(OUT)  :: OutCount
1343  INTEGER ,       INTENT(OUT) :: Status
1344  CALL wrf_message('ext_esmf_get_dom_ti_logical not supported yet')
1345  Status = WRF_WARN_NOTSUPPORTED
1346  RETURN
1347END SUBROUTINE ext_esmf_get_dom_ti_logical
1348
1349!--- put_dom_ti_logical
1350SUBROUTINE ext_esmf_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
1351  USE module_ext_esmf
1352  IMPLICIT NONE
1353  INTEGER ,       INTENT(IN)  :: DataHandle
1354  CHARACTER*(*) :: Element
1355  logical ,            INTENT(IN) :: Data(*)
1356  INTEGER ,       INTENT(IN)  :: Count
1357  INTEGER ,       INTENT(OUT) :: Status
1358  CALL wrf_message('ext_esmf_put_dom_ti_logical not supported yet')
1359  Status = WRF_WARN_NOTSUPPORTED
1360  RETURN
1361END SUBROUTINE ext_esmf_put_dom_ti_logical
1362
1363!--- get_dom_ti_char
1364SUBROUTINE ext_esmf_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
1365  USE module_ext_esmf
1366  IMPLICIT NONE
1367  INTEGER ,       INTENT(IN)  :: DataHandle
1368  CHARACTER*(*) :: Element
1369  CHARACTER*(*) :: Data
1370  INTEGER ,       INTENT(OUT) :: Status
1371  CALL wrf_message('ext_esmf_get_dom_ti_char not supported yet')
1372  Status = WRF_WARN_NOTSUPPORTED
1373  RETURN
1374END SUBROUTINE ext_esmf_get_dom_ti_char
1375
1376!--- put_dom_ti_char
1377SUBROUTINE ext_esmf_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
1378  USE module_ext_esmf
1379  IMPLICIT NONE
1380  INTEGER ,       INTENT(IN)  :: DataHandle
1381  CHARACTER*(*) :: Element
1382  CHARACTER*(*) :: Data
1383  INTEGER ,       INTENT(OUT) :: Status
1384  CALL wrf_message('ext_esmf_put_dom_ti_char not supported yet')
1385  Status = WRF_WARN_NOTSUPPORTED
1386  RETURN
1387END SUBROUTINE ext_esmf_put_dom_ti_char
1388
1389!--- get_dom_td_real
1390SUBROUTINE ext_esmf_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1391  USE module_ext_esmf
1392  IMPLICIT NONE
1393  INTEGER ,       INTENT(IN)  :: DataHandle
1394  CHARACTER*(*) :: Element
1395  CHARACTER*(*) :: DateStr
1396  real ,            INTENT(OUT) :: Data(*)
1397  INTEGER ,       INTENT(IN)  :: Count
1398  INTEGER ,       INTENT(OUT)  :: OutCount
1399  INTEGER ,       INTENT(OUT) :: Status
1400  CALL wrf_message('ext_esmf_get_dom_td_real not supported yet')
1401  Status = WRF_WARN_NOTSUPPORTED
1402  RETURN
1403END SUBROUTINE ext_esmf_get_dom_td_real
1404
1405!--- put_dom_td_real
1406SUBROUTINE ext_esmf_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
1407  USE module_ext_esmf
1408  IMPLICIT NONE
1409  INTEGER ,       INTENT(IN)  :: DataHandle
1410  CHARACTER*(*) :: Element
1411  CHARACTER*(*) :: DateStr
1412  real ,            INTENT(IN) :: Data(*)
1413  INTEGER ,       INTENT(IN)  :: Count
1414  INTEGER ,       INTENT(OUT) :: Status
1415  CALL wrf_message('ext_esmf_put_dom_td_real not supported yet')
1416  Status = WRF_WARN_NOTSUPPORTED
1417  RETURN
1418END SUBROUTINE ext_esmf_put_dom_td_real
1419
1420!--- get_dom_td_double
1421SUBROUTINE ext_esmf_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1422  USE module_ext_esmf
1423  IMPLICIT NONE
1424  INTEGER ,       INTENT(IN)  :: DataHandle
1425  CHARACTER*(*) :: Element
1426  CHARACTER*(*) :: DateStr
1427  real*8 ,            INTENT(OUT) :: Data(*)
1428  INTEGER ,       INTENT(IN)  :: Count
1429  INTEGER ,       INTENT(OUT)  :: OutCount
1430  INTEGER ,       INTENT(OUT) :: Status
1431  CALL wrf_message('ext_esmf_get_dom_td_double not supported yet')
1432  Status = WRF_WARN_NOTSUPPORTED
1433  RETURN
1434END SUBROUTINE ext_esmf_get_dom_td_double
1435
1436!--- put_dom_td_double
1437SUBROUTINE ext_esmf_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
1438  USE module_ext_esmf
1439  IMPLICIT NONE
1440  INTEGER ,       INTENT(IN)  :: DataHandle
1441  CHARACTER*(*) :: Element
1442  CHARACTER*(*) :: DateStr
1443  real*8 ,            INTENT(IN) :: Data(*)
1444  INTEGER ,       INTENT(IN)  :: Count
1445  INTEGER ,       INTENT(OUT) :: Status
1446  CALL wrf_message('ext_esmf_put_dom_td_double not supported yet')
1447  Status = WRF_WARN_NOTSUPPORTED
1448  RETURN
1449END SUBROUTINE ext_esmf_put_dom_td_double
1450
1451!--- get_dom_td_integer
1452SUBROUTINE ext_esmf_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1453  USE module_ext_esmf
1454  IMPLICIT NONE
1455  INTEGER ,       INTENT(IN)  :: DataHandle
1456  CHARACTER*(*) :: Element
1457  CHARACTER*(*) :: DateStr
1458  integer ,            INTENT(OUT) :: Data(*)
1459  INTEGER ,       INTENT(IN)  :: Count
1460  INTEGER ,       INTENT(OUT)  :: OutCount
1461  INTEGER ,       INTENT(OUT) :: Status
1462  CALL wrf_message('ext_esmf_get_dom_td_integer not supported yet')
1463  Status = WRF_WARN_NOTSUPPORTED
1464  RETURN
1465END SUBROUTINE ext_esmf_get_dom_td_integer
1466
1467!--- put_dom_td_integer
1468SUBROUTINE ext_esmf_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
1469  USE module_ext_esmf
1470  IMPLICIT NONE
1471  INTEGER ,       INTENT(IN)  :: DataHandle
1472  CHARACTER*(*) :: Element
1473  CHARACTER*(*) :: DateStr
1474  integer ,            INTENT(IN) :: Data(*)
1475  INTEGER ,       INTENT(IN)  :: Count
1476  INTEGER ,       INTENT(OUT) :: Status
1477  CALL wrf_message('ext_esmf_put_dom_td_integer not supported yet')
1478  Status = WRF_WARN_NOTSUPPORTED
1479  RETURN
1480END SUBROUTINE ext_esmf_put_dom_td_integer
1481
1482!--- get_dom_td_logical
1483SUBROUTINE ext_esmf_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1484  USE module_ext_esmf
1485  IMPLICIT NONE
1486  INTEGER ,       INTENT(IN)  :: DataHandle
1487  CHARACTER*(*) :: Element
1488  CHARACTER*(*) :: DateStr
1489  logical ,            INTENT(OUT) :: Data(*)
1490  INTEGER ,       INTENT(IN)  :: Count
1491  INTEGER ,       INTENT(OUT)  :: OutCount
1492  INTEGER ,       INTENT(OUT) :: Status
1493  CALL wrf_message('ext_esmf_get_dom_td_logical not supported yet')
1494  Status = WRF_WARN_NOTSUPPORTED
1495  RETURN
1496END SUBROUTINE ext_esmf_get_dom_td_logical
1497
1498!--- put_dom_td_logical
1499SUBROUTINE ext_esmf_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
1500  USE module_ext_esmf
1501  IMPLICIT NONE
1502  INTEGER ,       INTENT(IN)  :: DataHandle
1503  CHARACTER*(*) :: Element
1504  CHARACTER*(*) :: DateStr
1505  logical ,            INTENT(IN) :: Data(*)
1506  INTEGER ,       INTENT(IN)  :: Count
1507  INTEGER ,       INTENT(OUT) :: Status
1508  CALL wrf_message('ext_esmf_put_dom_td_logical not supported yet')
1509  Status = WRF_WARN_NOTSUPPORTED
1510  RETURN
1511END SUBROUTINE ext_esmf_put_dom_td_logical
1512
1513!--- get_dom_td_char
1514SUBROUTINE ext_esmf_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
1515  USE module_ext_esmf
1516  IMPLICIT NONE
1517  INTEGER ,       INTENT(IN)  :: DataHandle
1518  CHARACTER*(*) :: Element
1519  CHARACTER*(*) :: DateStr
1520  CHARACTER*(*) :: Data
1521  INTEGER ,       INTENT(OUT) :: Status
1522  CALL wrf_message('ext_esmf_get_dom_td_char not supported yet')
1523  Status = WRF_WARN_NOTSUPPORTED
1524  RETURN
1525END SUBROUTINE ext_esmf_get_dom_td_char
1526
1527!--- put_dom_td_char
1528SUBROUTINE ext_esmf_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
1529  USE module_ext_esmf
1530  IMPLICIT NONE
1531  INTEGER ,       INTENT(IN)  :: DataHandle
1532  CHARACTER*(*) :: Element
1533  CHARACTER*(*) :: DateStr
1534  CHARACTER*(*) :: Data
1535  INTEGER ,       INTENT(OUT) :: Status
1536  CALL wrf_message('ext_esmf_put_dom_td_char not supported yet')
1537  Status = WRF_WARN_NOTSUPPORTED
1538  RETURN
1539END SUBROUTINE ext_esmf_put_dom_td_char
1540
1541!--- get_var_ti_real
1542SUBROUTINE ext_esmf_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1543  USE module_ext_esmf
1544  IMPLICIT NONE
1545  INTEGER ,       INTENT(IN)  :: DataHandle
1546  CHARACTER*(*) :: Element
1547  CHARACTER*(*) :: VarName
1548  real ,            INTENT(OUT) :: Data(*)
1549  INTEGER ,       INTENT(IN)  :: Count
1550  INTEGER ,       INTENT(OUT)  :: OutCount
1551  INTEGER ,       INTENT(OUT) :: Status
1552  CALL wrf_message('ext_esmf_get_var_ti_real not supported yet')
1553  Status = WRF_WARN_NOTSUPPORTED
1554  RETURN
1555END SUBROUTINE ext_esmf_get_var_ti_real
1556
1557!--- put_var_ti_real
1558SUBROUTINE ext_esmf_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
1559  USE module_ext_esmf
1560  IMPLICIT NONE
1561  INTEGER ,       INTENT(IN)  :: DataHandle
1562  CHARACTER*(*) :: Element
1563  CHARACTER*(*) :: VarName
1564  real ,            INTENT(IN) :: Data(*)
1565  INTEGER ,       INTENT(IN)  :: Count
1566  INTEGER ,       INTENT(OUT) :: Status
1567  CALL wrf_message('ext_esmf_put_var_ti_real not supported yet')
1568  Status = WRF_WARN_NOTSUPPORTED
1569  RETURN
1570END SUBROUTINE ext_esmf_put_var_ti_real
1571
1572!--- get_var_ti_double
1573SUBROUTINE ext_esmf_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1574  USE module_ext_esmf
1575  IMPLICIT NONE
1576  INTEGER ,       INTENT(IN)  :: DataHandle
1577  CHARACTER*(*) :: Element
1578  CHARACTER*(*) :: VarName
1579  real*8 ,            INTENT(OUT) :: Data(*)
1580  INTEGER ,       INTENT(IN)  :: Count
1581  INTEGER ,       INTENT(OUT)  :: OutCount
1582  INTEGER ,       INTENT(OUT) :: Status
1583  CALL wrf_message('ext_esmf_get_var_ti_double not supported yet')
1584  Status = WRF_WARN_NOTSUPPORTED
1585  RETURN
1586END SUBROUTINE ext_esmf_get_var_ti_double
1587
1588!--- put_var_ti_double
1589SUBROUTINE ext_esmf_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
1590  USE module_ext_esmf
1591  IMPLICIT NONE
1592  INTEGER ,       INTENT(IN)  :: DataHandle
1593  CHARACTER*(*) :: Element
1594  CHARACTER*(*) :: VarName
1595  real*8 ,            INTENT(IN) :: Data(*)
1596  INTEGER ,       INTENT(IN)  :: Count
1597  INTEGER ,       INTENT(OUT) :: Status
1598  CALL wrf_message('ext_esmf_put_var_ti_double not supported yet')
1599  Status = WRF_WARN_NOTSUPPORTED
1600  RETURN
1601END SUBROUTINE ext_esmf_put_var_ti_double
1602
1603!--- get_var_ti_integer
1604SUBROUTINE ext_esmf_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1605  USE module_ext_esmf
1606  IMPLICIT NONE
1607  INTEGER ,       INTENT(IN)  :: DataHandle
1608  CHARACTER*(*) :: Element
1609  CHARACTER*(*) :: VarName
1610  integer ,            INTENT(OUT) :: Data(*)
1611  INTEGER ,       INTENT(IN)  :: Count
1612  INTEGER ,       INTENT(OUT)  :: OutCount
1613  INTEGER ,       INTENT(OUT) :: Status
1614  CALL wrf_message('ext_esmf_get_var_ti_integer not supported yet')
1615  Status = WRF_WARN_NOTSUPPORTED
1616  RETURN
1617END SUBROUTINE ext_esmf_get_var_ti_integer
1618
1619!--- put_var_ti_integer
1620SUBROUTINE ext_esmf_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
1621  USE module_ext_esmf
1622  IMPLICIT NONE
1623  INTEGER ,       INTENT(IN)  :: DataHandle
1624  CHARACTER*(*) :: Element
1625  CHARACTER*(*) :: VarName
1626  integer ,            INTENT(IN) :: Data(*)
1627  INTEGER ,       INTENT(IN)  :: Count
1628  INTEGER ,       INTENT(OUT) :: Status
1629  CALL wrf_message('ext_esmf_put_var_ti_integer not supported yet')
1630  Status = WRF_WARN_NOTSUPPORTED
1631  RETURN
1632END SUBROUTINE ext_esmf_put_var_ti_integer
1633
1634!--- get_var_ti_logical
1635SUBROUTINE ext_esmf_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1636  USE module_ext_esmf
1637  IMPLICIT NONE
1638  INTEGER ,       INTENT(IN)  :: DataHandle
1639  CHARACTER*(*) :: Element
1640  CHARACTER*(*) :: VarName
1641  logical ,            INTENT(OUT) :: Data(*)
1642  INTEGER ,       INTENT(IN)  :: Count
1643  INTEGER ,       INTENT(OUT)  :: OutCount
1644  INTEGER ,       INTENT(OUT) :: Status
1645  CALL wrf_message('ext_esmf_get_var_ti_logical not supported yet')
1646  Status = WRF_WARN_NOTSUPPORTED
1647  RETURN
1648END SUBROUTINE ext_esmf_get_var_ti_logical
1649
1650!--- put_var_ti_logical
1651SUBROUTINE ext_esmf_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
1652  USE module_ext_esmf
1653  IMPLICIT NONE
1654  INTEGER ,       INTENT(IN)  :: DataHandle
1655  CHARACTER*(*) :: Element
1656  CHARACTER*(*) :: VarName
1657  logical ,            INTENT(IN) :: Data(*)
1658  INTEGER ,       INTENT(IN)  :: Count
1659  INTEGER ,       INTENT(OUT) :: Status
1660  CALL wrf_message('ext_esmf_put_var_ti_logical not supported yet')
1661  Status = WRF_WARN_NOTSUPPORTED
1662  RETURN
1663END SUBROUTINE ext_esmf_put_var_ti_logical
1664
1665!--- get_var_ti_char
1666SUBROUTINE ext_esmf_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
1667  USE module_ext_esmf
1668  IMPLICIT NONE
1669  INTEGER ,       INTENT(IN)  :: DataHandle
1670  CHARACTER*(*) :: Element
1671  CHARACTER*(*) :: VarName
1672  CHARACTER*(*) :: Data
1673  INTEGER ,       INTENT(OUT) :: Status
1674  INTEGER locDataHandle, code
1675  CHARACTER*132 locElement, locVarName
1676  CALL wrf_message('ext_esmf_get_var_ti_char not supported yet')
1677  Status = WRF_WARN_NOTSUPPORTED
1678  RETURN
1679END SUBROUTINE ext_esmf_get_var_ti_char
1680
1681!--- put_var_ti_char
1682SUBROUTINE ext_esmf_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
1683  USE module_ext_esmf
1684  IMPLICIT NONE
1685  INTEGER ,       INTENT(IN)  :: DataHandle
1686  CHARACTER*(*) :: Element
1687  CHARACTER*(*) :: VarName
1688  CHARACTER*(*) :: Data
1689  INTEGER ,       INTENT(OUT) :: Status
1690  REAL dummy
1691  INTEGER                 :: Count
1692  CALL wrf_message('ext_esmf_put_var_ti_char not supported yet')
1693  Status = WRF_WARN_NOTSUPPORTED
1694  RETURN
1695END SUBROUTINE ext_esmf_put_var_ti_char
1696
1697!--- get_var_td_real
1698SUBROUTINE ext_esmf_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1699  USE module_ext_esmf
1700  IMPLICIT NONE
1701  INTEGER ,       INTENT(IN)  :: DataHandle
1702  CHARACTER*(*) :: Element
1703  CHARACTER*(*) :: DateStr
1704  CHARACTER*(*) :: VarName
1705  real ,            INTENT(OUT) :: Data(*)
1706  INTEGER ,       INTENT(IN)  :: Count
1707  INTEGER ,       INTENT(OUT)  :: OutCount
1708  INTEGER ,       INTENT(OUT) :: Status
1709  CALL wrf_message('ext_esmf_get_var_td_real not supported yet')
1710  Status = WRF_WARN_NOTSUPPORTED
1711  RETURN
1712END SUBROUTINE ext_esmf_get_var_td_real
1713
1714!--- put_var_td_real
1715SUBROUTINE ext_esmf_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1716  USE module_ext_esmf
1717  IMPLICIT NONE
1718  INTEGER ,       INTENT(IN)  :: DataHandle
1719  CHARACTER*(*) :: Element
1720  CHARACTER*(*) :: DateStr
1721  CHARACTER*(*) :: VarName
1722  real ,            INTENT(IN) :: Data(*)
1723  INTEGER ,       INTENT(IN)  :: Count
1724  INTEGER ,       INTENT(OUT) :: Status
1725  CALL wrf_message('ext_esmf_put_var_td_real not supported yet')
1726  Status = WRF_WARN_NOTSUPPORTED
1727  RETURN
1728END SUBROUTINE ext_esmf_put_var_td_real
1729
1730!--- get_var_td_double
1731SUBROUTINE ext_esmf_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1732  USE module_ext_esmf
1733  IMPLICIT NONE
1734  INTEGER ,       INTENT(IN)  :: DataHandle
1735  CHARACTER*(*) :: Element
1736  CHARACTER*(*) :: DateStr
1737  CHARACTER*(*) :: VarName
1738  real*8 ,            INTENT(OUT) :: Data(*)
1739  INTEGER ,       INTENT(IN)  :: Count
1740  INTEGER ,       INTENT(OUT)  :: OutCount
1741  INTEGER ,       INTENT(OUT) :: Status
1742  CALL wrf_message('ext_esmf_get_var_td_double not supported yet')
1743  Status = WRF_WARN_NOTSUPPORTED
1744  RETURN
1745END SUBROUTINE ext_esmf_get_var_td_double
1746
1747!--- put_var_td_double
1748SUBROUTINE ext_esmf_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1749  USE module_ext_esmf
1750  IMPLICIT NONE
1751  INTEGER ,       INTENT(IN)  :: DataHandle
1752  CHARACTER*(*) :: Element
1753  CHARACTER*(*) :: DateStr
1754  CHARACTER*(*) :: VarName
1755  real*8 ,            INTENT(IN) :: Data(*)
1756  INTEGER ,       INTENT(IN)  :: Count
1757  INTEGER ,       INTENT(OUT) :: Status
1758  CALL wrf_message('ext_esmf_put_var_td_double not supported yet')
1759  Status = WRF_WARN_NOTSUPPORTED
1760  RETURN
1761END SUBROUTINE ext_esmf_put_var_td_double
1762
1763!--- get_var_td_integer
1764SUBROUTINE ext_esmf_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1765  USE module_ext_esmf
1766  IMPLICIT NONE
1767  INTEGER ,       INTENT(IN)  :: DataHandle
1768  CHARACTER*(*) :: Element
1769  CHARACTER*(*) :: DateStr
1770  CHARACTER*(*) :: VarName
1771  integer ,            INTENT(OUT) :: Data(*)
1772  INTEGER ,       INTENT(IN)  :: Count
1773  INTEGER ,       INTENT(OUT)  :: OutCount
1774  INTEGER ,       INTENT(OUT) :: Status
1775  CALL wrf_message('ext_esmf_get_var_td_integer not supported yet')
1776  Status = WRF_WARN_NOTSUPPORTED
1777  RETURN
1778END SUBROUTINE ext_esmf_get_var_td_integer
1779
1780!--- put_var_td_integer
1781SUBROUTINE ext_esmf_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1782  USE module_ext_esmf
1783  IMPLICIT NONE
1784  INTEGER ,       INTENT(IN)  :: DataHandle
1785  CHARACTER*(*) :: Element
1786  CHARACTER*(*) :: DateStr
1787  CHARACTER*(*) :: VarName
1788  integer ,            INTENT(IN) :: Data(*)
1789  INTEGER ,       INTENT(IN)  :: Count
1790  INTEGER ,       INTENT(OUT) :: Status
1791  CALL wrf_message('ext_esmf_put_var_td_integer not supported yet')
1792  Status = WRF_WARN_NOTSUPPORTED
1793  RETURN
1794END SUBROUTINE ext_esmf_put_var_td_integer
1795
1796!--- get_var_td_logical
1797SUBROUTINE ext_esmf_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1798  USE module_ext_esmf
1799  IMPLICIT NONE
1800  INTEGER ,       INTENT(IN)  :: DataHandle
1801  CHARACTER*(*) :: Element
1802  CHARACTER*(*) :: DateStr
1803  CHARACTER*(*) :: VarName
1804  logical ,            INTENT(OUT) :: Data(*)
1805  INTEGER ,       INTENT(IN)  :: Count
1806  INTEGER ,       INTENT(OUT)  :: OutCount
1807  INTEGER ,       INTENT(OUT) :: Status
1808  CALL wrf_message('ext_esmf_get_var_td_logical not supported yet')
1809  Status = WRF_WARN_NOTSUPPORTED
1810  RETURN
1811END SUBROUTINE ext_esmf_get_var_td_logical
1812
1813!--- put_var_td_logical
1814SUBROUTINE ext_esmf_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1815  USE module_ext_esmf
1816  IMPLICIT NONE
1817  INTEGER ,       INTENT(IN)  :: DataHandle
1818  CHARACTER*(*) :: Element
1819  CHARACTER*(*) :: DateStr
1820  CHARACTER*(*) :: VarName
1821  logical ,            INTENT(IN) :: Data(*)
1822  INTEGER ,       INTENT(IN)  :: Count
1823  INTEGER ,       INTENT(OUT) :: Status
1824  CALL wrf_message('ext_esmf_put_var_td_logical not supported yet')
1825  Status = WRF_WARN_NOTSUPPORTED
1826  RETURN
1827END SUBROUTINE ext_esmf_put_var_td_logical
1828
1829!--- get_var_td_char
1830SUBROUTINE ext_esmf_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1831  USE module_ext_esmf
1832  IMPLICIT NONE
1833  INTEGER ,       INTENT(IN)  :: DataHandle
1834  CHARACTER*(*) :: Element
1835  CHARACTER*(*) :: DateStr
1836  CHARACTER*(*) :: VarName
1837  CHARACTER*(*) :: Data
1838  INTEGER ,       INTENT(OUT) :: Status
1839  CALL wrf_message('ext_esmf_get_var_td_char not supported yet')
1840  Status = WRF_WARN_NOTSUPPORTED
1841  RETURN
1842END SUBROUTINE ext_esmf_get_var_td_char
1843
1844!--- put_var_td_char
1845SUBROUTINE ext_esmf_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1846  USE module_ext_esmf
1847  IMPLICIT NONE
1848  INTEGER ,       INTENT(IN)  :: DataHandle
1849  CHARACTER*(*) :: Element
1850  CHARACTER*(*) :: DateStr
1851  CHARACTER*(*) :: VarName
1852  CHARACTER*(*) :: Data
1853  INTEGER ,       INTENT(OUT) :: Status
1854  CALL wrf_message('ext_esmf_put_var_td_char not supported yet')
1855  Status = WRF_WARN_NOTSUPPORTED
1856  RETURN
1857END SUBROUTINE ext_esmf_put_var_td_char
1858
1859
Note: See TracBrowser for help on using the repository browser.