wrfv2_fire/external/io_mcel/io_mcel.F90

   1 MODULE module_ext_mcel
   2
   3   INTEGER, PARAMETER :: int_num_handles = 99
   4   LOGICAL, DIMENSION(int_num_handles) :: okay_to_write, okay_to_read,                     &
   5                                          opened_for_write, opened_for_update,             &
   6                                          opened_for_read,                                 &
   7                                          int_handle_in_use, okay_to_commit
   8   LOGICAL, DIMENSION(int_num_handles) :: mcel_grid_defined, mcel_finalized
   9   INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
  10   INTEGER, DIMENSION(int_num_handles) :: usemask
  11   CHARACTER*256, DIMENSION(int_num_handles) :: CurrentDateInFile
  12   CHARACTER*8092, DIMENSION(int_num_handles) :: ListOfFields
  13   REAL, POINTER    :: int_local_output_buffer(:)
  14   INTEGER          :: int_local_output_cursor
  15   INTEGER          :: mcel_npglobal, mcel_mystart, mcel_mnproc, mcel_myproc
  16
  17   INTEGER, PARAMETER           :: onebyte = 1
  18   INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
  19   INTEGER itypesize, rtypesize, typesize
  20   INTEGER, DIMENSION(512)     :: hdrbuf
  21   INTEGER, DIMENSION(int_num_handles)       :: handle
  22   INTEGER, DIMENSION(512, int_num_handles)  :: open_file_descriptors
  23   INCLUDE "MCEL.inc"
  24 #include "intio_tags.h"
  25 #include "wrf_io_flags.h"
  26 #include "wrf_status_codes.h"
  27   CHARACTER*80  LAT_R(int_num_handles), LON_R(int_num_handles), LANDMASK_I(int_num_handles)
  28
  29   REAL*8, ALLOCATABLE :: xlat(:,:), xlong(:,:)
  30   REAL*8              :: deltax, deltay, dxm(2)
  31   REAL*8              :: originx, originy, origin(2)
  32   INTEGER, ALLOCATABLE :: mask(:,:)
  33   REAL, ALLOCATABLE :: rmask(:,:)
  34   DOUBLEPRECISION, ALLOCATABLE :: dmask(:,:)
  35
  36   CHARACTER*132 last_next_var
  37
  38   CONTAINS
  39
  40     LOGICAL FUNCTION int_valid_handle( handle )
  41       IMPLICIT NONE
  42       INTEGER, INTENT(IN) ::  handle
  43       int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
  44     END FUNCTION int_valid_handle
  45
  46     SUBROUTINE int_get_fresh_handle( retval )
  47 !      USE wrf_data, ONLY : wrf_data_handle
  48 !      USE ext_ncd_support_routines, ONLY : allocHandle
  49 !      type(wrf_data_handle),pointer     :: DH
  50 !      INTEGER i, retval, comm, Status
  51       INTEGER i, retval
  52
  53 #if 0
  54       CALL allocHandle(retval,DH,Comm,Status)
  55 #endif
  56
  57       retval = -1
  58 ! dont use first 8 handles
  59       DO i = 8, int_num_handles
  60         IF ( .NOT. int_handle_in_use(i) )  THEN
  61           retval = i
  62           GOTO 33
  63         ENDIF
  64       ENDDO
  65 33    CONTINUE
  66       IF ( retval < 0 )  THEN
  67         CALL wrf_error_fatal("external/io_quilt/io_int.F90: int_get_fresh_handle() can not")
  68       ENDIF
  69       int_handle_in_use(retval) = .TRUE.
  70       NULLIFY ( int_local_output_buffer )
  71     END SUBROUTINE int_get_fresh_handle
  72
  73 ! parse comma separated list of VARIABLE=VALUE strings and return the
  74 ! value for the matching variable if such exists, otherwise return
  75 ! the empty string
  76 SUBROUTINE get_value ( varname , str , retval )
  77   IMPLICIT NONE
  78   CHARACTER*(*) ::    varname
  79   CHARACTER*(*) ::    str
  80   CHARACTER*(*) ::    retval
  81
  82   CHARACTER (128) varstr, tstr
  83   INTEGER i,j,n,varstrn
  84   LOGICAL nobreak, nobreakouter
  85
  86   varstr = TRIM(varname)//"="
  87   varstrn = len(TRIM(varstr))
  88   n = len(TRIM(str))
  89   retval = ""
  90   i = 1
  91   nobreakouter = .TRUE.
  92   DO WHILE ( nobreakouter )
  93     j = 1
  94     nobreak = .TRUE.
  95     tstr = ""
  96     DO WHILE ( nobreak )
  97       nobreak = .FALSE.
  98       IF ( i .LE. n ) THEN
  99         IF (str(i:i) .NE. ',' ) THEN
 100            tstr(j:j) = str(i:i)
 101            nobreak = .TRUE.
 102         ENDIF
 103       ENDIF
 104       j = j + 1
 105       i = i + 1
 106     ENDDO
 107     IF ( i .GT. n ) nobreakouter = .FALSE.
 108     IF ( varstr(1:varstrn) .EQ. tstr(1:varstrn) ) THEN
 109       retval(1:) = TRIM(tstr(varstrn+1:))
 110       nobreakouter = .FALSE.
 111     ENDIF
 112   ENDDO
 113   RETURN
 114 END SUBROUTINE get_value
 115
 116
 117     !--- ioinit
 118     SUBROUTINE init_module_ext_mcel
 119       IMPLICIT NONE
 120       CALL wrf_sizeof_integer( itypesize )
 121       CALL wrf_sizeof_real   ( rtypesize )
 122     END SUBROUTINE init_module_ext_mcel
 123
 124 END MODULE module_ext_mcel
 125
 126  SUBROUTINE copy_field_to_cache_r2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
 127    USE module_ext_mcel
 128    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 129    INTEGER idex, i, j
 130    REAL             Field(*)
 131    REAL             cache(ips:ipe,jps:jpe)
 132    DO j = jps, jpe
 133      DO i = ips, ipe
 134         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 135         cache(i,j) = Field( idex )
 136      ENDDO
 137    ENDDO
 138  END SUBROUTINE copy_field_to_cache_r2r
 139
 140  SUBROUTINE copy_field_to_cache_r2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
 141    USE module_ext_mcel
 142    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 143    INTEGER idex, i, j
 144    REAL             Field(*)
 145    DOUBLE PRECISION cache(ips:ipe,jps:jpe)
 146    DO j = jps, jpe
 147      DO i = ips, ipe
 148         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 149         cache(i,j) = Field( idex )
 150      ENDDO
 151    ENDDO
 152  END SUBROUTINE copy_field_to_cache_r2d
 153
 154  SUBROUTINE copy_field_to_cache_d2r ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
 155    USE module_ext_mcel
 156    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 157    INTEGER idex, i, j
 158    DOUBLE PRECISION Field(*)
 159    REAL             cache(ips:ipe,jps:jpe)
 160    DO j = jps, jpe
 161      DO i = ips, ipe
 162         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 163         cache(i,j) = Field( idex )
 164      ENDDO
 165    ENDDO
 166  END SUBROUTINE copy_field_to_cache_d2r
 167
 168  SUBROUTINE copy_field_to_cache_d2d ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
 169    USE module_ext_mcel
 170    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 171    INTEGER idex, i, j
 172    DOUBLE PRECISION Field(*)
 173    DOUBLE PRECISION cache(ips:ipe,jps:jpe)
 174    DO j = jps, jpe
 175      DO i = ips, ipe
 176         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 177         cache(i,j) = Field( idex )
 178      ENDDO
 179    ENDDO
 180  END SUBROUTINE copy_field_to_cache_d2d
 181
 182  SUBROUTINE copy_field_to_cache_int ( Field, cache, ips, ipe, jps, jpe, ims, ime, jms, jme )
 183    USE module_ext_mcel
 184    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 185    INTEGER idex, i, j
 186    INTEGER Field(*)
 187    INTEGER cache(ips:ipe,jps:jpe)
 188    DO j = jps, jpe
 189      DO i = ips, ipe
 190         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 191         cache(i,j) = Field( idex )
 192      ENDDO
 193    ENDDO
 194  END SUBROUTINE copy_field_to_cache_int
 195
 196  SUBROUTINE copy_cache_to_field_r2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
 197    USE module_ext_mcel
 198    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 199    INTEGER idex, i, j
 200    REAL            cache(ips:ipe,jps:jpe)
 201    REAL            Field(*)
 202    DO j = jps, jpe
 203      DO i = ips, ipe
 204         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 205         Field( idex ) = cache(i,j)
 206      ENDDO
 207    ENDDO
 208  END SUBROUTINE copy_cache_to_field_r2r
 209
 210  SUBROUTINE copy_cache_to_field_r2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
 211    USE module_ext_mcel
 212    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 213    INTEGER idex, i, j
 214    REAL             cache(ips:ipe,jps:jpe)
 215    DOUBLEPRECISION  Field(*)
 216    DO j = jps, jpe
 217      DO i = ips, ipe
 218         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 219         Field( idex ) = cache(i,j)
 220      ENDDO
 221    ENDDO
 222  END SUBROUTINE copy_cache_to_field_r2d
 223
 224  SUBROUTINE copy_cache_to_field_d2r ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
 225    USE module_ext_mcel
 226    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 227    INTEGER idex, i, j
 228    DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
 229    REAL             Field(*)
 230    DO j = jps, jpe
 231      DO i = ips, ipe
 232         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 233         Field( idex ) = cache(i,j)
 234      ENDDO
 235    ENDDO
 236  END SUBROUTINE copy_cache_to_field_d2r
 237
 238  SUBROUTINE copy_cache_to_field_d2d ( cache, Field, ips, ipe, jps, jpe, ims, ime, jms, jme )
 239    USE module_ext_mcel
 240    INTEGER FieldType, ips, ipe, jps, jpe, ims, ime, jms, jme
 241    INTEGER idex, i, j
 242    DOUBLEPRECISION  cache(ips:ipe,jps:jpe)
 243    DOUBLEPRECISION  Field(*)
 244    DO j = jps, jpe
 245      DO i = ips, ipe
 246         idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
 247         Field( idex ) = cache(i,j)
 248      ENDDO
 249    ENDDO
 250  END SUBROUTINE copy_cache_to_field_d2d
 251
 252 !--------------
 253
 254 SUBROUTINE ext_mcel_ioinit( SysDepInfo, Status )
 255   USE module_ext_mcel
 256   IMPLICIT NONE
 257   CHARACTER*(*), INTENT(IN) :: SysDepInfo
 258   INTEGER Status
 259   CALL init_module_ext_mcel
 260   Status = 0
 261 END SUBROUTINE ext_mcel_ioinit
 262
 263 !--- open_for_read
 264 SUBROUTINE ext_mcel_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
 265                                DataHandle , Status )
 266   USE module_ext_mcel
 267   IMPLICIT NONE
 268   CHARACTER*(*) :: FileName
 269   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
 270   CHARACTER*(*) :: SysDepInfo
 271   INTEGER ,       INTENT(OUT) :: DataHandle
 272   INTEGER ,       INTENT(OUT) :: Status
 273   INTEGER i
 274
 275   CALL int_get_fresh_handle(i)
 276   okay_to_write(i) = .false.
 277   DataHandle = i
 278   CurrentDateInFile(i) = ""
 279   Status = WRF_WARN_NOTSUPPORTED
 280
 281   RETURN
 282 END SUBROUTINE ext_mcel_open_for_read
 283
 284
 285 !--- inquire_opened
 286 SUBROUTINE ext_mcel_inquire_opened ( DataHandle, FileName , FileStatus, Status )
 287   USE module_ext_mcel
 288   IMPLICIT NONE
 289   INTEGER ,       INTENT(IN)  :: DataHandle
 290   CHARACTER*(*) :: FileName
 291   INTEGER ,       INTENT(OUT) :: FileStatus
 292   INTEGER ,       INTENT(OUT) :: Status
 293
 294   Status = 0
 295
 296   FileStatus = WRF_FILE_NOT_OPENED
 297   IF ( DataHandle .GE. 1 .AND. DataHandle .LE. int_num_handles ) THEN
 298     IF      ( int_handle_in_use( DataHandle ) .AND. opened_for_read ( DataHandle ) ) THEN
 299       IF ( okay_to_read ( DataHandle ) ) THEN
 300         FileStatus = WRF_FILE_OPENED_FOR_READ
 301       ELSE
 302         FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 303       ENDIF
 304     ELSE IF ( int_handle_in_use( DataHandle ) .AND. opened_for_write ( DataHandle ) ) THEN
 305       IF ( okay_to_write ( DataHandle ) ) THEN
 306         FileStatus = WRF_FILE_OPENED_FOR_WRITE
 307       ELSE
 308         FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 309       ENDIF
 310     ENDIF
 311   ENDIF
 312   Status = 0
 313
 314   RETURN
 315 END SUBROUTINE ext_mcel_inquire_opened
 316
 317 !--- inquire_filename
 318 SUBROUTINE ext_mcel_inquire_filename ( DataHandle, FileName , FileStatus, Status )
 319   USE module_ext_mcel
 320   IMPLICIT NONE
 321   INTEGER ,       INTENT(IN)  :: DataHandle
 322   CHARACTER*(*) :: FileName
 323   INTEGER ,       INTENT(OUT) :: FileStatus
 324   INTEGER ,       INTENT(OUT) :: Status
 325   CHARACTER *80   SysDepInfo
 326   Status = 0
 327   FileStatus = WRF_FILE_NOT_OPENED
 328   IF ( int_valid_handle( DataHandle ) ) THEN
 329     IF ( int_handle_in_use( DataHandle ) ) THEN
 330       IF ( opened_for_read ( DataHandle ) ) THEN
 331         IF ( okay_to_read( DataHandle ) ) THEN
 332            FileStatus = WRF_FILE_OPENED_FOR_READ
 333         ELSE
 334            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 335         ENDIF
 336       ELSE IF ( opened_for_write( DataHandle ) ) THEN
 337         IF ( okay_to_write( DataHandle ) ) THEN
 338            FileStatus = WRF_FILE_OPENED_FOR_WRITE
 339         ELSE
 340            FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
 341         ENDIF
 342       ELSE
 343         FileStatus = WRF_FILE_NOT_OPENED
 344       ENDIF
 345     ENDIF
 346   ENDIF
 347   Status = 0
 348 END SUBROUTINE ext_mcel_inquire_filename
 349
 350 !--- sync
 351 SUBROUTINE ext_mcel_iosync ( DataHandle, Status )
 352   USE module_ext_mcel
 353   IMPLICIT NONE
 354   INTEGER ,       INTENT(IN)  :: DataHandle
 355   INTEGER ,       INTENT(OUT) :: Status
 356
 357   Status = 0
 358   RETURN
 359 END SUBROUTINE ext_mcel_iosync
 360
 361 !--- close
 362 SUBROUTINE ext_mcel_ioclose ( DataHandle, Status )
 363   USE module_ext_mcel
 364   IMPLICIT NONE
 365   INTEGER DataHandle, Status
 366
 367   IF ( int_valid_handle (DataHandle) ) THEN
 368     IF ( int_handle_in_use( DataHandle ) ) THEN
 369       CLOSE ( DataHandle )
 370     ENDIF
 371   ENDIF
 372
 373   Status = 0
 374
 375   RETURN
 376 END SUBROUTINE ext_mcel_ioclose
 377
 378 !--- ioexit
 379 SUBROUTINE ext_mcel_ioexit( Status )
 380
 381   USE module_ext_mcel
 382   IMPLICIT NONE
 383   INTEGER ,       INTENT(OUT) :: Status
 384   INTEGER                     :: DataHandle
 385   INTEGER i,ierr
 386   REAL dummy
 387
 388   RETURN
 389 END SUBROUTINE ext_mcel_ioexit
 390
 391 !--- get_next_time
 392 SUBROUTINE ext_mcel_get_next_time ( DataHandle, DateStr, Status )
 393   USE module_ext_mcel
 394   IMPLICIT NONE
 395   INTEGER ,       INTENT(IN)  :: DataHandle
 396   CHARACTER*(*) :: DateStr
 397   INTEGER ,       INTENT(OUT) :: Status
 398   INTEGER         code
 399   CHARACTER*132   locElement, dummyvar
 400   INTEGER istat
 401
 402 !local
 403   INTEGER                        :: locDataHandle
 404   CHARACTER*132                  :: locDateStr
 405   CHARACTER*132                  :: locVarName
 406   integer                        :: locFieldType
 407   integer                        :: locComm
 408   integer                        :: locIOComm
 409   integer                        :: locDomainDesc
 410   character*132                  :: locMemoryOrder
 411   character*132                  :: locStagger
 412   character*132 , dimension (3)  :: locDimNames
 413   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 414   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 415   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 416
 417   character*132 mess
 418   integer ii,jj,kk,myrank
 419   INTEGER inttypesize, realtypesize
 420   REAL, DIMENSION( 1 ) :: Field
 421
 422   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 423     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: invalid data handle" )
 424   ENDIF
 425   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 426     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_time: DataHandle not opened" )
 427   ENDIF
 428   inttypesize = itypesize
 429   realtypesize = rtypesize
 430
 431   Status = WRF_WARN_NOTSUPPORTED
 432
 433   RETURN
 434 END SUBROUTINE ext_mcel_get_next_time
 435
 436 !--- set_time
 437 SUBROUTINE ext_mcel_set_time ( DataHandle, DateStr, Status )
 438   USE module_ext_mcel
 439   IMPLICIT NONE
 440   INTEGER ,       INTENT(IN)  :: DataHandle
 441   CHARACTER*(*) :: DateStr
 442   INTEGER ,       INTENT(OUT) :: Status
 443
 444   Status = WRF_WARN_NOTSUPPORTED
 445   RETURN
 446 END SUBROUTINE ext_mcel_set_time
 447
 448 !--- get_var_info
 449 SUBROUTINE ext_mcel_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
 450                               DomainStart , DomainEnd , WrfType, Status )
 451   USE module_ext_mcel
 452   IMPLICIT NONE
 453   integer               ,intent(in)     :: DataHandle
 454   character*(*)         ,intent(in)     :: VarName
 455   integer               ,intent(out)    :: NDim
 456   character*(*)         ,intent(out)    :: MemoryOrder
 457   character*(*)         ,intent(out)    :: Stagger
 458   integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
 459   integer               ,intent(out)    :: WrfType
 460   integer               ,intent(out)    :: Status
 461
 462 !local
 463   INTEGER                        :: locDataHandle
 464   CHARACTER*132                  :: locDateStr
 465   CHARACTER*132                  :: locVarName
 466   integer                        :: locFieldType
 467   integer                        :: locComm
 468   integer                        :: locIOComm
 469   integer                        :: locDomainDesc
 470   character*132                  :: locMemoryOrder
 471   character*132                  :: locStagger
 472   character*132 , dimension (3)  :: locDimNames
 473   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 474   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 475   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 476
 477   character*132 mess
 478   integer ii,jj,kk,myrank
 479   INTEGER inttypesize, realtypesize, istat, code
 480   REAL, DIMENSION( 1 ) :: Field
 481
 482   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 483     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: invalid data handle" )
 484   ENDIF
 485   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 486     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_var_info: DataHandle not opened" )
 487   ENDIF
 488   inttypesize = itypesize
 489   realtypesize = rtypesize
 490   Status = 0
 491
 492 RETURN
 493 END SUBROUTINE ext_mcel_get_var_info
 494
 495 !--- get_next_var  (not defined for IntIO)
 496 SUBROUTINE ext_mcel_get_next_var ( DataHandle, VarName, Status )
 497   USE module_ext_mcel
 498   IMPLICIT NONE
 499   INTEGER ,       INTENT(IN)  :: DataHandle
 500   CHARACTER*(*) :: VarName
 501   INTEGER ,       INTENT(OUT) :: Status
 502
 503 !local
 504   INTEGER                        :: locDataHandle
 505   CHARACTER*132                  :: locDateStr
 506   CHARACTER*132                  :: locVarName
 507   integer                        :: locFieldType
 508   integer                        :: locComm
 509   integer                        :: locIOComm
 510   integer                        :: locDomainDesc
 511   character*132                  :: locMemoryOrder
 512   character*132                  :: locStagger
 513   character*132 , dimension (3)  :: locDimNames
 514   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 515   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 516   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 517
 518 character*128 locElement, strData, dumstr
 519 integer loccode, loccount
 520 integer idata(128)
 521 real    rdata(128)
 522
 523   character*132 mess
 524   integer ii,jj,kk,myrank
 525   INTEGER inttypesize, realtypesize, istat, code
 526   REAL, DIMENSION( 1 ) :: Field
 527
 528   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 529     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: invalid data handle" )
 530   ENDIF
 531   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 532     CALL wrf_error_fatal("external/io_quilt/io_int.F90: ext_mcel_get_next_var: DataHandle not opened" )
 533   ENDIF
 534   inttypesize = itypesize
 535   realtypesize = rtypesize
 536
 537   Status = 0
 538
 539   RETURN
 540 END SUBROUTINE ext_mcel_get_next_var
 541
 542 !--- get_dom_ti_real
 543 SUBROUTINE ext_mcel_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
 544   USE module_ext_mcel
 545   IMPLICIT NONE
 546   INTEGER ,       INTENT(IN)  :: DataHandle
 547   CHARACTER*(*) :: Element
 548   real ,            INTENT(IN) :: Data(*)
 549   INTEGER ,       INTENT(IN)  :: Count
 550   INTEGER ,       INTENT(OUT) :: Outcount
 551   INTEGER ,       INTENT(OUT) :: Status
 552   INTEGER loccount, code, istat, locDataHandle
 553   CHARACTER*132                :: locElement, mess
 554   LOGICAL keepgoing
 555
 556   Status = 0
 557
 558 RETURN
 559 END SUBROUTINE ext_mcel_get_dom_ti_real
 560
 561 !--- put_dom_ti_real
 562 SUBROUTINE ext_mcel_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
 563   USE module_ext_mcel
 564   IMPLICIT NONE
 565   INTEGER ,       INTENT(IN)  :: DataHandle
 566   CHARACTER*(*) :: Element
 567   real ,            INTENT(IN) :: Data(*)
 568   INTEGER ,       INTENT(IN)  :: Count
 569   INTEGER ,       INTENT(OUT) :: Status
 570   REAL dummy
 571 !
 572
 573   Status = 0
 574 RETURN
 575 END SUBROUTINE ext_mcel_put_dom_ti_real
 576
 577 !--- get_dom_ti_double
 578 SUBROUTINE ext_mcel_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
 579   IMPLICIT NONE
 580   INTEGER ,       INTENT(IN)  :: DataHandle
 581   CHARACTER*(*) :: Element
 582   real*8 ,            INTENT(OUT) :: Data(*)
 583   INTEGER ,       INTENT(IN)  :: Count
 584   INTEGER ,       INTENT(OUT)  :: OutCount
 585   INTEGER ,       INTENT(OUT) :: Status
 586   CALL wrf_message('ext_mcel_get_dom_ti_double not supported yet')
 587 RETURN
 588 END SUBROUTINE ext_mcel_get_dom_ti_double
 589
 590 !--- put_dom_ti_double
 591 SUBROUTINE ext_mcel_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
 592   IMPLICIT NONE
 593   INTEGER ,       INTENT(IN)  :: DataHandle
 594   CHARACTER*(*) :: Element
 595   real*8 ,            INTENT(IN) :: Data(*)
 596   INTEGER ,       INTENT(IN)  :: Count
 597   INTEGER ,       INTENT(OUT) :: Status
 598   CALL wrf_message('ext_mcel_put_dom_ti_double not supported yet')
 599 RETURN
 600 END SUBROUTINE ext_mcel_put_dom_ti_double
 601
 602 !--- get_dom_ti_integer
 603 SUBROUTINE ext_mcel_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
 604   USE module_ext_mcel
 605   IMPLICIT NONE
 606   INTEGER ,       INTENT(IN)  :: DataHandle
 607   CHARACTER*(*) :: Element
 608   integer ,            INTENT(OUT) :: Data(*)
 609   INTEGER ,       INTENT(IN)  :: Count
 610   INTEGER ,       INTENT(OUT)  :: OutCount
 611   INTEGER ,       INTENT(OUT) :: Status
 612   INTEGER loccount, code, istat, locDataHandle
 613   CHARACTER*132   locElement, mess
 614   LOGICAL keepgoing
 615
 616   Status = 0
 617 RETURN
 618 END SUBROUTINE ext_mcel_get_dom_ti_integer
 619
 620 !--- put_dom_ti_integer
 621 SUBROUTINE ext_mcel_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
 622   USE module_ext_mcel
 623   IMPLICIT NONE
 624   INTEGER ,       INTENT(IN)  :: DataHandle
 625   CHARACTER*(*) :: Element
 626   INTEGER ,       INTENT(IN) :: Data(*)
 627   INTEGER ,       INTENT(IN)  :: Count
 628   INTEGER ,       INTENT(OUT) :: Status
 629   REAL dummy
 630 !
 631   Status = 0
 632 RETURN
 633 END SUBROUTINE ext_mcel_put_dom_ti_integer
 634
 635 !--- get_dom_ti_logical
 636 SUBROUTINE ext_mcel_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
 637   IMPLICIT NONE
 638   INTEGER ,       INTENT(IN)  :: DataHandle
 639   CHARACTER*(*) :: Element
 640   logical ,            INTENT(OUT) :: Data(*)
 641   INTEGER ,       INTENT(IN)  :: Count
 642   INTEGER ,       INTENT(OUT)  :: OutCount
 643   INTEGER ,       INTENT(OUT) :: Status
 644   CALL wrf_message('ext_mcel_get_dom_ti_logical not supported yet')
 645 RETURN
 646 END SUBROUTINE ext_mcel_get_dom_ti_logical
 647
 648 !--- put_dom_ti_logical
 649 SUBROUTINE ext_mcel_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
 650   IMPLICIT NONE
 651   INTEGER ,       INTENT(IN)  :: DataHandle
 652   CHARACTER*(*) :: Element
 653   logical ,            INTENT(IN) :: Data(*)
 654   INTEGER ,       INTENT(IN)  :: Count
 655   INTEGER ,       INTENT(OUT) :: Status
 656   CALL wrf_message('ext_mcel_put_dom_ti_logical not supported yet')
 657 RETURN
 658 END SUBROUTINE ext_mcel_put_dom_ti_logical
 659
 660 !--- get_dom_ti_char
 661 SUBROUTINE ext_mcel_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
 662   USE module_ext_mcel
 663   IMPLICIT NONE
 664   INTEGER ,       INTENT(IN)  :: DataHandle
 665   CHARACTER*(*) :: Element
 666   CHARACTER*(*) :: Data
 667   INTEGER ,       INTENT(OUT) :: Status
 668   INTEGER istat, code, i
 669   CHARACTER*79 dumstr, locElement
 670   INTEGER locDataHandle
 671   LOGICAL keepgoing
 672
 673   Status = 0
 674 RETURN
 675 END SUBROUTINE ext_mcel_get_dom_ti_char
 676
 677 !--- put_dom_ti_char
 678 SUBROUTINE ext_mcel_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
 679   USE module_ext_mcel
 680   IMPLICIT NONE
 681   INTEGER ,       INTENT(IN)  :: DataHandle
 682   CHARACTER*(*) :: Element
 683   CHARACTER*(*) :: Data
 684   INTEGER ,       INTENT(OUT) :: Status
 685   INTEGER i
 686   REAL dummy
 687   INTEGER                 :: Count
 688
 689 ! TBH:  Not sure what this is doing here.  2004_11_15
 690 ! JGM:  You are right. It does not belong here.  2006_09_28
 691 !  IF ( int_valid_handle ( Datahandle ) ) THEN
 692 !    IF ( int_handle_in_use( DataHandle ) ) THEN
 693 !      CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
 694 !                                   DataHandle, Element, "", Data, int_dom_ti_char )
 695 !      WRITE( unit=DataHandle ) hdrbuf
 696 !    ENDIF
 697 !  ENDIF
 698   Status = 0
 699 RETURN
 700 END SUBROUTINE ext_mcel_put_dom_ti_char
 701
 702 !--- get_dom_td_real
 703 SUBROUTINE ext_mcel_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 704   IMPLICIT NONE
 705   INTEGER ,       INTENT(IN)  :: DataHandle
 706   CHARACTER*(*) :: Element
 707   CHARACTER*(*) :: DateStr
 708   real ,            INTENT(OUT) :: Data(*)
 709   INTEGER ,       INTENT(IN)  :: Count
 710   INTEGER ,       INTENT(OUT)  :: OutCount
 711   INTEGER ,       INTENT(OUT) :: Status
 712 RETURN
 713 END SUBROUTINE ext_mcel_get_dom_td_real
 714
 715 !--- put_dom_td_real
 716 SUBROUTINE ext_mcel_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
 717   IMPLICIT NONE
 718   INTEGER ,       INTENT(IN)  :: DataHandle
 719   CHARACTER*(*) :: Element
 720   CHARACTER*(*) :: DateStr
 721   real ,            INTENT(IN) :: Data(*)
 722   INTEGER ,       INTENT(IN)  :: Count
 723   INTEGER ,       INTENT(OUT) :: Status
 724 RETURN
 725 END SUBROUTINE ext_mcel_put_dom_td_real
 726
 727 !--- get_dom_td_double
 728 SUBROUTINE ext_mcel_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 729   IMPLICIT NONE
 730   INTEGER ,       INTENT(IN)  :: DataHandle
 731   CHARACTER*(*) :: Element
 732   CHARACTER*(*) :: DateStr
 733   real*8 ,            INTENT(OUT) :: Data(*)
 734   INTEGER ,       INTENT(IN)  :: Count
 735   INTEGER ,       INTENT(OUT)  :: OutCount
 736   INTEGER ,       INTENT(OUT) :: Status
 737 RETURN
 738 END SUBROUTINE ext_mcel_get_dom_td_double
 739
 740 !--- put_dom_td_double
 741 SUBROUTINE ext_mcel_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
 742   IMPLICIT NONE
 743   INTEGER ,       INTENT(IN)  :: DataHandle
 744   CHARACTER*(*) :: Element
 745   CHARACTER*(*) :: DateStr
 746   real*8 ,            INTENT(IN) :: Data(*)
 747   INTEGER ,       INTENT(IN)  :: Count
 748   INTEGER ,       INTENT(OUT) :: Status
 749 RETURN
 750 END SUBROUTINE ext_mcel_put_dom_td_double
 751
 752 !--- get_dom_td_integer
 753 SUBROUTINE ext_mcel_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 754   IMPLICIT NONE
 755   INTEGER ,       INTENT(IN)  :: DataHandle
 756   CHARACTER*(*) :: Element
 757   CHARACTER*(*) :: DateStr
 758   integer ,            INTENT(OUT) :: Data(*)
 759   INTEGER ,       INTENT(IN)  :: Count
 760   INTEGER ,       INTENT(OUT)  :: OutCount
 761   INTEGER ,       INTENT(OUT) :: Status
 762 RETURN
 763 END SUBROUTINE ext_mcel_get_dom_td_integer
 764
 765 !--- put_dom_td_integer
 766 SUBROUTINE ext_mcel_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
 767   IMPLICIT NONE
 768   INTEGER ,       INTENT(IN)  :: DataHandle
 769   CHARACTER*(*) :: Element
 770   CHARACTER*(*) :: DateStr
 771   integer ,            INTENT(IN) :: Data(*)
 772   INTEGER ,       INTENT(IN)  :: Count
 773   INTEGER ,       INTENT(OUT) :: Status
 774 RETURN
 775 END SUBROUTINE ext_mcel_put_dom_td_integer
 776
 777 !--- get_dom_td_logical
 778 SUBROUTINE ext_mcel_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 779   IMPLICIT NONE
 780   INTEGER ,       INTENT(IN)  :: DataHandle
 781   CHARACTER*(*) :: Element
 782   CHARACTER*(*) :: DateStr
 783   logical ,            INTENT(OUT) :: Data(*)
 784   INTEGER ,       INTENT(IN)  :: Count
 785   INTEGER ,       INTENT(OUT)  :: OutCount
 786   INTEGER ,       INTENT(OUT) :: Status
 787 RETURN
 788 END SUBROUTINE ext_mcel_get_dom_td_logical
 789
 790 !--- put_dom_td_logical
 791 SUBROUTINE ext_mcel_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
 792   IMPLICIT NONE
 793   INTEGER ,       INTENT(IN)  :: DataHandle
 794   CHARACTER*(*) :: Element
 795   CHARACTER*(*) :: DateStr
 796   logical ,            INTENT(IN) :: Data(*)
 797   INTEGER ,       INTENT(IN)  :: Count
 798   INTEGER ,       INTENT(OUT) :: Status
 799 RETURN
 800 END SUBROUTINE ext_mcel_put_dom_td_logical
 801
 802 !--- get_dom_td_char
 803 SUBROUTINE ext_mcel_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
 804   IMPLICIT NONE
 805   INTEGER ,       INTENT(IN)  :: DataHandle
 806   CHARACTER*(*) :: Element
 807   CHARACTER*(*) :: DateStr
 808   CHARACTER*(*) :: Data
 809   INTEGER ,       INTENT(OUT) :: Status
 810 RETURN
 811 END SUBROUTINE ext_mcel_get_dom_td_char
 812
 813 !--- put_dom_td_char
 814 SUBROUTINE ext_mcel_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
 815   IMPLICIT NONE
 816   INTEGER ,       INTENT(IN)  :: DataHandle
 817   CHARACTER*(*) :: Element
 818   CHARACTER*(*) :: DateStr
 819   CHARACTER*(*) :: Data
 820   INTEGER ,       INTENT(OUT) :: Status
 821 RETURN
 822 END SUBROUTINE ext_mcel_put_dom_td_char
 823
 824 !--- get_var_ti_real
 825 SUBROUTINE ext_mcel_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
 826   IMPLICIT NONE
 827   INTEGER ,       INTENT(IN)  :: DataHandle
 828   CHARACTER*(*) :: Element
 829   CHARACTER*(*) :: VarName
 830   real ,            INTENT(OUT) :: Data(*)
 831   INTEGER ,       INTENT(IN)  :: Count
 832   INTEGER ,       INTENT(OUT)  :: OutCount
 833   INTEGER ,       INTENT(OUT) :: Status
 834 RETURN
 835 END SUBROUTINE ext_mcel_get_var_ti_real
 836
 837 !--- put_var_ti_real
 838 SUBROUTINE ext_mcel_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
 839   IMPLICIT NONE
 840   INTEGER ,       INTENT(IN)  :: DataHandle
 841   CHARACTER*(*) :: Element
 842   CHARACTER*(*) :: VarName
 843   real ,            INTENT(IN) :: Data(*)
 844   INTEGER ,       INTENT(IN)  :: Count
 845   INTEGER ,       INTENT(OUT) :: Status
 846 RETURN
 847 END SUBROUTINE ext_mcel_put_var_ti_real
 848
 849 !--- get_var_ti_double
 850 SUBROUTINE ext_mcel_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
 851   IMPLICIT NONE
 852   INTEGER ,       INTENT(IN)  :: DataHandle
 853   CHARACTER*(*) :: Element
 854   CHARACTER*(*) :: VarName
 855   real*8 ,            INTENT(OUT) :: Data(*)
 856   INTEGER ,       INTENT(IN)  :: Count
 857   INTEGER ,       INTENT(OUT)  :: OutCount
 858   INTEGER ,       INTENT(OUT) :: Status
 859 RETURN
 860 END SUBROUTINE ext_mcel_get_var_ti_double
 861
 862 !--- put_var_ti_double
 863 SUBROUTINE ext_mcel_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
 864   IMPLICIT NONE
 865   INTEGER ,       INTENT(IN)  :: DataHandle
 866   CHARACTER*(*) :: Element
 867   CHARACTER*(*) :: VarName
 868   real*8 ,            INTENT(IN) :: Data(*)
 869   INTEGER ,       INTENT(IN)  :: Count
 870   INTEGER ,       INTENT(OUT) :: Status
 871 RETURN
 872 END SUBROUTINE ext_mcel_put_var_ti_double
 873
 874 !--- get_var_ti_integer
 875 SUBROUTINE ext_mcel_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
 876   IMPLICIT NONE
 877   INTEGER ,       INTENT(IN)  :: DataHandle
 878   CHARACTER*(*) :: Element
 879   CHARACTER*(*) :: VarName
 880   integer ,            INTENT(OUT) :: Data(*)
 881   INTEGER ,       INTENT(IN)  :: Count
 882   INTEGER ,       INTENT(OUT)  :: OutCount
 883   INTEGER ,       INTENT(OUT) :: Status
 884 RETURN
 885 END SUBROUTINE ext_mcel_get_var_ti_integer
 886
 887 !--- put_var_ti_integer
 888 SUBROUTINE ext_mcel_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
 889   IMPLICIT NONE
 890   INTEGER ,       INTENT(IN)  :: DataHandle
 891   CHARACTER*(*) :: Element
 892   CHARACTER*(*) :: VarName
 893   integer ,            INTENT(IN) :: Data(*)
 894   INTEGER ,       INTENT(IN)  :: Count
 895   INTEGER ,       INTENT(OUT) :: Status
 896 RETURN
 897 END SUBROUTINE ext_mcel_put_var_ti_integer
 898
 899 !--- get_var_ti_logical
 900 SUBROUTINE ext_mcel_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
 901   IMPLICIT NONE
 902   INTEGER ,       INTENT(IN)  :: DataHandle
 903   CHARACTER*(*) :: Element
 904   CHARACTER*(*) :: VarName
 905   logical ,            INTENT(OUT) :: Data(*)
 906   INTEGER ,       INTENT(IN)  :: Count
 907   INTEGER ,       INTENT(OUT)  :: OutCount
 908   INTEGER ,       INTENT(OUT) :: Status
 909 RETURN
 910 END SUBROUTINE ext_mcel_get_var_ti_logical
 911
 912 !--- put_var_ti_logical
 913 SUBROUTINE ext_mcel_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
 914   IMPLICIT NONE
 915   INTEGER ,       INTENT(IN)  :: DataHandle
 916   CHARACTER*(*) :: Element
 917   CHARACTER*(*) :: VarName
 918   logical ,            INTENT(IN) :: Data(*)
 919   INTEGER ,       INTENT(IN)  :: Count
 920   INTEGER ,       INTENT(OUT) :: Status
 921 RETURN
 922 END SUBROUTINE ext_mcel_put_var_ti_logical
 923
 924 !--- get_var_ti_char
 925 SUBROUTINE ext_mcel_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
 926   USE module_ext_mcel
 927   IMPLICIT NONE
 928   INTEGER ,       INTENT(IN)  :: DataHandle
 929   CHARACTER*(*) :: Element
 930   CHARACTER*(*) :: VarName
 931   CHARACTER*(*) :: Data
 932   INTEGER ,       INTENT(OUT) :: Status
 933   INTEGER locDataHandle, code
 934   CHARACTER*132 locElement, locVarName
 935   Status = 0
 936 RETURN
 937 END SUBROUTINE ext_mcel_get_var_ti_char
 938
 939 !--- put_var_ti_char
 940 SUBROUTINE ext_mcel_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
 941   USE module_ext_mcel
 942   IMPLICIT NONE
 943   INTEGER ,       INTENT(IN)  :: DataHandle
 944   CHARACTER*(*) :: Element
 945   CHARACTER*(*) :: VarName
 946   CHARACTER*(*) :: Data
 947   INTEGER ,       INTENT(OUT) :: Status
 948   REAL dummy
 949   INTEGER                 :: Count
 950   Status = 0
 951 RETURN
 952 END SUBROUTINE ext_mcel_put_var_ti_char
 953
 954 !--- get_var_td_real
 955 SUBROUTINE ext_mcel_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
 956   IMPLICIT NONE
 957   INTEGER ,       INTENT(IN)  :: DataHandle
 958   CHARACTER*(*) :: Element
 959   CHARACTER*(*) :: DateStr
 960   CHARACTER*(*) :: VarName
 961   real ,            INTENT(OUT) :: Data(*)
 962   INTEGER ,       INTENT(IN)  :: Count
 963   INTEGER ,       INTENT(OUT)  :: OutCount
 964   INTEGER ,       INTENT(OUT) :: Status
 965 RETURN
 966 END SUBROUTINE ext_mcel_get_var_td_real
 967
 968 !--- put_var_td_real
 969 SUBROUTINE ext_mcel_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
 970   IMPLICIT NONE
 971   INTEGER ,       INTENT(IN)  :: DataHandle
 972   CHARACTER*(*) :: Element
 973   CHARACTER*(*) :: DateStr
 974   CHARACTER*(*) :: VarName
 975   real ,            INTENT(IN) :: Data(*)
 976   INTEGER ,       INTENT(IN)  :: Count
 977   INTEGER ,       INTENT(OUT) :: Status
 978 RETURN
 979 END SUBROUTINE ext_mcel_put_var_td_real
 980
 981 !--- get_var_td_double
 982 SUBROUTINE ext_mcel_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
 983   IMPLICIT NONE
 984   INTEGER ,       INTENT(IN)  :: DataHandle
 985   CHARACTER*(*) :: Element
 986   CHARACTER*(*) :: DateStr
 987   CHARACTER*(*) :: VarName
 988   real*8 ,            INTENT(OUT) :: Data(*)
 989   INTEGER ,       INTENT(IN)  :: Count
 990   INTEGER ,       INTENT(OUT)  :: OutCount
 991   INTEGER ,       INTENT(OUT) :: Status
 992 RETURN
 993 END SUBROUTINE ext_mcel_get_var_td_double
 994
 995 !--- put_var_td_double
 996 SUBROUTINE ext_mcel_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
 997   IMPLICIT NONE
 998   INTEGER ,       INTENT(IN)  :: DataHandle
 999   CHARACTER*(*) :: Element
