source: trunk/WRF.COMMON/WRFV3/external/io_esmf/io_esmf.F90 @ 2762

Last change on this file since 2762 was 2759, checked in by aslmd, 3 years ago

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