source: lmdz_wrf/WRFV3/external/io_esmf/io_esmf.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

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