1000   CHARACTER*(*) :: DateStr
1001   CHARACTER*(*) :: VarName
1002   real*8 ,            INTENT(IN) :: Data(*)
1003   INTEGER ,       INTENT(IN)  :: Count
1004   INTEGER ,       INTENT(OUT) :: Status
1005 RETURN
1006 END SUBROUTINE ext_mcel_put_var_td_double
1007
1008 !--- get_var_td_integer
1009 SUBROUTINE ext_mcel_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1010   IMPLICIT NONE
1011   INTEGER ,       INTENT(IN)  :: DataHandle
1012   CHARACTER*(*) :: Element
1013   CHARACTER*(*) :: DateStr
1014   CHARACTER*(*) :: VarName
1015   integer ,            INTENT(OUT) :: Data(*)
1016   INTEGER ,       INTENT(IN)  :: Count
1017   INTEGER ,       INTENT(OUT)  :: OutCount
1018   INTEGER ,       INTENT(OUT) :: Status
1019 RETURN
1020 END SUBROUTINE ext_mcel_get_var_td_integer
1021
1022 !--- put_var_td_integer
1023 SUBROUTINE ext_mcel_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1024   IMPLICIT NONE
1025   INTEGER ,       INTENT(IN)  :: DataHandle
1026   CHARACTER*(*) :: Element
1027   CHARACTER*(*) :: DateStr
1028   CHARACTER*(*) :: VarName
1029   integer ,            INTENT(IN) :: Data(*)
1030   INTEGER ,       INTENT(IN)  :: Count
1031   INTEGER ,       INTENT(OUT) :: Status
1032 RETURN
1033 END SUBROUTINE ext_mcel_put_var_td_integer
1034
1035 !--- get_var_td_logical
1036 SUBROUTINE ext_mcel_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1037   IMPLICIT NONE
1038   INTEGER ,       INTENT(IN)  :: DataHandle
1039   CHARACTER*(*) :: Element
1040   CHARACTER*(*) :: DateStr
1041   CHARACTER*(*) :: VarName
1042   logical ,            INTENT(OUT) :: Data(*)
1043   INTEGER ,       INTENT(IN)  :: Count
1044   INTEGER ,       INTENT(OUT)  :: OutCount
1045   INTEGER ,       INTENT(OUT) :: Status
1046 RETURN
1047 END SUBROUTINE ext_mcel_get_var_td_logical
1048
1049 !--- put_var_td_logical
1050 SUBROUTINE ext_mcel_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1051   IMPLICIT NONE
1052   INTEGER ,       INTENT(IN)  :: DataHandle
1053   CHARACTER*(*) :: Element
1054   CHARACTER*(*) :: DateStr
1055   CHARACTER*(*) :: VarName
1056   logical ,            INTENT(IN) :: Data(*)
1057   INTEGER ,       INTENT(IN)  :: Count
1058   INTEGER ,       INTENT(OUT) :: Status
1059 RETURN
1060 END SUBROUTINE ext_mcel_put_var_td_logical
1061
1062 !--- get_var_td_char
1063 SUBROUTINE ext_mcel_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1064   IMPLICIT NONE
1065   INTEGER ,       INTENT(IN)  :: DataHandle
1066   CHARACTER*(*) :: Element
1067   CHARACTER*(*) :: DateStr
1068   CHARACTER*(*) :: VarName
1069   CHARACTER*(*) :: Data
1070   INTEGER ,       INTENT(OUT) :: Status
1071 RETURN
1072 END SUBROUTINE ext_mcel_get_var_td_char
1073
1074 !--- put_var_td_char
1075 SUBROUTINE ext_mcel_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1076   IMPLICIT NONE
1077   INTEGER ,       INTENT(IN)  :: DataHandle
1078   CHARACTER*(*) :: Element
1079   CHARACTER*(*) :: DateStr
1080   CHARACTER*(*) :: VarName
1081   CHARACTER*(*) :: Data
1082   INTEGER ,       INTENT(OUT) :: Status
1083 RETURN
1084 END SUBROUTINE ext_mcel_put_var_td_char
1085
1086 SUBROUTINE ext_mcel_georegister( DataHandle, inlon, inlat,                                    &
1087                                  MemoryStart , MemoryEnd ,                                    &
1088                                  PatchStart , PatchEnd ,                                      &
1089                                  Status )
1090   USE module_ext_mcel
1091   IMPLICIT NONE
1092   integer                       ,intent(in)    :: DataHandle
1093   integer                       ,intent(inout) :: Status
1094   integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
1095   integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
1096   REAL , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inlon, inlat
1097   integer ips,ipe,jps,jpe
1098   integer ims,ime,jms,jme
1099   integer idex,ierr,i,j
1100
1101   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1102     CALL wrf_error_fatal("ext_mcel_georegister: invalid data handle" )
1103   ENDIF
1104   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1105     CALL wrf_error_fatal("ext_mcel_georegister: DataHandle not opened" )
1106   ENDIF
1107   IF ( mcel_finalized( DataHandle ) ) THEN
1108     CALL wrf_error_fatal( "ext_mcel_georegister: called after first read/write operation" ) ;
1109   ENDIF
1110
1111   ips = PatchStart(1) ; ipe = PatchEnd(1)
1112   jps = PatchStart(2) ; jpe = PatchEnd(2)
1113   ims = MemoryStart(1) ; ime = MemoryEnd(1)
1114   jms = MemoryStart(2) ; jme = MemoryEnd(2)
1115
1116   IF ( ALLOCATED(xlat) ) THEN
1117     DEALLOCATE(xlat)
1118   ENDIF
1119   IF ( ALLOCATED(xlong) ) THEN
1120     DEALLOCATE(xlong)
1121   ENDIF
1122   ALLOCATE(xlat(ips:ipe,jps:jpe))
1123   DO j = jps, jpe
1124     DO i = ips, ipe
1125       idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1126       xlat(i,j) = inlat( i,j)  ! idex )
1127     ENDDO
1128   ENDDO
1129   ALLOCATE(xlong(ips:ipe,jps:jpe))
1130   DO j = jps, jpe
1131     DO i = ips, ipe
1132       idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1133       xlong(i,j) = inlon( i,j ) ! idex )
1134     ENDDO
1135   ENDDO
1136   RETURN
1137 END SUBROUTINE ext_mcel_georegister
1138
1139 SUBROUTINE ext_mcel_mask ( DataHandle, inmask,                                          &
1140                            MemoryStart , MemoryEnd ,                                    &
1141                            PatchStart , PatchEnd ,                                      &
1142                            Status )
1143   USE module_ext_mcel
1144   IMPLICIT NONE
1145   integer                       ,intent(in)    :: DataHandle
1146   integer                       ,intent(inout) :: Status
1147   integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
1148   integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
1149   INTEGER , DIMENSION(MemoryStart(1):MemoryEnd(1),MemoryStart(2):MemoryEnd(2)), INTENT(IN) :: inmask
1150   integer ips,ipe,jps,jpe
1151   integer ims,ime,jms,jme
1152   integer idex,ierr,i,j
1153
1154   ips = PatchStart(1) ; ipe = PatchEnd(1)
1155   jps = PatchStart(2) ; jpe = PatchEnd(2)
1156   ims = MemoryStart(1) ; ime = MemoryEnd(1)
1157   jms = MemoryStart(2) ; jme = MemoryEnd(2)
1158
1159   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1160     CALL wrf_error_fatal("ext_mcel_mask: invalid data handle" )
1161   ENDIF
1162   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1163     CALL wrf_error_fatal("ext_mcel_mask: DataHandle not opened" )
1164   ENDIF
1165   IF ( mcel_finalized( DataHandle ) ) THEN
1166     CALL wrf_error_fatal( "ext_mcel_mask: called after first read/write operation" ) ;
1167   ENDIF
1168
1169   IF ( ALLOCATED(mask) ) THEN
1170     DEALLOCATE(mask)
1171   ENDIF
1172   ALLOCATE(mask(ips:ipe,jps:jpe))
1173   DO j = jps, jpe
1174     DO i = ips, ipe
1175       idex = i+ips-ims + (j+jps-jms-1)*(ime-ims+1)
1176       mask(i,j) = inmask( i,j ) ! idex )
1177     ENDDO
1178   ENDDO
1179   RETURN
1180 END SUBROUTINE ext_mcel_mask
1181
1182 INTEGER FUNCTION cast_to_int( a )
1183   INTEGER a
1184   cast_to_int = a
1185   RETURN
1186 END FUNCTION cast_to_int
1187