external/io_esmf/io_esmf.F90

   1
   2 MODULE module_ext_esmf
   3
   4 ! 5.2.0r  USE ESMF_Mod
   5   USE ESMF
   6   USE module_esmf_extensions
   7
   8   IMPLICIT NONE
   9
  10   TYPE grid_ptr
  11     TYPE(ESMF_Grid), POINTER :: ptr
  12     ! use these for error-checking for now...
  13     INTEGER :: ide_save
  14     INTEGER :: jde_save
  15     INTEGER :: kde_save
  16     LOGICAL :: in_use
  17   END TYPE grid_ptr
  18
  19 !TODO:  encapsulate this state into a class...
  20   INTEGER, PARAMETER :: int_num_handles = 99
  21   LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,       &
  22                                          opened_for_write, opened_for_read, &
  23                                          int_handle_in_use
  24   TYPE(grid_ptr) :: grid(int_num_handles)
  25
  26   ! convenience...
  27   CHARACTER (256) :: msg
  28
  29 #include "wrf_io_flags.h"
  30 #include "wrf_status_codes.h"
  31
  32   CONTAINS
  33
  34     LOGICAL FUNCTION int_valid_handle( handle )
  35       IMPLICIT NONE
  36       INTEGER, INTENT(IN) ::  handle
  37       int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
  38     END FUNCTION int_valid_handle
  39
  40     SUBROUTINE int_get_fresh_handle( retval )
  41       INTEGER i, retval
  42
  43       retval = -1
  44 ! dont use first 8 handles
  45       DO i = 8, int_num_handles
  46         IF ( .NOT. int_handle_in_use(i) )  THEN
  47           retval = i
  48           GOTO 33
  49         ENDIF
  50       ENDDO
  51 33    CONTINUE
  52       IF ( retval < 0 )  THEN
  53         CALL wrf_error_fatal( "io_esmf.F90: int_get_fresh_handle() out of handles")
  54       ENDIF
  55       int_handle_in_use(retval) = .TRUE.
  56     END SUBROUTINE int_get_fresh_handle
  57
  58 ! parse comma separated list of VARIABLE=VALUE strings and return the
  59 ! value for the matching variable if such exists, otherwise return
  60 ! the empty string
  61 SUBROUTINE get_value ( varname , str , retval )
  62   IMPLICIT NONE
  63   CHARACTER*(*) ::    varname
  64   CHARACTER*(*) ::    str
  65   CHARACTER*(*) ::    retval
  66
  67   CHARACTER (128) varstr, tstr
  68   INTEGER i,j,n,varstrn
  69   LOGICAL nobreak, nobreakouter
  70
  71   varstr = TRIM(varname)//"="
  72   varstrn = len(TRIM(varstr))
  73   n = len(TRIM(str))
  74   retval = ""
  75   i = 1
  76   nobreakouter = .TRUE.
  77   DO WHILE ( nobreakouter )
  78     j = 1
  79     nobreak = .TRUE.
  80     tstr = ""
  81     DO WHILE ( nobreak )
  82       nobreak = .FALSE.
  83       IF ( i .LE. n ) THEN
  84         IF (str(i:i) .NE. ',' ) THEN
  85            tstr(j:j) = str(i:i)
  86            nobreak = .TRUE.
  87         ENDIF
  88       ENDIF
  89       j = j + 1
  90       i = i + 1
  91     ENDDO
  92     IF ( i .GT. n ) nobreakouter = .FALSE.
  93     IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
  94       retval(1:) = TRIM(tstr(varstrn+1:))
  95       nobreakouter = .FALSE.
  96     ENDIF
  97   ENDDO
  98   RETURN
  99 END SUBROUTINE get_value
 100
 101
 102     !--- ioinit
 103     SUBROUTINE init_module_ext_esmf
 104       IMPLICIT NONE
 105       INTEGER :: i
 106       DO i = 1, int_num_handles
 107         WRITE( msg,* ) 'init_module_ext_esmf:  calling ioesmf_nullify_grid(',i,')'
 108         CALL wrf_debug ( 5, TRIM(msg) )
 109         CALL ioesmf_nullify_grid( i )
 110       ENDDO
 111       RETURN
 112     END SUBROUTINE init_module_ext_esmf
 113
 114
 115   ! allgather for integers, ESMF_style (since ESMF does not do this yet)
 116   SUBROUTINE GatherIntegerScalars_ESMF( inval, pe, numprocs, outvals )
 117     INTEGER, INTENT(IN   ) :: inval                 ! input scalar on this task
 118     INTEGER, INTENT(IN   ) :: pe                    ! task id
 119     INTEGER, INTENT(IN   ) :: numprocs              ! number of tasks
 120     INTEGER, INTENT(  OUT) :: outvals(0:numprocs-1) ! gathered output vector
 121     ! Local declarations
 122     TYPE(ESMF_VM) :: vm
 123     INTEGER(ESMF_KIND_I4) :: allSnd(0:numprocs-1)
 124     INTEGER(ESMF_KIND_I4) :: allRcv(0:numprocs-1)
 125     INTEGER :: rc
 126
 127     ! get current ESMF virtual machine for communication
 128     CALL ESMF_VMGetCurrent(vm, rc=rc)
 129     IF ( rc /= ESMF_SUCCESS ) THEN
 130       WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
 131                      __FILE__ ,                    &
 132                      ', line',                     &
 133                      __LINE__
 134       CALL wrf_error_fatal ( msg )
 135     ENDIF
 136     allSnd = 0_ESMF_KIND_I4
 137     allSnd(pe) = inval
 138     ! Hack due to lack of ESMF_VMAllGather().
 139 ! 5.2.0r    CALL ESMF_VMAllReduce(vm, allSnd, allRcv, numprocs, ESMF_SUM, rc=rc )
 140     CALL ESMF_VMAllReduce(vm, allSnd, allRcv, numprocs, ESMF_REDUCE_SUM, rc=rc )
 141     IF ( rc /= ESMF_SUCCESS ) THEN
 142       WRITE( msg,* ) 'Error in ESMF_VMAllReduce', &
 143                      __FILE__ ,                     &
 144                      ', line',                      &
 145                      __LINE__
 146       CALL wrf_error_fatal ( msg )
 147     ENDIF
 148     outvals = allRcv
 149
 150   END SUBROUTINE GatherIntegerScalars_ESMF
 151
 152
 153 END MODULE module_ext_esmf
 154
 155
 156
 157   ! Indexes for non-staggered variables come in at one-less than
 158   ! domain dimensions, but io_esmf is currently hacked to use full
 159   ! domain spec, so adjust if not staggered.
 160   !TODO:  remove this hackery once ESMF can support staggered
 161   !TODO:  grids in regional models
 162   SUBROUTINE ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
 163                                  DomainEndFull, PatchEndFull )
 164     IMPLICIT NONE
 165     INTEGER,       INTENT(IN   ) :: numdims
 166     INTEGER,       INTENT(IN   ) :: DomainEnd(numdims)
 167     INTEGER,       INTENT(IN   ) :: PatchEnd(numdims)
 168     CHARACTER*(*), INTENT(IN   ) :: Stagger
 169     INTEGER,       INTENT(  OUT) :: DomainEndFull(numdims)
 170     INTEGER,       INTENT(  OUT) :: PatchEndFull(numdims)
 171     LOGICAL, EXTERNAL :: has_char
 172     DomainEndFull(1:numdims) = DomainEnd(1:numdims)
 173     IF ( .NOT. has_char( Stagger, 'x' ) ) DomainEndFull(1) = DomainEndFull(1) + 1
 174     IF ( .NOT. has_char( Stagger, 'y' ) ) DomainEndFull(2) = DomainEndFull(2) + 1
 175     PatchEndFull(1:numdims) = PatchEnd(1:numdims)
 176     IF ( .NOT. has_char( Stagger, 'x' ) ) THEN
 177       IF ( DomainEnd(1) == PatchEnd(1) ) PatchEndFull(1) = DomainEndFull(1)
 178     ENDIF
 179     IF ( .NOT. has_char( Stagger, 'y' ) ) THEN
 180       IF ( DomainEnd(2) == PatchEnd(2) ) PatchEndFull(2) = DomainEndFull(2)
 181     ENDIF
 182   END SUBROUTINE ioesmf_endfullhack
 183
 184
 185   ! Create the ESMF_Grid associated with index DataHandle.
 186   !TODO:  Note that periodicity is not supported by this interface.  If
 187   !TODO:  periodicity is needed, pass in via SysDepInfo in the call to
 188   !TODO:  ext_esmf_ioinit().
 189   !TODO:  Note that lat/lon coordinates are not supported by this interface
 190   !TODO:  since general curvilinear coordindates (needed for map projections
 191   !TODO:  used by WRF such as polar stereographic, mercator, lambert conformal)
 192   !TODO:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported,
 193   !TODO:  add them via the "sieve" method used in ../io_mcel/.
 194   SUBROUTINE ioesmf_create_grid( DataHandle, numdims,    &
 195                                  MemoryOrder, Stagger,   &
 196                                  DomainStart, DomainEnd, &
 197                                  MemoryStart, MemoryEnd, &
 198                                  PatchStart, PatchEnd )
 199     USE module_ext_esmf
 200     IMPLICIT NONE
 201     INTEGER,       INTENT(IN   ) :: DataHandle
 202     INTEGER,       INTENT(IN   ) :: numdims
 203     CHARACTER*(*), INTENT(IN   ) :: MemoryOrder            ! not used yet
 204     CHARACTER*(*), INTENT(IN   ) :: Stagger
 205     INTEGER,       INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
 206     INTEGER,       INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
 207     INTEGER,       INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
 208     INTEGER :: DomainEndFull(numdims)
 209     INTEGER :: PatchEndFull(numdims)
 210
 211     WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  begin, DataHandle = ', DataHandle
 212     CALL wrf_debug ( 5, TRIM(msg) )
 213     ! For now, blindly create a new grid if it does not already exist for
 214     ! this DataHandle
 215 !TODO:  Note that this approach will result in duplicate ESMF_Grids when
 216 !TODO:  io_esmf is used for input and output.  The first ESMF_Grid will
 217 !TODO:  be associated with the input handle and the second will be associated
 218 !TODO:  with the output handle.  Fix this if ESMF_Grids are expensive.
 219     IF ( .NOT. grid( DataHandle )%in_use ) THEN
 220       IF ( ASSOCIATED( grid( DataHandle )%ptr ) ) THEN
 221         CALL wrf_error_fatal ( 'ASSERTION ERROR:  grid(',DataHandle,') should be NULL' )
 222       ENDIF
 223       IF ( numdims /= 2 ) THEN
 224         CALL wrf_error_fatal ( 'ERROR:  only 2D arrays supported so far with io_esmf' )
 225       ELSE
 226         WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  creating grid(',DataHandle,')%ptr'
 227         CALL wrf_debug ( 5, TRIM(msg) )
 228         ALLOCATE( grid( DataHandle )%ptr )
 229         grid( DataHandle )%in_use = .TRUE.
 230         ! The non-staggered variables come in at one-less than
 231         ! domain dimensions, but io_esmf is currently hacked to use full
 232         ! domain spec, so adjust if not staggered.
 233         !TODO:  remove this hackery once ESMF can support staggered
 234         !TODO:  grids in regional models
 235         CALL ioesmf_endfullhack( numdims, DomainEnd, PatchEnd, Stagger, &
 236                                  DomainEndFull, PatchEndFull )
 237 !TODO:  at the moment this is hard-coded for 2D arrays
 238 !TODO:  use MemoryOrder to set these properly!
 239 !TODO:  also, set these once only
 240 !TODO:  maybe even rip this out since it depends on a hack in input_wrf.F ...
 241         grid( DataHandle )%ide_save = DomainEndFull(1)
 242         grid( DataHandle )%jde_save = DomainEndFull(2)
 243         grid( DataHandle )%kde_save = 1
 244         WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  DomainEndFull = ', DomainEndFull
 245         CALL wrf_debug ( 5, TRIM(msg) )
 246         WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  PatchEndFull = ', PatchEndFull
 247         CALL wrf_debug ( 5, TRIM(msg) )
 248         CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  Calling ioesmf_create_grid_int()' )
 249         CALL ioesmf_create_grid_int( grid( DataHandle )%ptr,     &
 250                               numdims,                    &
 251                               DomainStart, DomainEndFull, &
 252 !                              DomainStart, DomainEnd, &
 253                               MemoryStart, MemoryEnd,     &
 254 !                              PatchStart, PatchEndFull )
 255                               PatchStart, PatchEnd )
 256         CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid:  back from ioesmf_create_grid_int()' )
 257         WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  done creating grid(',DataHandle,')%ptr'
 258         CALL wrf_debug ( 5, TRIM(msg) )
 259       ENDIF
 260     ENDIF
 261     WRITE( msg,* ) 'DEBUG ioesmf_create_grid:  end'
 262     CALL wrf_debug ( 5, TRIM(msg) )
 263
 264   END SUBROUTINE ioesmf_create_grid
 265
 266
 267
 268   ! Create an ESMF_Grid that matches a WRF decomposition.
 269   !TODO:  Note that periodicity is not supported by this interface.  If
 270   !TODO:  periodicity is needed, pass in via SysDepInfo in the call to
 271   !TODO:  ext_esmf_ioinit().
 272   !TODO:  Note that lat/lon coordinates are not supported by this interface
 273   !TODO:  since general curvilinear coordindates (needed for map projections
 274   !TODO:  used by WRF such as polar stereographic, mercator, lambert conformal)
 275   !TODO:  are not supported by ESMF as of ESMF 2.1.1.  Once they are supported,
 276   !TODO:  add them via the "sieve" method used in ../io_mcel/.
 277   !TODO:  Note that DomainEnd and PatchEnd must currently include "extra"
 278   !TODO:  points for non-periodic staggered arrays.  It may be possible to
 279   !TODO:  remove this hackery once ESMF can support staggered
 280   !TODO:  grids in regional models.
 281   SUBROUTINE ioesmf_create_grid_int( esmfgrid, numdims,      &
 282                               DomainStart, DomainEnd, &
 283                               MemoryStart, MemoryEnd, &
 284                               PatchStart, PatchEnd )
 285     USE module_ext_esmf
 286     IMPLICIT NONE
 287     TYPE(ESMF_Grid), INTENT(INOUT) :: esmfgrid
 288     INTEGER,         INTENT(IN   ) :: numdims
 289     INTEGER,         INTENT(IN   ) :: DomainStart(numdims), DomainEnd(numdims)
 290     INTEGER,         INTENT(IN   ) :: MemoryStart(numdims), MemoryEnd(numdims)
 291     INTEGER,         INTENT(IN   ) :: PatchStart(numdims),  PatchEnd(numdims)
 292     ! Local declarations
 293     INTEGER :: numprocs     ! total number of tasks
 294     INTEGER, ALLOCATABLE :: ipatchStarts(:), jpatchStarts(:)
 295     INTEGER :: numprocsX    ! number of tasks in "i" dimension
 296     INTEGER :: numprocsY    ! number of tasks in "j" dimension
 297     INTEGER, ALLOCATABLE :: permuteTasks(:)
 298     INTEGER :: globalXcount ! staggered domain count in "i" dimension
 299     INTEGER :: globalYcount ! staggered domain count in "j" dimension
 300     INTEGER :: myXstart     ! task-local start in "i" dimension
 301     INTEGER :: myYstart     ! task-local start in "j" dimension
 302     INTEGER :: myXend       ! staggered task-local end in "i" dimension
 303     INTEGER :: myYend       ! staggered task-local end in "j" dimension
 304     INTEGER, ALLOCATABLE :: allXStart(:)
 305     INTEGER, ALLOCATABLE :: allXCount(:)
 306     INTEGER, ALLOCATABLE :: dimXCount(:)
 307     INTEGER, ALLOCATABLE :: allYStart(:)
 308     INTEGER, ALLOCATABLE :: allYCount(:)
 309     INTEGER, ALLOCATABLE :: dimYCount(:)
 310     REAL(ESMF_KIND_R8), ALLOCATABLE :: coordX(:)
 311     REAL(ESMF_KIND_R8), ALLOCATABLE :: coordY(:)
 312     INTEGER, ALLOCATABLE :: cellCounts(:,:)
 313     INTEGER, ALLOCATABLE :: globalStarts(:,:)
 314     INTEGER :: rc, debug_level
 315     INTEGER :: myXcount      ! task-local count in "i" dimension
 316     INTEGER :: myYcount      ! task-local count in "j" dimension
 317     INTEGER :: globalCellCounts(2)
 318     INTEGER :: numprocsXY(2)
 319     INTEGER :: myPE, i, j, pe, is, ie, js, je, is_min, js_min, ie_max, je_max
 320     INTEGER :: ips, ipe, jps, jpe, ids, ide, jds, jde
 321     TYPE(ESMF_VM) :: vm
 322     TYPE(ESMF_DELayout) :: taskLayout
 323     REAL(ESMF_KIND_R8), DIMENSION(:), POINTER :: coordX2d, coordY2d
 324     INTEGER, DIMENSION(3) :: ubnd, lbnd
 325     CHARACTER (32) :: gridname
 326     INTEGER, SAVE :: gridID = 0
 327
 328       CALL get_wrf_debug_level( debug_level )
 329
 330       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  begin...' )
 331       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numdims = ',numdims
 332       CALL wrf_debug ( 5 , TRIM(msg) )
 333       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainStart = ',DomainStart(1:numdims)
 334       CALL wrf_debug ( 5 , TRIM(msg) )
 335       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  DomainEnd = ',DomainEnd(1:numdims)
 336       CALL wrf_debug ( 5 , TRIM(msg) )
 337       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryStart = ',MemoryStart(1:numdims)
 338       CALL wrf_debug ( 5 , TRIM(msg) )
 339       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  MemoryEnd = ',MemoryEnd(1:numdims)
 340       CALL wrf_debug ( 5 , TRIM(msg) )
 341       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchStart = ',PatchStart(1:numdims)
 342       CALL wrf_debug ( 5 , TRIM(msg) )
 343       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  PatchEnd = ',PatchEnd(1:numdims)
 344       CALL wrf_debug ( 5 , TRIM(msg) )
 345       ! First, determine number of tasks and number of tasks in each decomposed
 346       ! dimension (ESMF 2.2.0 is restricted to simple task layouts)
 347       ! get current ESMF virtual machine and inquire...
 348       CALL ESMF_VMGetCurrent(vm, rc=rc)
 349       IF ( rc /= ESMF_SUCCESS ) THEN
 350         WRITE( msg,* ) 'Error in ESMF_VMGetCurrent', &
 351                        __FILE__ ,                    &
 352                        ', line',                     &
 353                        __LINE__
 354         CALL wrf_error_fatal ( msg )
 355       ENDIF
 356 !TODO:  Note (PET==MPI process) assumption here.  This is OK in ESMF
 357 !TODO:  2.2.0 but may change in a future ESMF release.  If so, we will
 358 !TODO:  need another way to do this.  May want to grab mpiCommunicator
 359 !TODO:  instead and ask it directly for number of MPI tasks.  Unless this
 360 !TODO:  is a serial run...
 361       CALL ESMF_VMGet(vm, petCount=numprocs, localPet=myPE, rc=rc)
 362       IF ( rc /= ESMF_SUCCESS ) THEN
 363         WRITE( msg,* ) 'Error in ESMF_VMGet', &
 364                        __FILE__ ,             &
 365                        ', line',              &
 366                        __LINE__
 367         CALL wrf_error_fatal ( msg )
 368       ENDIF
 369       ALLOCATE( ipatchStarts(0:numprocs-1), jpatchStarts(0:numprocs-1) )
 370       CALL GatherIntegerScalars_ESMF(PatchStart(1), myPE, numprocs, ipatchStarts)
 371       CALL GatherIntegerScalars_ESMF(PatchStart(2), myPE, numprocs, jpatchStarts)
 372       numprocsX = 0
 373       numprocsY = 0
 374       DO pe = 0, numprocs-1
 375         IF ( PatchStart(1) == ipatchStarts(pe) ) THEN
 376           numprocsY = numprocsY + 1
 377         ENDIF
 378         IF ( PatchStart(2) == jpatchStarts(pe) ) THEN
 379           numprocsX = numprocsX + 1
 380         ENDIF
 381       ENDDO
 382       DEALLOCATE( ipatchStarts, jpatchStarts )
 383 WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numprocsX = ',numprocsX
 384 CALL wrf_debug ( 5 , TRIM(msg) )
 385 WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numprocsY = ',numprocsY
 386 CALL wrf_debug ( 5 , TRIM(msg) )
 387       ! sanity check
 388       IF ( numprocs /= numprocsX*numprocsY ) THEN
 389         CALL wrf_error_fatal ( 'ASSERTION FAILED:  numprocs /= numprocsX*numprocsY' )
 390       ENDIF
 391       ! Next, create ESMF_DELayout
 392       numprocsXY = (/ numprocsX, numprocsY /)
 393 !TODO:  1-to-1 DE to PET mapping is assumed below...
 394       ALLOCATE( permuteTasks(0:numprocs-1) )
 395       pe = 0
 396       DO j = 0, numprocsY-1
 397         DO i = 0, numprocsX-1
 398 ! NOTE:  seems to work both ways...
 399 ! (/ 0 2 1 3 /)
 400 !        permuteTasks(pe) = (i*numprocsY) + j
 401 ! (/ 0 1 2 3 /)
 402         permuteTasks(pe) = pe
 403         pe = pe + 1
 404         ENDDO
 405       ENDDO
 406       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  numprocsXY = ',numprocsXY
 407       CALL wrf_debug ( 5 , TRIM(msg) )
 408       WRITE( msg,* ) 'DEBUG ioesmf_create_grid_int:  permuteTasks = ',permuteTasks
 409       CALL wrf_debug ( 5 , TRIM(msg) )
 410       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutCreate' )
 411       taskLayout = ESMF_DELayoutCreate( vm, numprocsXY, petList=permuteTasks, rc=rc )
 412       IF ( rc /= ESMF_SUCCESS ) THEN
 413         WRITE( msg,* ) 'Error in ESMF_DELayoutCreate', &
 414                        __FILE__ ,                      &
 415                        ', line',                       &
 416                        __LINE__
 417         CALL wrf_error_fatal ( msg )
 418       ENDIF
 419       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutCreate' )
 420       DEALLOCATE( permuteTasks )
 421
 422       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 1' )
 423       IF ( 5 .LE. debug_level ) THEN
 424         CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
 425       ENDIF
 426       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 1' )
 427
 428 ! Compute the dimensions for the ESMF grid, using WRF's non-staggered dimensions
 429 ! This is as of ESMF v3, JM 20080715
 430
 431       ! the [ij][dp][se] bits are for convenience...
 432       ids = DomainStart(1); ide = DomainEnd(1);
 433       jds = DomainStart(2); jde = DomainEnd(2);
 434       ips = PatchStart(1);  ipe = PatchEnd(1);
 435       jps = PatchStart(2);  jpe = PatchEnd(2);
 436       globalXcount = ide - ids  ! in other words, the number of points from ids to ide-1 inclusive
 437       globalYcount = jde - jds  ! in other words, the number of points from jds to jde-1 inclusive
 438       ! task-local numbers of points in patch for staggered arrays
 439       myXstart = ips
 440       myYstart = jps
 441       myXend = MIN(ipe,ide-1)
 442       myYend = MIN(jpe,jde-1)
 443       myXcount = myXend - myXstart + 1
 444       myYcount = myYend - myYstart + 1
 445       ! gather task-local information on all tasks since
 446       ! ESMF_GridDistribute[Block] interface require global knowledge to set up
 447       ! decompositions
 448       ! Recall that coordX and coordY are coordinates of *vertices*, not cell centers.
 449       ! Thus they must be 1 bigger than the number of cells.
 450       ALLOCATE( allXStart(0:numprocs-1),  allXCount(0:numprocs-1),  &
 451                 allYStart(0:numprocs-1),  allYCount(0:numprocs-1),  &
 452                 dimXCount(0:numprocsX-1), dimYCount(0:numprocsY-1), &
 453                 coordX(globalXcount+1),   coordY(globalYcount+1) )
 454       CALL GatherIntegerScalars_ESMF(myXcount, myPE, numprocs, allXCount)
 455       CALL GatherIntegerScalars_ESMF(myXstart, myPE, numprocs, allXStart)
 456       CALL GatherIntegerScalars_ESMF(myYcount, myPE, numprocs, allYCount)
 457       CALL GatherIntegerScalars_ESMF(myYstart, myPE, numprocs, allYStart)
 458
 459       !TODO:  ESMF 2.x does not support mercator, polar-stereographic, or
 460       !TODO:  lambert-conformal projections.  Therefore, we're using fake
 461       !TODO:  coordinates here.  This means that WRF will either have to
 462       !TODO:  couple to models that run on the same coorindate such that
 463       !TODO:  grid points are co-located or something else will have to
 464       !TODO:  perform the inter-grid interpolation computations.  Replace
 465       !TODO:  this once ESMF is upgraded to support the above map
 466       !TODO:  projections (via general curvilinear coordinates).
 467       CALL wrf_message( 'WARNING:  Using artificial coordinates for ESMF coupling.' )
 468       CALL wrf_message( 'WARNING:  ESMF coupling interpolation will be incorrect' )
 469       CALL wrf_message( 'WARNING:  unless grid points in the coupled components' )
 470       CALL wrf_message( 'WARNING:  are co-located.  This limitation will be removed' )
 471       CALL wrf_message( 'WARNING:  once ESMF coupling supports generalized' )
 472       CALL wrf_message( 'WARNING:  curvilinear coordintates needed to represent' )
 473       CALL wrf_message( 'WARNING:  common map projections used by WRF and other' )
 474       CALL wrf_message( 'WARNING:  regional models.' )
 475       ! Note that ESMF defines coordinates at *vertices*
 476       coordX(1) = 0.0
 477       DO i = 2, SIZE(coordX)
 478         coordX(i) = coordX(i-1) + 1.0
 479       ENDDO
 480       coordY(1) = 0.0
 481       DO j = 2, SIZE(coordY)
 482         coordY(j) = coordY(j-1) + 1.0
 483       ENDDO
 484       ! Create an ESMF_Grid
 485       ! For now we create only a 2D grid suitable for simple coupling of 2D
 486       ! surface fields.  Later, create and subset one or more 3D grids.
 487 !TODO:  Pass staggering info into this routine once ESMF can support staggered
 488 !TODO:  grids.  For now, it is hard-coded for WRF-ARW.
 489       gridID = gridID + 1
 490       WRITE ( gridname,'(a,i0)' ) 'WRF_grid_', gridID
 491
 492 CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridCreate' )
 493 WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordX) = ', SIZE(coordX)
 494 CALL wrf_debug ( 5 , TRIM(msg) )
 495 WRITE( msg,* ) 'DEBUG WRF:  SIZE(coordY) = ', SIZE(coordY)
 496 CALL wrf_debug ( 5 , TRIM(msg) )
 497 DO i = 1, SIZE(coordX)
 498   WRITE( msg,* ) 'DEBUG WRF:  coord1(',i,') = ', coordX(i)
 499   CALL wrf_debug ( 5 , TRIM(msg) )
 500 ENDDO
 501 DO j = 1, SIZE(coordY)
 502   WRITE( msg,* ) 'DEBUG WRF:  coord2(',j,') = ', coordY(j)
 503   CALL wrf_debug ( 5 , TRIM(msg) )
 504 ENDDO
 505 !WRITE( msg,* ) 'DEBUG WRF:  horzstagger = ', ESMF_GRID_HORZ_STAGGER_C_SW
 506 !CALL wrf_debug ( 5 , TRIM(msg) )
 507 WRITE( msg,* ) 'DEBUG WRF:  name = ', TRIM(gridname)
 508 CALL wrf_debug ( 5 , TRIM(msg) )
 509
 510       ! distribute the ESMF_Grid
 511       ! ignore repeated values
 512       is_min = MINVAL(allXStart)
 513       js_min = MINVAL(allYStart)
 514       i = 0
 515       j = 0
 516       WRITE( msg,* ) 'DEBUG:  is_min = ',is_min,'  allXStart = ',allXStart
 517       CALL wrf_debug ( 5 , TRIM(msg) )
 518       WRITE( msg,* ) 'DEBUG:  js_min = ',js_min,'  allYStart = ',allYStart
 519       CALL wrf_debug ( 5 , TRIM(msg) )
 520       WRITE( msg,* ) 'DEBUG:  allXCount = ',allXCount
 521       CALL wrf_debug ( 5 , TRIM(msg) )
 522       WRITE( msg,* ) 'DEBUG:  allYCount = ',allYCount
 523       CALL wrf_debug ( 5 , TRIM(msg) )
 524       DO pe = 0, numprocs-1
 525         IF (allXStart(pe) == is_min) THEN
 526           IF (j >= numprocsY) THEN
 527             WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreate', &
 528                            __FILE__ ,                                   &
 529                            ', line',                                    &
 530                            __LINE__
 531             CALL wrf_error_fatal ( msg )
 532           ENDIF
 533       WRITE( msg,* ) 'DEBUG:  dimYCount(',j,') == allYCount(',pe,')'
 534       CALL wrf_debug ( 5 , TRIM(msg) )
 535           dimYCount(j) = allYCount(pe)
 536           j = j + 1
 537         ENDIF
 538         IF (allYStart(pe) == js_min) THEN
 539           IF (i >= numprocsX) THEN
 540             WRITE( msg,* ) 'ASSERTION FAILED in ESMF_GridCreate', &
 541                            __FILE__ ,                                   &
 542                            ', line',                                    &
 543                            __LINE__
 544             CALL wrf_error_fatal ( msg )
 545           ENDIF
 546       WRITE( msg,* ) 'DEBUG:  dimXCount(',i,') == allXCount(',pe,')'
 547       CALL wrf_debug ( 5 , TRIM(msg) )
 548           dimXCount(i) = allXCount(pe)
 549           i = i + 1
 550         ENDIF
 551       ENDDO
 552       WRITE( msg,* ) 'DEBUG:  i = ',i,'  dimXCount = ',dimXCount
 553       CALL wrf_debug ( 5 , TRIM(msg) )
 554       WRITE( msg,* ) 'DEBUG:  j = ',j,'  dimYCount = ',dimYCount
 555       CALL wrf_debug ( 5 , TRIM(msg) )
 556
 557 #if 0
 558       esmfgrid = ESMF_GridCreateHorzXY(                     &
 559                    coord1=coordX, coord2=coordY,            &
 560                    horzstagger=ESMF_GRID_HORZ_STAGGER_C_SW, &
 561 !TODO:  use this for 3D Grids once it is stable
 562 !                  coordorder=ESMF_COORD_ORDER_XZY,         &
 563                    name=TRIM(gridname), rc=rc )
 564 #else
 565 ! based on example in 3.1 ref man sec 23.2.5, Creating an Irregularly
 566 ! Distributed Rectilinear Grid with a Non-Distributed Vertical Dimension
 567       !esmfgrid = ESMF_GridCreateShapeTile(  &
 568 !write(0,*)'calling ESMF_GridCreateShapeTile for grid named ',trim(gridname)
 569 !write(0,*)'calling ESMF_GridCreateShapeTile dimXCount ',dimXCount
 570 !write(0,*)'calling ESMF_GridCreateShapeTile dimYCount ',dimYCount
 571 ! 5.2.0r      esmfgrid = ESMF_GridCreateShapeTile(  &
 572       esmfgrid = ESMF_GridCreate(  &
 573                  countsPerDEDim1=dimXCount , &
 574                  countsPerDEDim2=dimYcount , &
 575                  coordDep1=(/1/) , &
 576                  coordDep2=(/2/) , &
 577                  indexflag=ESMF_INDEX_GLOBAL, & ! use global indices
 578                  name=TRIM(gridname), &
 579                  rc = rc )
 580
 581       CALL ESMF_GridAddCoord(esmfgrid, &
 582                  staggerloc=ESMF_STAGGERLOC_CENTER, &
 583                  rc=rc)
 584
 585
 586       CALL ESMF_GridGetCoord(esmfgrid,coordDim=1,localDE=0, &
 587                  staggerloc=ESMF_STAGGERLOC_CENTER, &
 588                  computationalLBound=lbnd,computationalUBound=ubnd, &
 589                  farrayptr=coordX2d, &
 590                  rc=rc)
 591
 592       DO i=lbnd(1),ubnd(1)
 593         coordX2d(i) = (i-1)*1.0
 594       ENDDO
 595       CALL ESMF_GridGetCoord(esmfgrid,coordDim=2,localDE=0, &
 596                  staggerloc=ESMF_STAGGERLOC_CENTER, &
 597                  computationalLBound=lbnd,computationalUBound=ubnd, &
 598                  farrayptr=coordY2d,                             &
 599                  rc=rc)
 600       DO i=lbnd(1),ubnd(1)
 601         coordY2d(i) = (i-1)*1.0
 602       ENDDO
 603
 604
 605 #endif
 606       IF ( rc /= ESMF_SUCCESS ) THEN
 607         WRITE( msg,* ) 'Error in ESMF_GridCreate', &
 608                        __FILE__ ,                        &
 609                        ', line',                         &
 610                        __LINE__
 611         CALL wrf_error_fatal ( msg )
 612       ENDIF
 613 CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridCreate' )
 614
 615       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  calling ESMF_DELayoutPrint 2' )
 616       IF ( 5 .LE. debug_level ) THEN
 617         CALL ESMF_DELayoutPrint( taskLayout, rc=rc )
 618       ENDIF
 619       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  back from ESMF_DELayoutPrint 2' )
 620
 621 #if 0
 622       CALL ESMF_GridDistribute( esmfgrid,                  &
 623                                 delayout=taskLayout,       &
 624                                 countsPerDEDim1=dimXCount, &
 625                                 countsPerDEDim2=dimYCount, &
 626                                 rc=rc )
 627       IF ( rc /= ESMF_SUCCESS ) THEN
 628         WRITE( msg,* ) 'Error in ESMF_GridDistribute ', &
 629                        __FILE__ ,                       &
 630                        ', line ',                       &
 631                        __LINE__ ,                       &
 632                        ', error code = ',rc
 633         CALL wrf_error_fatal ( msg )
 634       ENDIF
 635 #endif
 636 CALL wrf_debug ( 5 , 'DEBUG WRF:  Calling ESMF_GridValidate()' )
 637       CALL ESMF_GridValidate( esmfgrid, rc=rc )
 638       IF ( rc /= ESMF_SUCCESS ) THEN
 639         WRITE( msg,* ) 'Error in ESMF_GridValidate ',   &
 640                        __FILE__ ,                       &
 641                        ', line ',                       &
 642                        __LINE__ ,                       &
 643                        ', error code = ',rc
 644         CALL wrf_error_fatal ( msg )
 645       ENDIF
 646
 647 CALL wrf_debug ( 5 , 'DEBUG WRF:  back OK from ESMF_GridValidate()' )
 648       DEALLOCATE( allXStart, allXCount, allYStart, allYCount, &
 649                   dimXCount, dimYCount, coordX, coordY )
 650
 651 #if 0
 652       ! Print out the ESMF decomposition info for debug comparison with WRF
 653       ! decomposition info.
 654       ALLOCATE( cellCounts(0:numprocs-1,2), globalStarts(0:numprocs-1,2) )
 655
 656       ! extract information about staggered grids for debugging
 657       CALL ESMF_GridGet( esmfgrid,                               &
 658                          horzrelloc=ESMF_CELL_WFACE,             &
 659                          globalStartPerDEPerDim=globalStarts,    &
 660                          cellCountPerDEPerDim=cellCounts,        &
 661                          globalCellCountPerDim=globalCellCounts, &
 662                          rc=rc )
 663       IF ( rc /= ESMF_SUCCESS ) THEN
 664         WRITE( msg,* ) 'Error in ESMF_GridGet', &
 665                        __FILE__ ,               &
 666                        ', line',                &
 667                        __LINE__
 668         CALL wrf_error_fatal ( msg )
 669       ENDIF
 670 ! note that global indices in ESMF_Grid always start at zero
 671       WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ips = ',1+globalStarts(myPE,1)
 672       CALL wrf_debug ( 5 , TRIM(msg) )
 673       WRITE( msg,* ) 'DEBUG:  ESMF     staggered     ipe = ',1+globalStarts(myPE,1) + cellCounts(myPE,1) - 1
 674       CALL wrf_debug ( 5 , TRIM(msg) )
 675       WRITE( msg,* ) 'DEBUG:  ESMF     staggered i count = ',  cellCounts(myPE,1)
 676       CALL wrf_debug ( 5 , TRIM(msg) )
 677       CALL ESMF_GridGet( esmfgrid,                               &
 678                          horzrelloc=ESMF_CELL_SFACE,             &
 679                          globalStartPerDEPerDim=globalStarts,    &
 680                          cellCountPerDEPerDim=cellCounts,        &
 681                          globalCellCountPerDim=globalCellCounts, &
 682                          rc=rc )
 683       IF ( rc /= ESMF_SUCCESS ) THEN
 684         WRITE( msg,* ) 'Error in ESMF_GridGet', &
 685                        __FILE__ ,               &
 686                        ', line',                &
 687                        __LINE__
 688         CALL wrf_error_fatal ( msg )
 689       ENDIF
 690 ! note that global indices in ESMF_Grid always start at zero
 691       WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jps = ',1+globalStarts(myPE,2)
 692       CALL wrf_debug ( 5 , TRIM(msg) )
 693       WRITE( msg,* ) 'DEBUG:  ESMF     staggered     jpe = ',1+globalStarts(myPE,2) + cellCounts(myPE,2) - 1
 694       CALL wrf_debug ( 5 , TRIM(msg) )
 695       WRITE( msg,* ) 'DEBUG:  ESMF     staggered j count = ',  cellCounts(myPE,2)
 696       CALL wrf_debug ( 5 , TRIM(msg) )
 697
 698       DEALLOCATE( cellCounts, globalStarts )
 699
 700       CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid BEGIN...' )
 701       IF ( 100 .LE. debug_level ) THEN
 702         CALL ESMF_GridPrint( esmfgrid, rc=rc )
 703         IF ( rc /= ESMF_SUCCESS ) THEN
 704           WRITE( msg,* ) 'Error in ESMF_GridPrint', &
 705                          __FILE__ ,                        &
 706                          ', line',                         &
 707                          __LINE__
 708           CALL wrf_error_fatal ( msg )
 709         ENDIF
 710       ENDIF
 711       CALL wrf_debug ( 100 , 'DEBUG ioesmf_create_grid_int:  print esmfgrid END' )
 712
 713 #endif
 714       CALL wrf_debug ( 5 , 'DEBUG ioesmf_create_grid_int:  returning...' )
 715
 716   END SUBROUTINE ioesmf_create_grid_int
 717
 718
 719
 720   ! Destroy the ESMF_Grid associated with index DataHandle.
 721   ! grid( DataHandle )%ptr is DEALLOCATED (NULLIFIED)
 722   SUBROUTINE ioesmf_destroy_grid( DataHandle )
 723     USE module_ext_esmf
 724     IMPLICIT NONE
 725     INTEGER, INTENT(IN   ) :: DataHandle
 726     ! Local declarations
 727     INTEGER :: id, rc
 728     TYPE(ESMF_DELayout) :: taskLayout
 729     LOGICAL :: noneLeft
 730     IF ( grid( DataHandle )%in_use ) THEN
 731 #if 0
 732 WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) begin...'
 733 CALL wrf_debug ( 5 , TRIM(msg) )
 734       CALL ESMF_GridGet( grid( DataHandle )%ptr, delayout=taskLayout, rc=rc )
 735       IF ( rc /= ESMF_SUCCESS ) THEN
 736         WRITE( msg,* ) 'Error in ESMF_GridGet', &
 737                        __FILE__ ,               &
 738                        ', line',                &
 739                        __LINE__
 740         CALL wrf_error_fatal ( msg )
 741       ENDIF
 742       ! I "know" I created this...  (not really, but ESMF cannot tell me!)
 743       CALL ESMF_DELayoutDestroy( taskLayout, rc=rc )
 744       IF ( rc /= ESMF_SUCCESS ) THEN
 745         WRITE( msg,* ) 'Error in ESMF_DELayoutDestroy', &
 746                        __FILE__ ,                       &
 747                        ', line',                        &
 748                        __LINE__
 749         CALL wrf_error_fatal ( msg )
 750       ENDIF
 751 #endif
 752       CALL ESMF_GridDestroy( grid( DataHandle )%ptr, rc=rc )
 753       IF ( rc /= ESMF_SUCCESS ) THEN
 754         WRITE( msg,* ) 'Error in ESMF_GridDestroy', &
 755                        __FILE__ ,                   &
 756                        ', line',                    &
 757                        __LINE__
 758         CALL wrf_error_fatal ( msg )
 759       ENDIF
 760       DEALLOCATE( grid( DataHandle )%ptr )
 761       CALL ioesmf_nullify_grid( DataHandle )
 762 WRITE( msg,* ) 'DEBUG:  ioesmf_destroy_grid( ',DataHandle,' ) end'
 763 CALL wrf_debug ( 5 , TRIM(msg) )
 764     ENDIF
 765
 766   END SUBROUTINE ioesmf_destroy_grid
 767
 768
 769   ! Nullify the grid_ptr associated with index DataHandle.
 770   ! grid( DataHandle )%ptr must not be associated
 771   ! DataHandle must be in a valid range
 772   SUBROUTINE ioesmf_nullify_grid( DataHandle )
 773     USE module_ext_esmf
 774     IMPLICIT NONE
 775     INTEGER, INTENT(IN   ) :: DataHandle
 776     NULLIFY( grid( DataHandle )%ptr )
 777     grid( DataHandle )%in_use = .FALSE.
 778     grid( DataHandle )%ide_save = 0
 779     grid( DataHandle )%jde_save = 0
 780     grid( DataHandle )%kde_save = 0
 781   END SUBROUTINE ioesmf_nullify_grid
 782
 783
 784 !TODO:  use generic explicit interfaces and remove duplication
 785 !TODO:  use cpp to remove duplication
 786  SUBROUTINE ioesmf_extract_data_real( data_esmf_real, Field,      &
 787                                       ips, ipe, jps, jpe, kps, kpe, &
 788                                       ims, ime, jms, jme, kms, kme )
 789    USE module_ext_esmf
 790    IMPLICIT NONE
 791    INTEGER,            INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 792    INTEGER,            INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 793    REAL(ESMF_KIND_R4), INTENT(IN   ) :: data_esmf_real( ips:ipe, jps:jpe )
 794    REAL,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
 795    Field( ips:ipe, jps:jpe, kms ) = data_esmf_real( ips:ipe, jps:jpe )
 796  END SUBROUTINE ioesmf_extract_data_real
 797
 798
 799 !TODO:  use cpp to remove duplication
 800  SUBROUTINE ioesmf_extract_data_int( data_esmf_int, Field,         &
 801                                      ips, ipe, jps, jpe, kps, kpe, &
 802                                      ims, ime, jms, jme, kms, kme )
 803    USE module_ext_esmf
 804    IMPLICIT NONE
 805    INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 806    INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 807    INTEGER(ESMF_KIND_I4), INTENT(IN   ) :: data_esmf_int( ips:ipe, jps:jpe )
 808    INTEGER,               INTENT(  OUT) :: Field( ims:ime, jms:jme, kms:kme )
 809    Field( ips:ipe, jps:jpe, kms ) = data_esmf_int( ips:ipe, jps:jpe )
 810  END SUBROUTINE ioesmf_extract_data_int
 811
 812
 813 !TODO:  use cpp to remove duplication
 814  SUBROUTINE ioesmf_insert_data_real( Field, data_esmf_real,        &
 815                                      ips, ipe, jps, jpe, kps, kpe, &
 816                                      ims, ime, jms, jme, kms, kme )
 817    USE module_ext_esmf
 818    IMPLICIT NONE
 819    INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 820    INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 821    REAL,                  INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
 822    REAL(ESMF_KIND_R4),    INTENT(  OUT) :: data_esmf_real( ips:ipe, jps:jpe )
 823    !TODO:  Remove this hack once we no longer have to store non-staggered
 824    !TODO:  arrays in space dimensioned for staggered arrays.
 825    data_esmf_real = 0.0_ESMF_KIND_R4
 826    data_esmf_real( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
 827  END SUBROUTINE ioesmf_insert_data_real
 828
 829
 830 !TODO:  use cpp to remove duplication
 831  SUBROUTINE ioesmf_insert_data_int( Field, data_esmf_int,         &
 832                                     ips, ipe, jps, jpe, kps, kpe, &
 833                                     ims, ime, jms, jme, kms, kme )
 834    USE module_ext_esmf
 835    IMPLICIT NONE
 836    INTEGER,               INTENT(IN   ) :: ips, ipe, jps, jpe, kps, kpe
 837    INTEGER,               INTENT(IN   ) :: ims, ime, jms, jme, kms, kme
 838    INTEGER,               INTENT(IN   ) :: Field( ims:ime, jms:jme, kms:kme )
 839    INTEGER(ESMF_KIND_I4), INTENT(  OUT) :: data_esmf_int( ips:ipe, jps:jpe )
 840    !TODO:  Remove this hack once we no longer have to store non-staggered
 841    !TODO:  arrays in space dimensioned for staggered arrays.
 842    data_esmf_int = 0.0_ESMF_KIND_I4
 843    data_esmf_int( ips:ipe, jps:jpe ) = Field( ips:ipe, jps:jpe, kms )
 844  END SUBROUTINE ioesmf_insert_data_int
 845
 846
 847 !--------------
 848
 849 SUBROUTINE ext_esmf_ioinit( SysDepInfo, Status )
 850   USE module_ext_esmf
 851   IMPLICIT NONE
 852   CHARACTER*(*), INTENT(IN) :: SysDepInfo
 853   INTEGER Status
 854   CALL init_module_ext_esmf
 855   Status = 0
 856 END SUBROUTINE ext_esmf_ioinit
 857
 858 !--- open_for_read
 859 SUBROUTINE ext_esmf_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
 860                                     DataHandle , Status )
 861   USE module_ext_esmf
 862   IMPLICIT NONE
 863   CHARACTER*(*) :: FileName
 864   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
 865   CHARACTER*(*) :: SysDepInfo
 866   INTEGER ,       INTENT(OUT) :: DataHandle
 867   INTEGER ,       INTENT(OUT) :: Status
 868   CALL wrf_debug(1,'ext_esmf_open_for_read not supported yet')
 869   Status = WRF_WARN_NOTSUPPORTED
 870   RETURN
 871 END SUBROUTINE ext_esmf_open_for_read
 872
 873
 874 !--- inquire_opened
 875 SUBROUTINE ext_esmf_inquire_opened ( DataHandle, FileName , FileStatus, Status )
 876   USE module_ext_esmf
 877   IMPLICIT NONE
 878   INTEGER ,       INTENT(IN)  :: DataHandle
 879   CHARACTER*(*) :: FileName
 880   INTEGER ,       INTENT(OUT) :: FileStatus
 881   INTEGER ,       INTENT(OUT) :: Status
 882
 883   Status = 0
 884
 885   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  begin, DataHandle = ', DataHandle
 886   CALL wrf_debug ( 5 , TRIM(msg) )
 887   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_valid_handle(',DataHandle,') = ', &
 888                  int_valid_handle( DataHandle )
 889   CALL wrf_debug ( 5 , TRIM(msg) )
 890   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  int_handle_in_use(',DataHandle,') = ', &
 891                  int_handle_in_use( DataHandle )
 892   CALL wrf_debug ( 5 , TRIM(msg) )
 893   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_read(',DataHandle,') = ', &
 894                  opened_for_read( DataHandle )
 895   CALL wrf_debug ( 5 , TRIM(msg) )
 896   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_read(',DataHandle,') = ', &
 897                  okay_to_read( DataHandle )
 898   CALL wrf_debug ( 5 , TRIM(msg) )
 899   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  opened_for_write(',DataHandle,') = ', &
 900                  opened_for_write( DataHandle )
 901   CALL wrf_debug ( 5 , TRIM(msg) )
 902   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  okay_to_write(',DataHandle,') = ', &
 903                  okay_to_write( DataHandle )
 904   CALL wrf_debug ( 5 , TRIM(msg) )
 905
 906 !TODO:  need to cache file name and match with FileName argument and return
 907 !TODO:  FileStatus = WRF_FILE_NOT_OPENED if they do not match
 908
 909   FileStatus = WRF_FILE_NOT_OPENED
 910   IF ( int_valid_handle( DataHandle ) ) THEN
 911     IF ( int_handle_in_use( DataHandle ) ) THEN
 912       IF ( opened_for_read ( DataHandle ) ) THEN
 913         IF ( okay_to_read( DataHandle ) ) THEN
 914            FileStatus = WRF_FILE_OPENED_FOR_READ
 915         ELSE
 916            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 917         ENDIF
 918       ELSE IF ( opened_for_write( DataHandle ) ) THEN
 919         IF ( okay_to_write( DataHandle ) ) THEN
 920            FileStatus = WRF_FILE_OPENED_FOR_WRITE
 921         ELSE
 922            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 923         ENDIF
 924       ELSE
 925         FileStatus = WRF_FILE_NOT_OPENED
 926       ENDIF
 927     ENDIF
 928     WRITE( msg,* ) 'ERROR ext_esmf_inquire_opened:  file handle ',DataHandle,' is invalid'
 929     CALL wrf_error_fatal ( TRIM(msg) )
 930   ENDIF
 931
 932   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_opened:  end, FileStatus = ', FileStatus
 933   CALL wrf_debug ( 5 , TRIM(msg) )
 934
 935   Status = 0
 936
 937   RETURN
 938 END SUBROUTINE ext_esmf_inquire_opened
 939
 940 !--- inquire_filename
 941 SUBROUTINE ext_esmf_inquire_filename ( DataHandle, FileName , FileStatus, Status )
 942   USE module_ext_esmf
 943   IMPLICIT NONE
 944   INTEGER ,       INTENT(IN)  :: DataHandle
 945   CHARACTER*(*) :: FileName
 946   INTEGER ,       INTENT(OUT) :: FileStatus
 947   INTEGER ,       INTENT(OUT) :: Status
 948   CHARACTER *80   SysDepInfo
 949   Status = 0
 950
 951   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  begin, DataHandle = ', DataHandle
 952   CALL wrf_debug ( 5 , TRIM(msg) )
 953   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_valid_handle(',DataHandle,') = ', &
 954                  int_valid_handle( DataHandle )
 955   CALL wrf_debug ( 5 , TRIM(msg) )
 956   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  int_handle_in_use(',DataHandle,') = ', &
 957                  int_handle_in_use( DataHandle )
 958   CALL wrf_debug ( 5 , TRIM(msg) )
 959   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_read(',DataHandle,') = ', &
 960                  opened_for_read( DataHandle )
 961   CALL wrf_debug ( 5 , TRIM(msg) )
 962   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_read(',DataHandle,') = ', &
 963                  okay_to_read( DataHandle )
 964   CALL wrf_debug ( 5 , TRIM(msg) )
 965   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  opened_for_write(',DataHandle,') = ', &
 966                  opened_for_write( DataHandle )
 967   CALL wrf_debug ( 5 , TRIM(msg) )
 968   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  okay_to_write(',DataHandle,') = ', &
 969                  okay_to_write( DataHandle )
 970   CALL wrf_debug ( 5 , TRIM(msg) )
 971
 972 !TODO:  need to cache file name and return via FileName argument
 973
 974   FileStatus = WRF_FILE_NOT_OPENED
 975   IF ( int_valid_handle( DataHandle ) ) THEN
 976     IF ( int_handle_in_use( DataHandle ) ) THEN
 977       IF ( opened_for_read ( DataHandle ) ) THEN
 978         IF ( okay_to_read( DataHandle ) ) THEN
 979            FileStatus = WRF_FILE_OPENED_FOR_READ
 980         ELSE
 981            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 982         ENDIF
 983       ELSE IF ( opened_for_write( DataHandle ) ) THEN
 984         IF ( okay_to_write( DataHandle ) ) THEN
 985            FileStatus = WRF_FILE_OPENED_FOR_WRITE
 986         ELSE
 987            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 988         ENDIF
 989       ELSE
 990         FileStatus = WRF_FILE_NOT_OPENED
 991       ENDIF
 992     ENDIF
 993     WRITE( msg,* ) 'ERROR ext_esmf_inquire_filename:  file handle ',DataHandle,' is invalid'
 994     CALL wrf_error_fatal ( TRIM(msg) )
 995   ENDIF
 996
 997   WRITE( msg,* ) 'DEBUG ext_esmf_inquire_filename:  end, FileStatus = ', FileStatus
 998   CALL wrf_debug ( 5 , TRIM(msg) )
 999
1000   Status = 0
1001   RETURN
1002 END SUBROUTINE ext_esmf_inquire_filename
1003
1004 !--- sync
1005 SUBROUTINE ext_esmf_iosync ( DataHandle, Status )
1006   USE module_ext_esmf
1007   IMPLICIT NONE
1008   INTEGER ,       INTENT(IN)  :: DataHandle
1009   INTEGER ,       INTENT(OUT) :: Status
1010   Status = 0
1011   RETURN
1012 END SUBROUTINE ext_esmf_iosync
1013
1014 !--- close
1015 SUBROUTINE ext_esmf_ioclose ( DataHandle, Status )
1016   USE module_ext_esmf
1017   IMPLICIT NONE
1018   INTEGER DataHandle, Status
1019   ! locals
1020   TYPE state_ptr
1021     TYPE(ESMF_State), POINTER :: stateptr
1022   END TYPE state_ptr
1023   TYPE(state_ptr) :: states(2)
1024   TYPE(ESMF_State), POINTER :: state
1025   INTEGER :: numItems, numFields, i, istate
1026   TYPE(ESMF_StateItem_Flag), ALLOCATABLE :: itemTypes(:)
1027   TYPE(ESMF_Field) :: tmpField
1028   REAL, POINTER :: tmp_ptr(:,:)
1029   CHARACTER (len=ESMF_MAXSTR), ALLOCATABLE :: itemNames(:)
1030   CHARACTER (len=ESMF_MAXSTR) :: str
1031   INTEGER :: rc
1032
1033 ! TODO:  The code below hangs with this error message:
1034 ! TODO:  "ext_esmf_ioclose:  ESMF_FieldGetDataPointer( LANDMASK) failed"
1035 ! TODO:  Fix this so ESMF objects actually get destroyed to avoid memory
1036 ! TODO:  leaks.
1037   CALL wrf_debug( 5, 'ext_esmf_ioclose:  WARNING:  not destroying ESMF objects' )
1038 #if 0
1039   !TODO:  Need to upgrade this to use nested ESMF_States if we want support
1040   !TODO:  more than one auxin and one auxhist stream for ESMF.
1041   IF ( int_valid_handle (DataHandle) ) THEN
1042     IF ( int_handle_in_use( DataHandle ) ) THEN
1043       ! Iterate through importState *and* exportState, find each ESMF_Field,
1044       ! extract its data pointer and deallocate it, then destroy the
1045       ! ESMF_Field.
1046       CALL ESMF_ImportStateGetCurrent(states(1)%stateptr, rc)
1047       IF ( rc /= ESMF_SUCCESS ) THEN
1048         CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ImportStateGetCurrent failed' )
1049       ENDIF
1050       CALL ESMF_ExportStateGetCurrent(states(2)%stateptr, rc)
1051       IF ( rc /= ESMF_SUCCESS ) THEN
1052         CALL wrf_error_fatal( 'ext_esmf_ioclose:  ESMF_ExportStateGetCurrent failed' )
1053       ENDIF
1054       DO istate=1, 2
1055         state => states(istate)%stateptr   ! all this to avoid assignment (@#$%)
1056         ! Since there are no convenient iterators for ESMF_State (@#$%),
1057         ! write a lot of code...
1058         ! Figure out how many items are in the ESMF_State
1059         CALL ESMF_StateGet(state, itemCount=numItems, rc=rc)
1060         IF ( rc /= ESMF_SUCCESS) THEN
1061           CALL wrf_error_fatal ( 'ext_esmf_ioclose:  ESMF_StateGet(numItems) failed' )
1062         ENDIF
1063         ! allocate an array to hold the types of all items
1064         ALLOCATE( itemTypes(numItems) )
1065         ! allocate an array to hold the names of all items
1066         ALLOCATE( itemNames(numItems) )
1067         ! get the item types and names
1068 !5.2.0r        CALL ESMF_StateGet(state, stateitemtypeList=itemTypes, &
1069         CALL ESMF_StateGet(state, itemtypeList=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
1124 END SUBROUTINE ext_esmf_ioclose
1125
1126 !--- ioexit
1127 SUBROUTINE 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
1149 END SUBROUTINE ext_esmf_ioexit
1150
1151 !--- get_next_time
1152 SUBROUTINE 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_debug(1, "ext_esmf_get_next_time() not supported yet")
1165   Status = WRF_WARN_NOTSUPPORTED
1166   RETURN
1167 END SUBROUTINE ext_esmf_get_next_time
1168
1169 !--- set_time
1170 SUBROUTINE 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_debug(1, "ext_esmf_set_time() not supported yet")
1177   Status = WRF_WARN_NOTSUPPORTED
1178   RETURN
1179 END SUBROUTINE ext_esmf_set_time
1180
1181 !--- get_var_info
1182 SUBROUTINE 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_debug(1, "ext_esmf_get_var_info() not supported yet")
1202   Status = WRF_WARN_NOTSUPPORTED
1203   RETURN
1204 END SUBROUTINE ext_esmf_get_var_info
1205
1206 !--- get_next_var
1207 SUBROUTINE 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_debug(1, "ext_esmf_get_next_var() not supported yet")
1221   Status = WRF_WARN_NOTSUPPORTED
1222   RETURN
1223 END SUBROUTINE ext_esmf_get_next_var
1224
1225 !--- get_dom_ti_real
1226 SUBROUTINE 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_debug(1, "ext_esmf_get_dom_ti_real() not supported yet")
1236   Status = WRF_WARN_NOTSUPPORTED
1237   RETURN
1238 END SUBROUTINE ext_esmf_get_dom_ti_real
1239
1240 !--- put_dom_ti_real
1241 SUBROUTINE 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_debug(1, "ext_esmf_put_dom_ti_real() not supported yet")
1250   Status = WRF_WARN_NOTSUPPORTED
1251   RETURN
1252 END SUBROUTINE ext_esmf_put_dom_ti_real
1253
1254 !--- get_dom_ti_double
1255 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_ti_double not supported yet')
1265   Status = WRF_WARN_NOTSUPPORTED
1266   RETURN
1267 END SUBROUTINE ext_esmf_get_dom_ti_double
1268
1269 !--- put_dom_ti_double
1270 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_ti_double not supported yet')
1279   Status = WRF_WARN_NOTSUPPORTED
1280   RETURN
1281 END SUBROUTINE ext_esmf_put_dom_ti_double
1282
1283 !--- get_dom_ti_integer
1284 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_ti_integer not fully supported yet')
1306     Status = WRF_WARN_NOTSUPPORTED
1307   ENDIF
1308
1309   RETURN
1310 END SUBROUTINE ext_esmf_get_dom_ti_integer
1311
1312 !--- put_dom_ti_integer
1313 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_ti_integer not supported yet')
1322   Status = WRF_WARN_NOTSUPPORTED
1323   RETURN
1324 END SUBROUTINE ext_esmf_put_dom_ti_integer
1325
1326 !--- get_dom_ti_logical
1327 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_ti_logical not supported yet')
1337   Status = WRF_WARN_NOTSUPPORTED
1338   RETURN
1339 END SUBROUTINE ext_esmf_get_dom_ti_logical
1340
1341 !--- put_dom_ti_logical
1342 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_ti_logical not supported yet')
1351   Status = WRF_WARN_NOTSUPPORTED
1352   RETURN
1353 END SUBROUTINE ext_esmf_put_dom_ti_logical
1354
1355 !--- get_dom_ti_char
1356 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_ti_char not supported yet')
1364   Status = WRF_WARN_NOTSUPPORTED
1365   RETURN
1366 END SUBROUTINE ext_esmf_get_dom_ti_char
1367
1368 !--- put_dom_ti_char
1369 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_ti_char not supported yet')
1377   Status = WRF_WARN_NOTSUPPORTED
1378   RETURN
1379 END SUBROUTINE ext_esmf_put_dom_ti_char
1380
1381 !--- get_dom_td_real
1382 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_td_real not supported yet')
1393   Status = WRF_WARN_NOTSUPPORTED
1394   RETURN
1395 END SUBROUTINE ext_esmf_get_dom_td_real
1396
1397 !--- put_dom_td_real
1398 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_td_real not supported yet')
1408   Status = WRF_WARN_NOTSUPPORTED
1409   RETURN
1410 END SUBROUTINE ext_esmf_put_dom_td_real
1411
1412 !--- get_dom_td_double
1413 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_td_double not supported yet')
1424   Status = WRF_WARN_NOTSUPPORTED
1425   RETURN
1426 END SUBROUTINE ext_esmf_get_dom_td_double
1427
1428 !--- put_dom_td_double
1429 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_td_double not supported yet')
1439   Status = WRF_WARN_NOTSUPPORTED
1440   RETURN
1441 END SUBROUTINE ext_esmf_put_dom_td_double
1442
1443 !--- get_dom_td_integer
1444 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_td_integer not supported yet')
1455   Status = WRF_WARN_NOTSUPPORTED
1456   RETURN
1457 END SUBROUTINE ext_esmf_get_dom_td_integer
1458
1459 !--- put_dom_td_integer
1460 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_td_integer not supported yet')
1470   Status = WRF_WARN_NOTSUPPORTED
1471   RETURN
1472 END SUBROUTINE ext_esmf_put_dom_td_integer
1473
1474 !--- get_dom_td_logical
1475 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_td_logical not supported yet')
1486   Status = WRF_WARN_NOTSUPPORTED
1487   RETURN
1488 END SUBROUTINE ext_esmf_get_dom_td_logical
1489
1490 !--- put_dom_td_logical
1491 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_td_logical not supported yet')
1501   Status = WRF_WARN_NOTSUPPORTED
1502   RETURN
1503 END SUBROUTINE ext_esmf_put_dom_td_logical
1504
1505 !--- get_dom_td_char
1506 SUBROUTINE 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_debug(1,'ext_esmf_get_dom_td_char not supported yet')
1515   Status = WRF_WARN_NOTSUPPORTED
1516   RETURN
1517 END SUBROUTINE ext_esmf_get_dom_td_char
1518
1519 !--- put_dom_td_char
1520 SUBROUTINE 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_debug(1,'ext_esmf_put_dom_td_char not supported yet')
1529   Status = WRF_WARN_NOTSUPPORTED
1530   RETURN
1531 END SUBROUTINE ext_esmf_put_dom_td_char
1532
1533 !--- get_var_ti_real
1534 SUBROUTINE 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_debug(1,'ext_esmf_get_var_ti_real not supported yet')
1545   Status = WRF_WARN_NOTSUPPORTED
1546   RETURN
1547 END SUBROUTINE ext_esmf_get_var_ti_real
1548
1549 !--- put_var_ti_real
1550 SUBROUTINE 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_debug(1,'ext_esmf_put_var_ti_real not supported yet')
1560   Status = WRF_WARN_NOTSUPPORTED
1561   RETURN
1562 END SUBROUTINE ext_esmf_put_var_ti_real
1563
1564 !--- get_var_ti_double
1565 SUBROUTINE 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_debug(1,'ext_esmf_get_var_ti_double not supported yet')
1576   Status = WRF_WARN_NOTSUPPORTED
1577   RETURN
1578 END SUBROUTINE ext_esmf_get_var_ti_double
1579
1580 !--- put_var_ti_double
1581 SUBROUTINE 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_debug(1,'ext_esmf_put_var_ti_double not supported yet')
1591   Status = WRF_WARN_NOTSUPPORTED
1592   RETURN
1593 END SUBROUTINE ext_esmf_put_var_ti_double
1594
1595 !--- get_var_ti_integer
1596 SUBROUTINE 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_debug(1,'ext_esmf_get_var_ti_integer not supported yet')
1607   Status = WRF_WARN_NOTSUPPORTED
1608   RETURN
1609 END SUBROUTINE ext_esmf_get_var_ti_integer
1610
1611 !--- put_var_ti_integer
1612 SUBROUTINE 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_debug(1,'ext_esmf_put_var_ti_integer not supported yet')
1622   Status = WRF_WARN_NOTSUPPORTED
1623   RETURN
1624 END SUBROUTINE ext_esmf_put_var_ti_integer
1625
1626 !--- get_var_ti_logical
1627 SUBROUTINE 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_debug(1,'ext_esmf_get_var_ti_logical not supported yet')
1638   Status = WRF_WARN_NOTSUPPORTED
1639   RETURN
1640 END SUBROUTINE ext_esmf_get_var_ti_logical
1641
1642 !--- put_var_ti_logical
1643 SUBROUTINE 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_debug(1,'ext_esmf_put_var_ti_logical not supported yet')
1653   Status = WRF_WARN_NOTSUPPORTED
1654   RETURN
1655 END SUBROUTINE ext_esmf_put_var_ti_logical
1656
1657 !--- get_var_ti_char
1658 SUBROUTINE 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_debug(1,'ext_esmf_get_var_ti_char not supported yet')
1669   Status = WRF_WARN_NOTSUPPORTED
1670   RETURN
1671 END SUBROUTINE ext_esmf_get_var_ti_char
1672
1673 !--- put_var_ti_char
1674 SUBROUTINE 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_debug(1,'ext_esmf_put_var_ti_char not supported yet')
1685   Status = WRF_WARN_NOTSUPPORTED
1686   RETURN
1687 END SUBROUTINE ext_esmf_put_var_ti_char
1688
1689 !--- get_var_td_real
1690 SUBROUTINE 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_debug(1,'ext_esmf_get_var_td_real not supported yet')
1702   Status = WRF_WARN_NOTSUPPORTED
1703   RETURN
1704 END SUBROUTINE ext_esmf_get_var_td_real
1705
1706 !--- put_var_td_real
1707 SUBROUTINE 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_debug(1,'ext_esmf_put_var_td_real not supported yet')
1718   Status = WRF_WARN_NOTSUPPORTED
1719   RETURN
1720 END SUBROUTINE ext_esmf_put_var_td_real
1721
1722 !--- get_var_td_double
1723 SUBROUTINE 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_debug(1,'ext_esmf_get_var_td_double not supported yet')
1735   Status = WRF_WARN_NOTSUPPORTED
1736   RETURN
1737 END SUBROUTINE ext_esmf_get_var_td_double
1738
1739 !--- put_var_td_double
1740 SUBROUTINE 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_debug(1,'ext_esmf_put_var_td_double not supported yet')
1751   Status = WRF_WARN_NOTSUPPORTED
1752   RETURN
1753 END SUBROUTINE ext_esmf_put_var_td_double
1754
1755 !--- get_var_td_integer
1756 SUBROUTINE 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_debug(1,'ext_esmf_get_var_td_integer not supported yet')
1768   Status = WRF_WARN_NOTSUPPORTED
1769   RETURN
1770 END SUBROUTINE ext_esmf_get_var_td_integer
1771
1772 !--- put_var_td_integer
1773 SUBROUTINE 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_debug(1,'ext_esmf_put_var_td_integer not supported yet')
1784   Status = WRF_WARN_NOTSUPPORTED
1785   RETURN
1786 END SUBROUTINE ext_esmf_put_var_td_integer
1787
1788 !--- get_var_td_logical
1789 SUBROUTINE 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_debug(1,'ext_esmf_get_var_td_logical not supported yet')
1801   Status = WRF_WARN_NOTSUPPORTED
1802   RETURN
1803 END SUBROUTINE ext_esmf_get_var_td_logical
1804
1805 !--- put_var_td_logical
1806 SUBROUTINE 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_debug(1,'ext_esmf_put_var_td_logical not supported yet')
1817   Status = WRF_WARN_NOTSUPPORTED
1818   RETURN
1819 END SUBROUTINE ext_esmf_put_var_td_logical
1820
1821 !--- get_var_td_char
1822 SUBROUTINE 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_debug(1,'ext_esmf_get_var_td_char not supported yet')
1832   Status = WRF_WARN_NOTSUPPORTED
1833   RETURN
1834 END SUBROUTINE ext_esmf_get_var_td_char
1835
1836 !--- put_var_td_char
1837 SUBROUTINE 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_debug(1,'ext_esmf_put_var_td_char not supported yet')
1847   Status = WRF_WARN_NOTSUPPORTED
1848   RETURN
1849 END SUBROUTINE ext_esmf_put_var_td_char
1850
1851