external/io_int/io_int.F90

   1 ! (old comment from when this file was a template)
   2 ! This is a template for adding a package-dependent implemetnation of
   3 ! the I/O API.  You can use the name xxx since that is already set up
   4 ! as a placeholder in module_io.F, md_calls.m4, and the Registry, or
   5 ! you can change the name here and in those other places.  For additional
   6 ! information on adding a package to WRF, see the latest version of the
   7 ! WRF Design and Implementation Document 1.1 (Draft). June 21, 2001
   8 !
   9 ! Uses header manipulation routines in module_io_quilt.F
  10 !
  11
  12 MODULE module_ext_internal
  13
  14   USE module_internal_header_util
  15
  16   INTEGER, PARAMETER :: int_num_handles = 99
  17   LOGICAL, DIMENSION(int_num_handles) :: okay_for_io, int_handle_in_use, okay_to_commit
  18   INTEGER, DIMENSION(int_num_handles) :: int_num_bytes_to_write
  19 ! first_operation is set to .TRUE. when a new handle is allocated
  20 ! or when open-for-write or open-for-read are committed.  It is set
  21 ! to .FALSE. when the first field is read or written.
  22   LOGICAL, DIMENSION(int_num_handles) :: first_operation
  23 ! TBH:  file_status is checked by routines that call the WRF IOAPI.  It is not
  24 ! TBH:  yet cleanly integrated with okay_for_io, int_handle_in_use,
  25 ! TBH:  okay_to_commit.  Fix this later...
  26   INTEGER, DIMENSION(int_num_handles) :: file_status
  27 ! TBH:  This flag goes along with file_status and is set as early as possible.
  28   LOGICAL, DIMENSION(int_num_handles) :: file_read_only
  29   CHARACTER*128, DIMENSION(int_num_handles) :: CurrentDateInFile
  30   REAL, POINTER    :: int_local_output_buffer(:)
  31   INTEGER          :: int_local_output_cursor
  32
  33   INTEGER, PARAMETER           :: onebyte = 1
  34   INTEGER comm_io_servers, iserver, hdrbufsize, obufsize
  35   INTEGER itypesize, rtypesize, typesize
  36   INTEGER, DIMENSION(512)     :: hdrbuf
  37   INTEGER, DIMENSION(int_num_handles)       :: handle
  38   INTEGER, DIMENSION(512, int_num_handles)  :: open_file_descriptors
  39
  40   CHARACTER*132 last_next_var( int_num_handles )
  41
  42   CONTAINS
  43
  44     LOGICAL FUNCTION int_valid_handle( handle )
  45       IMPLICIT NONE
  46       INTEGER, INTENT(IN) ::  handle
  47       int_valid_handle = ( handle .ge. 8 .and. handle .le. int_num_handles )
  48     END FUNCTION int_valid_handle
  49
  50     SUBROUTINE int_get_fresh_handle( retval )
  51 #include "wrf_io_flags.h"
  52       INTEGER i, retval
  53       retval = -1
  54 ! dont use first 8 handles
  55       DO i = 8, int_num_handles
  56         IF ( .NOT. int_handle_in_use(i) )  THEN
  57           retval = i
  58           GOTO 33
  59         ENDIF
  60       ENDDO
  61 33    CONTINUE
  62       IF ( retval < 0 )  THEN
  63         CALL wrf_error_fatal("io_int.F90: int_get_fresh_handle() can not get new handle")
  64       ENDIF
  65       int_handle_in_use(i) = .TRUE.
  66       first_operation(i) = .TRUE.
  67       file_status(i) = WRF_FILE_NOT_OPENED
  68       NULLIFY ( int_local_output_buffer )
  69     END SUBROUTINE int_get_fresh_handle
  70
  71     SUBROUTINE release_handle( i )
  72 #include "wrf_io_flags.h"
  73       INTEGER, INTENT(IN) :: i
  74       IF ( i .LT. 8 .OR. i .GT. int_num_handles ) RETURN
  75       IF ( .NOT. int_handle_in_use(i) ) RETURN
  76       int_handle_in_use(i) = .FALSE.
  77       RETURN
  78     END SUBROUTINE release_handle
  79
  80
  81
  82     !--- ioinit
  83     SUBROUTINE init_module_ext_internal
  84       IMPLICIT NONE
  85       INTEGER i
  86       CALL wrf_sizeof_integer( itypesize )
  87       CALL wrf_sizeof_real   ( rtypesize )
  88       DO i = 1, int_num_handles
  89          last_next_var( i ) = ' '
  90       ENDDO
  91     END SUBROUTINE init_module_ext_internal
  92
  93 ! Returns .TRUE. iff it is OK to write time-independent domain metadata to the
  94 ! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is
  95 ! returned.
  96 LOGICAL FUNCTION int_ok_to_put_dom_ti( DataHandle )
  97 #include "wrf_io_flags.h"
  98     INTEGER, INTENT(IN) :: DataHandle
  99     CHARACTER*256 :: fname
 100     INTEGER :: filestate
 101     INTEGER :: Status
 102     LOGICAL :: dryrun, first_output, retval
 103     call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
 104     IF ( Status /= 0 ) THEN
 105       retval = .FALSE.
 106     ELSE
 107       dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
 108       first_output = int_is_first_operation( DataHandle )
 109       ! Note that we want to REPLICATE time-independent domain metadata in the
 110       ! output files so the metadata is available during reads.  Fortran
 111       ! unformatted I/O must be sequential because we don't have fixed record
 112       ! lengths.
 113       ! retval = .NOT. dryrun .AND. first_output
 114       retval = .NOT. dryrun
 115     ENDIF
 116     int_ok_to_put_dom_ti = retval
 117     RETURN
 118 END FUNCTION int_ok_to_put_dom_ti
 119
 120 ! Returns .TRUE. iff it is OK to read time-independent domain metadata from the
 121 ! file referenced by DataHandle.  If DataHandle is invalid, .FALSE. is
 122 ! returned.
 123 LOGICAL FUNCTION int_ok_to_get_dom_ti( DataHandle )
 124 #include "wrf_io_flags.h"
 125     INTEGER, INTENT(IN) :: DataHandle
 126     CHARACTER*256 :: fname
 127     INTEGER :: filestate
 128     INTEGER :: Status
 129     LOGICAL :: dryrun, retval
 130     call ext_int_inquire_filename( DataHandle, fname, filestate, Status )
 131     IF ( Status /= 0 ) THEN
 132       retval = .FALSE.
 133     ELSE
 134       dryrun       = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
 135       retval = .NOT. dryrun
 136     ENDIF
 137     int_ok_to_get_dom_ti = retval
 138     RETURN
 139 END FUNCTION int_ok_to_get_dom_ti
 140
 141 ! Returns .TRUE. iff nothing has been read from or written to the file
 142 ! referenced by DataHandle.  If DataHandle is invalid, .FALSE. is returned.
 143 LOGICAL FUNCTION int_is_first_operation( DataHandle )
 144     INTEGER, INTENT(IN) :: DataHandle
 145     LOGICAL :: retval
 146     retval = .FALSE.
 147     IF ( int_valid_handle ( DataHandle ) ) THEN
 148       IF ( int_handle_in_use( DataHandle ) ) THEN
 149         retval = first_operation( DataHandle )
 150       ENDIF
 151     ENDIF
 152     int_is_first_operation = retval
 153     RETURN
 154 END FUNCTION int_is_first_operation
 155
 156 END MODULE module_ext_internal
 157
 158 SUBROUTINE ext_int_ioinit( SysDepInfo, Status )
 159   USE module_ext_internal
 160   IMPLICIT NONE
 161   CHARACTER*(*), INTENT(IN) :: SysDepInfo
 162   INTEGER Status
 163   CALL init_module_ext_internal
 164 END SUBROUTINE ext_int_ioinit
 165
 166 !--- open_for_write
 167 SUBROUTINE ext_int_open_for_write( FileName , Comm_compute, Comm_io, SysDepInfo, &
 168                                    DataHandle , Status )
 169   USE module_ext_internal
 170   IMPLICIT NONE
 171   INCLUDE 'intio_tags.h'
 172   CHARACTER*(*) :: FileName
 173   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
 174   CHARACTER*(*) :: SysDepInfo
 175   INTEGER ,       INTENT(OUT) :: DataHandle
 176   INTEGER ,       INTENT(OUT) :: Status
 177
 178   CALL ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
 179                                      DataHandle , Status )
 180   IF ( Status .NE. 0 ) RETURN
 181   CALL ext_int_open_for_write_commit( DataHandle , Status )
 182   RETURN
 183 END SUBROUTINE ext_int_open_for_write
 184
 185 !--- open_for_write_begin
 186 SUBROUTINE ext_int_open_for_write_begin( FileName , Comm_compute, Comm_io, SysDepInfo, &
 187                                          DataHandle , Status )
 188   USE module_ext_internal
 189   IMPLICIT NONE
 190   INCLUDE 'intio_tags.h'
 191 #include "wrf_io_flags.h"
 192   CHARACTER*(*) :: FileName
 193   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
 194   CHARACTER*(*) :: SysDepInfo
 195   INTEGER ,       INTENT(OUT) :: DataHandle
 196   INTEGER ,       INTENT(OUT) :: Status
 197   INTEGER i, tasks_in_group, ierr, comm_io_group
 198   REAL dummy
 199   INTEGER io_form
 200   CHARACTER*256 :: fname
 201
 202   CALL int_get_fresh_handle(i)
 203   okay_for_io(i) = .false.
 204   DataHandle = i
 205
 206   io_form = 100 ! dummy value
 207   fname = TRIM(FileName)
 208   CALL int_gen_ofwb_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
 209                             fname,SysDepInfo,io_form,DataHandle )
 210
 211   OPEN ( unit=DataHandle, file=TRIM(FileName), form='unformatted', iostat=Status )
 212
 213   file_status(DataHandle) = WRF_FILE_OPENED_NOT_COMMITTED
 214   file_read_only(DataHandle) = .FALSE.
 215
 216   Status = 0
 217   RETURN
 218 END SUBROUTINE ext_int_open_for_write_begin
 219
 220 !--- open_for_write_commit
 221 SUBROUTINE ext_int_open_for_write_commit( DataHandle , Status )
 222   USE module_ext_internal
 223   IMPLICIT NONE
 224   INCLUDE 'intio_tags.h'
 225 #include "wrf_io_flags.h"
 226   INTEGER ,       INTENT(IN ) :: DataHandle
 227   INTEGER ,       INTENT(OUT) :: Status
 228   REAL dummy
 229
 230   IF ( int_valid_handle ( DataHandle ) ) THEN
 231     IF ( int_handle_in_use( DataHandle ) ) THEN
 232       okay_for_io( DataHandle ) = .true.
 233     ENDIF
 234   ENDIF
 235
 236   first_operation( DataHandle ) = .TRUE.
 237   file_status(DataHandle) = WRF_FILE_OPENED_FOR_WRITE
 238
 239   Status = 0
 240
 241   RETURN
 242 END SUBROUTINE ext_int_open_for_write_commit
 243
 244 !--- open_for_read
 245 SUBROUTINE ext_int_open_for_read ( FileName , Comm_compute, Comm_io, SysDepInfo, &
 246                                DataHandle , Status )
 247   USE module_ext_internal
 248   IMPLICIT NONE
 249 #include "wrf_io_flags.h"
 250   CHARACTER*(*) :: FileName
 251   INTEGER ,       INTENT(IN)  :: Comm_compute , Comm_io
 252   CHARACTER*(*) :: SysDepInfo
 253   INTEGER ,       INTENT(OUT) :: DataHandle
 254   INTEGER ,       INTENT(OUT) :: Status
 255   INTEGER i
 256   CHARACTER*256 :: fname
 257
 258   CALL int_get_fresh_handle(i)
 259   DataHandle = i
 260   CurrentDateInFile(i) = ""
 261   fname = TRIM(FileName)
 262
 263   CALL int_gen_ofr_header( open_file_descriptors(1,i), hdrbufsize, itypesize, &
 264                             fname,SysDepInfo,DataHandle )
 265
 266   OPEN ( unit=DataHandle, status="old", file=TRIM(FileName), form='unformatted', iostat=Status )
 267   okay_for_io(DataHandle) = .true.
 268   file_status(DataHandle) = WRF_FILE_OPENED_FOR_READ
 269   file_read_only(DataHandle) = .TRUE.
 270
 271   RETURN
 272 END SUBROUTINE ext_int_open_for_read
 273
 274 !--- inquire_opened
 275 SUBROUTINE ext_int_inquire_opened ( DataHandle, FileName , FileStatus, Status )
 276   USE module_ext_internal
 277   IMPLICIT NONE
 278 #include "wrf_io_flags.h"
 279   INTEGER ,       INTENT(IN)  :: DataHandle
 280   CHARACTER*(*) :: FileName
 281   INTEGER ,       INTENT(OUT) :: FileStatus
 282   INTEGER ,       INTENT(OUT) :: Status
 283   CHARACTER*256 :: fname
 284
 285   Status = 0
 286
 287   CALL ext_int_inquire_filename ( DataHandle, fname, FileStatus, Status )
 288   IF ( fname /= TRIM(FileName) ) THEN
 289     FileStatus = WRF_FILE_NOT_OPENED
 290   ENDIF
 291
 292   Status = 0
 293
 294   RETURN
 295 END SUBROUTINE ext_int_inquire_opened
 296
 297 !--- inquire_filename
 298 SUBROUTINE ext_int_inquire_filename ( DataHandle, FileName , FileStatus, Status )
 299   USE module_ext_internal
 300   IMPLICIT NONE
 301 #include "wrf_io_flags.h"
 302   INTEGER ,       INTENT(IN)  :: DataHandle
 303   CHARACTER*(*) :: FileName
 304   INTEGER ,       INTENT(OUT) :: FileStatus
 305   INTEGER ,       INTENT(OUT) :: Status
 306   CHARACTER *4096   SysDepInfo
 307   INTEGER locDataHandle
 308   CHARACTER*256 :: fname
 309   INTEGER io_form
 310   Status = 0
 311   SysDepInfo = ""
 312   FileStatus = WRF_FILE_NOT_OPENED
 313   FileName = ""
 314   IF ( int_valid_handle( DataHandle ) ) THEN
 315     IF ( int_handle_in_use( DataHandle ) ) THEN
 316       ! Note that the formats for these headers differ.
 317       IF ( file_read_only(DataHandle) ) THEN
 318         CALL int_get_ofr_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
 319                                  fname,SysDepInfo,locDataHandle )
 320       ELSE
 321         CALL int_get_ofwb_header( open_file_descriptors(1,DataHandle), hdrbufsize, itypesize, &
 322                                   fname,SysDepInfo,io_form,locDataHandle )
 323       ENDIF
 324       FileName = TRIM(fname)
 325       FileStatus = file_status(DataHandle)
 326     ENDIF
 327   ENDIF
 328   Status = 0
 329 END SUBROUTINE ext_int_inquire_filename
 330
 331 !--- sync
 332 SUBROUTINE ext_int_iosync ( DataHandle, Status )
 333   USE module_ext_internal
 334   IMPLICIT NONE
 335   INTEGER ,       INTENT(IN)  :: DataHandle
 336   INTEGER ,       INTENT(OUT) :: Status
 337
 338   Status = 0
 339   RETURN
 340 END SUBROUTINE ext_int_iosync
 341
 342 !--- close
 343 SUBROUTINE ext_int_ioclose ( DataHandle, Status )
 344   USE module_ext_internal
 345   IMPLICIT NONE
 346   INTEGER DataHandle, Status
 347
 348   IF ( int_valid_handle (DataHandle) ) THEN
 349     IF ( int_handle_in_use( DataHandle ) ) THEN
 350       CLOSE ( DataHandle )
 351     ENDIF
 352     CALL release_handle(DataHandle)
 353   ENDIF
 354
 355   Status = 0
 356
 357   RETURN
 358 END SUBROUTINE ext_int_ioclose
 359
 360 !--- ioexit
 361 SUBROUTINE ext_int_ioexit( Status )
 362
 363   USE module_ext_internal
 364   IMPLICIT NONE
 365   INCLUDE 'intio_tags.h'
 366   INTEGER ,       INTENT(OUT) :: Status
 367   INTEGER                     :: DataHandle
 368   INTEGER i,ierr
 369   REAL dummy
 370
 371   RETURN
 372 END SUBROUTINE ext_int_ioexit
 373
 374 !--- get_next_time
 375 SUBROUTINE ext_int_get_next_time ( DataHandle, DateStr, Status )
 376   USE module_ext_internal
 377   IMPLICIT NONE
 378   INCLUDE 'intio_tags.h'
 379   INTEGER ,       INTENT(IN)  :: DataHandle
 380   CHARACTER*(*) :: DateStr
 381   INTEGER ,       INTENT(OUT) :: Status
 382   INTEGER         code
 383   CHARACTER*132   locElement, dummyvar
 384   INTEGER istat
 385
 386 !local
 387   INTEGER                        :: locDataHandle
 388   CHARACTER*132                  :: locDateStr
 389   CHARACTER*132                  :: locData
 390   CHARACTER*132                  :: locVarName
 391   integer                        :: locFieldType
 392   integer                        :: locComm
 393   integer                        :: locIOComm
 394   integer                        :: locDomainDesc
 395   character*132                  :: locMemoryOrder
 396   character*132                  :: locStagger
 397   character*132 , dimension (3)  :: locDimNames
 398   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 399   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 400   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 401   integer loccode
 402
 403   character*132 mess
 404   integer ii,jj,kk,myrank
 405   INTEGER inttypesize, realtypesize
 406   REAL, DIMENSION(1)    :: Field  ! dummy
 407
 408   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 409     CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: invalid data handle" )
 410   ENDIF
 411   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 412     CALL wrf_error_fatal("io_int.F90: ext_int_get_next_time: DataHandle not opened" )
 413   ENDIF
 414   inttypesize = itypesize
 415   realtypesize = rtypesize
 416   DO WHILE ( .TRUE. )
 417     READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
 418     IF ( istat .EQ. 0 ) THEN
 419       code = hdrbuf(2)
 420       IF ( code .EQ. int_field ) THEN
 421         CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
 422                                  locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
 423                                  locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
 424                                  locDomainStart , locDomainEnd ,                                    &
 425                                  locMemoryStart , locMemoryEnd ,                                    &
 426                                  locPatchStart , locPatchEnd )
 427         IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN  ! control break, return this date
 428           DateStr = TRIM(locDateStr)
 429           CurrentDateInFile(DataHandle) = TRIM(DateStr)
 430           BACKSPACE ( unit=DataHandle )
 431           Status = 0
 432           GOTO 7717
 433         ELSE
 434           READ( unit=DataHandle, iostat=istat )
 435         ENDIF
 436       ELSE IF ( code .EQ. int_dom_td_char ) THEN
 437         CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
 438                               locDataHandle, locDateStr, locElement, locData, loccode )
 439         IF ( TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle) ) ) THEN  ! control break, return this date
 440           DateStr = TRIM(locDateStr)
 441           CurrentDateInFile(DataHandle) = TRIM(DateStr)
 442           BACKSPACE ( unit=DataHandle )
 443           Status = 0
 444           GOTO 7717
 445         ELSE
 446           READ( unit=DataHandle, iostat=istat )
 447         ENDIF
 448       ENDIF
 449     ELSE
 450       Status = 1
 451       GOTO 7717
 452     ENDIF
 453   ENDDO
 454 7717 CONTINUE
 455
 456   RETURN
 457 END SUBROUTINE ext_int_get_next_time
 458
 459 !--- set_time
 460 SUBROUTINE ext_int_set_time ( DataHandle, DateStr, Status )
 461   USE module_ext_internal
 462   IMPLICIT NONE
 463   INCLUDE 'intio_tags.h'
 464   INTEGER ,       INTENT(IN)  :: DataHandle
 465   CHARACTER*(*) :: DateStr
 466   INTEGER ,       INTENT(OUT) :: Status
 467
 468   CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,        &
 469                                DataHandle, "TIMESTAMP", "", TRIM(DateStr), int_set_time )
 470   WRITE( unit=DataHandle ) hdrbuf
 471   Status = 0
 472   RETURN
 473 END SUBROUTINE ext_int_set_time
 474
 475 !--- get_var_info
 476 SUBROUTINE ext_int_get_var_info ( DataHandle , VarName , NDim , MemoryOrder , Stagger , &
 477                               DomainStart , DomainEnd , WrfType, Status )
 478   USE module_ext_internal
 479   IMPLICIT NONE
 480   INCLUDE 'intio_tags.h'
 481   integer               ,intent(in)     :: DataHandle
 482   character*(*)         ,intent(in)     :: VarName
 483   integer               ,intent(out)    :: NDim
 484   character*(*)         ,intent(out)    :: MemoryOrder
 485   character*(*)         ,intent(out)    :: Stagger
 486   integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
 487   integer               ,intent(out)    :: WrfType
 488   integer               ,intent(out)    :: Status
 489
 490 !local
 491   INTEGER                        :: locDataHandle
 492   CHARACTER*132                  :: locDateStr
 493   CHARACTER*132                  :: locVarName
 494   integer                        :: locFieldType
 495   integer                        :: locComm
 496   integer                        :: locIOComm
 497   integer                        :: locDomainDesc
 498   character*132                  :: locMemoryOrder
 499   character*132                  :: locStagger
 500   character*132 , dimension (3)  :: locDimNames
 501   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 502   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 503   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 504
 505   character*132 mess
 506   integer ii,jj,kk,myrank
 507   INTEGER inttypesize, realtypesize, istat, code
 508   REAL, DIMENSION(1)    :: Field   ! dummy
 509
 510   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 511     CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: invalid data handle" )
 512   ENDIF
 513   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 514     CALL wrf_error_fatal("io_int.F90: ext_int_get_var_info: DataHandle not opened" )
 515   ENDIF
 516   inttypesize = itypesize
 517   realtypesize = rtypesize
 518   DO WHILE ( .TRUE. )
 519     READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
 520     IF ( istat .EQ. 0 ) THEN
 521       code = hdrbuf(2)
 522       IF ( code .EQ. int_field ) THEN
 523         CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
 524                                  locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
 525                                  locDomainDesc , MemoryOrder , locStagger , locDimNames ,              &
 526                                  locDomainStart , locDomainEnd ,                                    &
 527                                  locMemoryStart , locMemoryEnd ,                                    &
 528                                  locPatchStart , locPatchEnd )
 529
 530         IF ( LEN(TRIM(MemoryOrder)) .EQ. 3 ) THEN
 531           NDim = 3
 532         ELSE IF ( LEN(TRIM(MemoryOrder)) .EQ. 2 ) THEN
 533           NDim = 2
 534         ELSE IF ( TRIM(MemoryOrder) .EQ. '0' ) THEN
 535           NDim = 0
 536         ELSE
 537           NDim = 1
 538         ENDIF
 539         Stagger = locStagger
 540         DomainStart(1:3) = locDomainStart(1:3)
 541         DomainEnd(1:3) = locDomainEnd(1:3)
 542         WrfType = locFieldType
 543         BACKSPACE ( unit=DataHandle )
 544         Status = 0
 545         GOTO 7717
 546       else
 547           WRITE(mess,*)'skipping a code=',code,' in ext_int_get_var_info'
 548           CALL wrf_debug(2,mess)
 549       ENDIF
 550     ELSE
 551       Status = 1
 552       GOTO 7717
 553     ENDIF
 554   ENDDO
 555 7717 CONTINUE
 556
 557 RETURN
 558 END SUBROUTINE ext_int_get_var_info
 559
 560 !--- get_next_var
 561 SUBROUTINE ext_int_get_next_var ( DataHandle, VarName, Status )
 562   USE module_ext_internal
 563   IMPLICIT NONE
 564   include 'intio_tags.h'
 565   include 'wrf_status_codes.h'
 566   INTEGER ,       INTENT(IN)  :: DataHandle
 567   CHARACTER*(*) :: VarName
 568   INTEGER ,       INTENT(OUT) :: Status
 569
 570 !local
 571   INTEGER                        :: locDataHandle
 572   CHARACTER*132                  :: locDateStr
 573   CHARACTER*132                  :: locVarName
 574   integer                        :: locFieldType
 575   integer                        :: locComm
 576   integer                        :: locIOComm
 577   integer                        :: locDomainDesc
 578   character*132                  :: locMemoryOrder
 579   character*132                  :: locStagger
 580   character*132 , dimension (3)  :: locDimNames
 581   integer ,dimension(3)          :: locDomainStart, locDomainEnd
 582   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
 583   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
 584
 585 character*128 locElement, strData, dumstr
 586 integer loccode, loccount
 587 integer idata(128)
 588 real    rdata(128)
 589
 590   character*132 mess
 591   integer ii,jj,kk,myrank
 592   INTEGER inttypesize, realtypesize, istat, code
 593   REAL, DIMENSION(1)    :: Field  ! dummy
 594
 595   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
 596     CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: invalid data handle" )
 597   ENDIF
 598   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
 599     CALL wrf_error_fatal("io_int.F90: ext_int_get_next_var: DataHandle not opened" )
 600   ENDIF
 601   inttypesize = itypesize
 602   realtypesize = rtypesize
 603   DO WHILE ( .TRUE. )
 604 7727 CONTINUE
 605     READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
 606     IF ( istat .EQ. 0 ) THEN
 607       code = hdrbuf(2)
 608 #if 1
 609       IF ( code .EQ. int_dom_ti_char ) THEN
 610         CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
 611                                          locDataHandle, locElement, dumstr, strData, loccode )
 612       ENDIF
 613       IF ( code .EQ. int_dom_ti_integer ) THEN
 614         CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
 615                                 locDataHandle, locElement, iData, loccount, code )
 616       ENDIF
 617       IF ( code .EQ. int_dom_ti_real ) THEN
 618         CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
 619                                 locDataHandle, locElement, rData, loccount, code )
 620       ENDIF
 621 #endif
 622       IF ( code .EQ. int_field ) THEN
 623         CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
 624                                  locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
 625                                  locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
 626                                  locDomainStart , locDomainEnd ,                                    &
 627                                  locMemoryStart , locMemoryEnd ,                                    &
 628                                  locPatchStart , locPatchEnd )
 629
 630         IF (TRIM(locDateStr) .NE. TRIM(CurrentDateInFile(DataHandle))) THEN
 631           Status = WRF_WARN_VAR_EOF !-6 ! signal past last var in time frame
 632           BACKSPACE ( unit=DataHandle )
 633           last_next_var( DataHandle )  = ""
 634           GOTO 7717
 635         ELSE
 636           VarName = TRIM(locVarName)
 637           IF ( last_next_var( DataHandle )  .NE. VarName ) THEN
 638             BACKSPACE ( unit=DataHandle )
 639             last_next_var( DataHandle )  = VarName
 640           ELSE
 641             READ( unit=DataHandle, iostat=istat )
 642             GOTO 7727
 643           ENDIF
 644           Status = 0
 645           GOTO 7717
 646         ENDIF
 647       ELSE
 648         GOTO 7727
 649       ENDIF
 650     ELSE
 651       Status = 1
 652       GOTO 7717
 653     ENDIF
 654   ENDDO
 655 7717 CONTINUE
 656   RETURN
 657 END SUBROUTINE ext_int_get_next_var
 658
 659 !--- get_dom_ti_real
 660 SUBROUTINE ext_int_get_dom_ti_real ( DataHandle,Element,   Data, Count, Outcount, Status )
 661   USE module_ext_internal
 662   IMPLICIT NONE
 663   INCLUDE 'intio_tags.h'
 664   INTEGER ,       INTENT(IN)  :: DataHandle
 665   CHARACTER*(*) :: Element
 666   REAL ,          INTENT(OUT) :: Data(*)
 667   INTEGER ,       INTENT(IN)  :: Count
 668   INTEGER ,       INTENT(OUT) :: Outcount
 669   INTEGER ,       INTENT(OUT) :: Status
 670   INTEGER loccount, code, istat, locDataHandle
 671   CHARACTER*132                :: locElement, mess
 672   LOGICAL keepgoing
 673
 674   Status = 0
 675   IF ( int_valid_handle( DataHandle ) ) THEN
 676     IF ( int_handle_in_use( DataHandle ) ) THEN
 677      ! Do nothing unless it is time to read time-independent domain metadata.
 678      IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
 679       keepgoing = .true.
 680       DO WHILE ( keepgoing )
 681         READ( unit=DataHandle , iostat = istat ) hdrbuf
 682         IF ( istat .EQ. 0 ) THEN
 683           code = hdrbuf(2)
 684           IF ( code .EQ. int_dom_ti_real ) THEN
 685             CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
 686                                     locDataHandle, locElement, Data, loccount, code )
 687             IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
 688               IF ( loccount .GT. Count ) THEN
 689                 CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_real: loccount .GT. Count' )
 690               ENDIF
 691               keepgoing = .false. ;  Status = 0
 692             ENDIF
 693           ELSE IF ( .NOT. ( code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_logical .OR. &
 694                             code .EQ. int_dom_ti_char    .OR. code .EQ. int_dom_ti_double  .OR. &
 695                             code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_logical .OR. &
 696                             code .EQ. int_dom_td_char    .OR. code .EQ. int_dom_td_double  .OR. &
 697                             code .EQ. int_dom_td_real                                  ) ) THEN
 698             BACKSPACE ( unit=DataHandle )
 699             keepgoing = .false. ; Status = 2
 700           ENDIF
 701         ELSE
 702           keepgoing = .false. ; Status = 1
 703         ENDIF
 704       ENDDO
 705      ENDIF
 706     ENDIF
 707   ENDIF
 708 RETURN
 709 END SUBROUTINE ext_int_get_dom_ti_real
 710
 711 !--- put_dom_ti_real
 712 SUBROUTINE ext_int_put_dom_ti_real ( DataHandle,Element,   Data, Count,  Status )
 713   USE module_ext_internal
 714   IMPLICIT NONE
 715   INCLUDE 'intio_tags.h'
 716   INTEGER ,       INTENT(IN)  :: DataHandle
 717   CHARACTER*(*) :: Element
 718   REAL ,          INTENT(IN) :: Data(*)
 719   INTEGER ,       INTENT(IN)  :: Count
 720   INTEGER ,       INTENT(OUT) :: Status
 721   REAL dummy
 722 !
 723
 724   IF ( int_valid_handle( DataHandle ) ) THEN
 725     IF ( int_handle_in_use( DataHandle ) ) THEN
 726       ! Do nothing unless it is time to write time-independent domain metadata.
 727       IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
 728         CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
 729                                 DataHandle, Element, Data, Count, int_dom_ti_real )
 730         WRITE( unit=DataHandle ) hdrbuf
 731       ENDIF
 732     ENDIF
 733   ENDIF
 734   Status = 0
 735 RETURN
 736 END SUBROUTINE ext_int_put_dom_ti_real
 737
 738 !--- get_dom_ti_double
 739 SUBROUTINE ext_int_get_dom_ti_double ( DataHandle,Element,   Data, Count, Outcount, Status )
 740   USE module_ext_internal
 741   IMPLICIT NONE
 742   INTEGER ,       INTENT(IN)  :: DataHandle
 743   CHARACTER*(*) :: Element
 744   real*8 ,            INTENT(OUT) :: Data(*)
 745   INTEGER ,       INTENT(IN)  :: Count
 746   INTEGER ,       INTENT(OUT)  :: OutCount
 747   INTEGER ,       INTENT(OUT) :: Status
 748   ! Do nothing unless it is time to read time-independent domain metadata.
 749   IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
 750     CALL wrf_error_fatal('ext_int_get_dom_ti_double not supported yet')
 751   ENDIF
 752 RETURN
 753 END SUBROUTINE ext_int_get_dom_ti_double
 754
 755 !--- put_dom_ti_double
 756 SUBROUTINE ext_int_put_dom_ti_double ( DataHandle,Element,   Data, Count,  Status )
 757   USE module_ext_internal
 758   IMPLICIT NONE
 759   INTEGER ,       INTENT(IN)  :: DataHandle
 760   CHARACTER*(*) :: Element
 761   real*8 ,            INTENT(IN) :: Data(*)
 762   INTEGER ,       INTENT(IN)  :: Count
 763   INTEGER ,       INTENT(OUT) :: Status
 764   ! Do nothing unless it is time to write time-independent domain metadata.
 765   IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
 766     CALL wrf_error_fatal('ext_int_put_dom_ti_double not supported yet')
 767   ENDIF
 768 RETURN
 769 END SUBROUTINE ext_int_put_dom_ti_double
 770
 771 !--- get_dom_ti_integer
 772 SUBROUTINE ext_int_get_dom_ti_integer ( DataHandle,Element,   Data, Count, Outcount, Status )
 773   USE module_ext_internal
 774   IMPLICIT NONE
 775   INCLUDE 'intio_tags.h'
 776   INTEGER ,       INTENT(IN)  :: DataHandle
 777   CHARACTER*(*) :: Element
 778   integer ,            INTENT(OUT) :: Data(*)
 779   INTEGER ,       INTENT(IN)  :: Count
 780   INTEGER ,       INTENT(OUT)  :: OutCount
 781   INTEGER ,       INTENT(OUT) :: Status
 782   INTEGER loccount, code, istat, locDataHandle
 783   CHARACTER*132   locElement, mess
 784   LOGICAL keepgoing
 785
 786   Status = 0
 787   IF ( int_valid_handle( DataHandle ) ) THEN
 788     IF ( int_handle_in_use( DataHandle ) ) THEN
 789      ! Do nothing unless it is time to read time-independent domain metadata.
 790      IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
 791       keepgoing = .true.
 792       DO WHILE ( keepgoing )
 793         READ( unit=DataHandle , iostat = istat ) hdrbuf
 794         IF ( istat .EQ. 0 ) THEN
 795           code = hdrbuf(2)
 796           IF ( code .EQ. int_dom_ti_integer ) THEN
 797             CALL int_get_ti_header( hdrbuf, hdrbufsize, itypesize, rtypesize, &
 798                                     locDataHandle, locElement, Data, loccount, code )
 799             IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
 800               IF ( loccount .GT. Count ) THEN
 801                 CALL wrf_error_fatal( 'io_int.F90: ext_int_get_dom_ti_integer: loccount .GT. Count' )
 802               ENDIF
 803               keepgoing = .false. ;  Status = 0
 804             ENDIF
 805
 806           ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real    .OR.   code .EQ. int_dom_ti_logical .OR. &
 807                             code .EQ. int_dom_ti_char    .OR.   code .EQ. int_dom_ti_double  .OR. &
 808                             code .EQ. int_dom_td_real    .OR.   code .EQ. int_dom_td_logical .OR. &
 809                             code .EQ. int_dom_td_char    .OR.   code .EQ. int_dom_td_double  .OR. &
 810                             code .EQ. int_dom_td_integer )                                           ) THEN
 811             BACKSPACE ( unit=DataHandle )
 812             keepgoing = .false. ; Status = 1
 813           ENDIF
 814         ELSE
 815           keepgoing = .false. ; Status = 1
 816         ENDIF
 817       ENDDO
 818      ENDIF
 819     ENDIF
 820   ENDIF
 821 RETURN
 822 END SUBROUTINE ext_int_get_dom_ti_integer
 823
 824 !--- put_dom_ti_integer
 825 SUBROUTINE ext_int_put_dom_ti_integer ( DataHandle,Element,   Data, Count,  Status )
 826   USE module_ext_internal
 827   IMPLICIT NONE
 828   INCLUDE 'intio_tags.h'
 829   INTEGER ,       INTENT(IN)  :: DataHandle
 830   CHARACTER*(*) :: Element
 831   INTEGER ,       INTENT(IN) :: Data(*)
 832   INTEGER ,       INTENT(IN)  :: Count
 833   INTEGER ,       INTENT(OUT) :: Status
 834   REAL dummy
 835 !
 836   IF ( int_valid_handle ( Datahandle ) ) THEN
 837     IF ( int_handle_in_use( DataHandle ) ) THEN
 838       ! Do nothing unless it is time to write time-independent domain metadata.
 839       IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
 840         CALL int_gen_ti_header( hdrbuf, hdrbufsize, itypesize, itypesize, &
 841                                 DataHandle, Element, Data, Count, int_dom_ti_integer )
 842         WRITE( unit=DataHandle ) hdrbuf
 843       ENDIF
 844     ENDIF
 845   ENDIF
 846   Status = 0
 847 RETURN
 848 END SUBROUTINE ext_int_put_dom_ti_integer
 849
 850 !--- get_dom_ti_logical
 851 SUBROUTINE ext_int_get_dom_ti_logical ( DataHandle,Element,   Data, Count, Outcount, Status )
 852   USE module_ext_internal
 853   IMPLICIT NONE
 854   INTEGER ,       INTENT(IN)  :: DataHandle
 855   CHARACTER*(*) :: Element
 856   logical ,            INTENT(OUT) :: Data(*)
 857   INTEGER ,       INTENT(IN)  :: Count
 858   INTEGER ,       INTENT(OUT)  :: OutCount
 859   INTEGER ,       INTENT(OUT) :: Status
 860   ! Do nothing unless it is time to read time-independent domain metadata.
 861   IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
 862     CALL wrf_message('ext_int_get_dom_ti_logical not supported yet')
 863   ENDIF
 864 RETURN
 865 END SUBROUTINE ext_int_get_dom_ti_logical
 866
 867 !--- put_dom_ti_logical
 868 SUBROUTINE ext_int_put_dom_ti_logical ( DataHandle,Element,   Data, Count,  Status )
 869   USE module_ext_internal
 870   IMPLICIT NONE
 871   INTEGER ,       INTENT(IN)  :: DataHandle
 872   CHARACTER*(*) :: Element
 873   logical ,            INTENT(IN) :: Data(*)
 874   INTEGER ,       INTENT(IN)  :: Count
 875   INTEGER ,       INTENT(OUT) :: Status
 876   ! Do nothing unless it is time to write time-independent domain metadata.
 877   IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
 878     CALL wrf_message('ext_int_put_dom_ti_logical not supported yet')
 879   ENDIF
 880 RETURN
 881 END SUBROUTINE ext_int_put_dom_ti_logical
 882
 883 !--- get_dom_ti_char
 884 SUBROUTINE ext_int_get_dom_ti_char ( DataHandle,Element,   Data,  Status )
 885   USE module_ext_internal
 886   IMPLICIT NONE
 887   INCLUDE 'intio_tags.h'
 888   INTEGER ,       INTENT(IN)  :: DataHandle
 889   CHARACTER*(*) :: Element
 890   CHARACTER*(*) :: Data
 891   INTEGER ,       INTENT(OUT) :: Status
 892   INTEGER istat, code, i
 893   CHARACTER*79 dumstr, locElement
 894   INTEGER locDataHandle
 895   LOGICAL keepgoing
 896
 897   Status = 0
 898   IF ( int_valid_handle( DataHandle ) ) THEN
 899     IF ( int_handle_in_use( DataHandle ) ) THEN
 900      ! Do nothing unless it is time to read time-independent domain metadata.
 901      IF ( int_ok_to_get_dom_ti( DataHandle ) ) THEN
 902       keepgoing = .true.
 903       DO WHILE ( keepgoing )
 904         READ( unit=DataHandle , iostat = istat ) hdrbuf
 905
 906         IF ( istat .EQ. 0 ) THEN
 907           code = hdrbuf(2)
 908           IF ( code .EQ. int_dom_ti_char ) THEN
 909             CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
 910                                          locDataHandle, locElement, dumstr, Data, code )
 911             IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
 912               keepgoing = .false. ;  Status = 0
 913             ENDIF
 914           ELSE IF ( .NOT. ( code .EQ. int_dom_ti_real    .OR. code .EQ. int_dom_ti_logical .OR. &
 915                             code .EQ. int_dom_ti_integer .OR. code .EQ. int_dom_ti_double  .OR. &
 916                             code .EQ. int_dom_td_real    .OR. code .EQ. int_dom_td_logical .OR. &
 917                             code .EQ. int_dom_td_integer .OR. code .EQ. int_dom_td_double  .OR. &
 918                             code .EQ. int_dom_td_char                                             ) ) THEN
 919             BACKSPACE ( unit=DataHandle )
 920             keepgoing = .false. ; Status = 1
 921           ENDIF
 922         ELSE
 923           keepgoing = .false. ; Status = 1
 924         ENDIF
 925       ENDDO
 926      ENDIF
 927     ENDIF
 928   ENDIF
 929 RETURN
 930 END SUBROUTINE ext_int_get_dom_ti_char
 931
 932 !--- put_dom_ti_char
 933 SUBROUTINE ext_int_put_dom_ti_char ( DataHandle, Element,  Data,  Status )
 934   USE module_ext_internal
 935   IMPLICIT NONE
 936   INCLUDE 'intio_tags.h'
 937   INTEGER ,       INTENT(IN)  :: DataHandle
 938   CHARACTER*(*) :: Element
 939   CHARACTER*(*) :: Data
 940   INTEGER ,       INTENT(OUT) :: Status
 941   INTEGER i
 942   REAL dummy
 943   INTEGER                 :: Count
 944
 945   IF ( int_valid_handle ( Datahandle ) ) THEN
 946     IF ( int_handle_in_use( DataHandle ) ) THEN
 947       ! Do nothing unless it is time to write time-independent domain metadata.
 948       IF ( int_ok_to_put_dom_ti( DataHandle ) ) THEN
 949         CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
 950                                      DataHandle, Element, "", Data, int_dom_ti_char )
 951         WRITE( unit=DataHandle ) hdrbuf
 952       ENDIF
 953     ENDIF
 954   ENDIF
 955   Status = 0
 956 RETURN
 957 END SUBROUTINE ext_int_put_dom_ti_char
 958
 959 !--- get_dom_td_real
 960 SUBROUTINE ext_int_get_dom_td_real ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 961   IMPLICIT NONE
 962   INTEGER ,       INTENT(IN)  :: DataHandle
 963   CHARACTER*(*) :: Element
 964   CHARACTER*(*) :: DateStr
 965   real ,            INTENT(OUT) :: Data(*)
 966   INTEGER ,       INTENT(IN)  :: Count
 967   INTEGER ,       INTENT(OUT)  :: OutCount
 968   INTEGER ,       INTENT(OUT) :: Status
 969 RETURN
 970 END SUBROUTINE ext_int_get_dom_td_real
 971
 972 !--- put_dom_td_real
 973 SUBROUTINE ext_int_put_dom_td_real ( DataHandle,Element, DateStr,  Data, Count,  Status )
 974   IMPLICIT NONE
 975   INTEGER ,       INTENT(IN)  :: DataHandle
 976   CHARACTER*(*) :: Element
 977   CHARACTER*(*) :: DateStr
 978   real ,            INTENT(IN) :: Data(*)
 979   INTEGER ,       INTENT(IN)  :: Count
 980   INTEGER ,       INTENT(OUT) :: Status
 981 RETURN
 982 END SUBROUTINE ext_int_put_dom_td_real
 983
 984 !--- get_dom_td_double
 985 SUBROUTINE ext_int_get_dom_td_double ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
 986   IMPLICIT NONE
 987   INTEGER ,       INTENT(IN)  :: DataHandle
 988   CHARACTER*(*) :: Element
 989   CHARACTER*(*) :: DateStr
 990   real*8 ,            INTENT(OUT) :: Data(*)
 991   INTEGER ,       INTENT(IN)  :: Count
 992   INTEGER ,       INTENT(OUT)  :: OutCount
 993   INTEGER ,       INTENT(OUT) :: Status
 994     CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
 995 RETURN
 996 END SUBROUTINE ext_int_get_dom_td_double
 997
 998 !--- put_dom_td_double
 999 SUBROUTINE ext_int_put_dom_td_double ( DataHandle,Element, DateStr,  Data, Count,  Status )
1000   IMPLICIT NONE
1001   INTEGER ,       INTENT(IN)  :: DataHandle
1002   CHARACTER*(*) :: Element
1003   CHARACTER*(*) :: DateStr
1004   real*8 ,            INTENT(IN) :: Data(*)
1005   INTEGER ,       INTENT(IN)  :: Count
1006   INTEGER ,       INTENT(OUT) :: Status
1007     CALL wrf_error_fatal('ext_int_get_dom_td_double not supported yet')
1008 RETURN
1009 END SUBROUTINE ext_int_put_dom_td_double
1010
1011 !--- get_dom_td_integer
1012 SUBROUTINE ext_int_get_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1013   IMPLICIT NONE
1014   INTEGER ,       INTENT(IN)  :: DataHandle
1015   CHARACTER*(*) :: Element
1016   CHARACTER*(*) :: DateStr
1017   integer ,            INTENT(OUT) :: Data(*)
1018   INTEGER ,       INTENT(IN)  :: Count
1019   INTEGER ,       INTENT(OUT)  :: OutCount
1020   INTEGER ,       INTENT(OUT) :: Status
1021 RETURN
1022 END SUBROUTINE ext_int_get_dom_td_integer
1023
1024 !--- put_dom_td_integer
1025 SUBROUTINE ext_int_put_dom_td_integer ( DataHandle,Element, DateStr,  Data, Count,  Status )
1026   IMPLICIT NONE
1027   INTEGER ,       INTENT(IN)  :: DataHandle
1028   CHARACTER*(*) :: Element
1029   CHARACTER*(*) :: DateStr
1030   integer ,            INTENT(IN) :: Data(*)
1031   INTEGER ,       INTENT(IN)  :: Count
1032   INTEGER ,       INTENT(OUT) :: Status
1033 RETURN
1034 END SUBROUTINE ext_int_put_dom_td_integer
1035
1036 !--- get_dom_td_logical
1037 SUBROUTINE ext_int_get_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count, Outcount, Status )
1038   IMPLICIT NONE
1039   INTEGER ,       INTENT(IN)  :: DataHandle
1040   CHARACTER*(*) :: Element
1041   CHARACTER*(*) :: DateStr
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_int_get_dom_td_logical
1048
1049 !--- put_dom_td_logical
1050 SUBROUTINE ext_int_put_dom_td_logical ( DataHandle,Element, DateStr,  Data, Count,  Status )
1051   IMPLICIT NONE
1052   INTEGER ,       INTENT(IN)  :: DataHandle
1053   CHARACTER*(*) :: Element
1054   CHARACTER*(*) :: DateStr
1055   logical ,            INTENT(IN) :: Data(*)
1056   INTEGER ,       INTENT(IN)  :: Count
1057   INTEGER ,       INTENT(OUT) :: Status
1058 RETURN
1059 END SUBROUTINE ext_int_put_dom_td_logical
1060
1061 !--- get_dom_td_char
1062 SUBROUTINE ext_int_get_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
1063   USE module_ext_internal
1064   IMPLICIT NONE
1065   INCLUDE 'intio_tags.h'
1066   INTEGER ,       INTENT(IN)  :: DataHandle
1067   CHARACTER*(*) :: Element
1068   CHARACTER*(*) :: Data, DateStr
1069   INTEGER ,       INTENT(OUT) :: Status
1070   INTEGER istat, code, i
1071   CHARACTER*79 dumstr, locElement, locDatestr
1072   INTEGER locDataHandle
1073   LOGICAL keepgoing
1074
1075   IF ( int_valid_handle( DataHandle ) ) THEN
1076     IF ( int_handle_in_use( DataHandle ) ) THEN
1077       keepgoing = .true.
1078       DO WHILE ( keepgoing )
1079         READ( unit=DataHandle , iostat = istat ) hdrbuf
1080
1081         IF ( istat .EQ. 0 ) THEN
1082           code = hdrbuf(2)
1083           IF ( code .EQ. int_dom_td_char ) THEN
1084             CALL int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
1085                                          locDataHandle, locDateStr, locElement, Data, code )
1086             IF ( TRIM(locElement) .EQ. TRIM(Element) ) THEN
1087               keepgoing = .false. ;  Status = 0
1088             ENDIF
1089           ELSE
1090             BACKSPACE ( unit=DataHandle )
1091             keepgoing = .false. ; Status = 1
1092           ENDIF
1093         ELSE
1094           keepgoing = .false. ; Status = 1
1095         ENDIF
1096       ENDDO
1097     ENDIF
1098   ENDIF
1099 RETURN
1100 END SUBROUTINE ext_int_get_dom_td_char
1101
1102 !--- put_dom_td_char
1103 SUBROUTINE ext_int_put_dom_td_char ( DataHandle,Element, DateStr,  Data,  Status )
1104   USE module_ext_internal
1105   IMPLICIT NONE
1106   INCLUDE 'intio_tags.h'
1107   INTEGER ,       INTENT(IN)  :: DataHandle
1108   CHARACTER*(*) :: Element
1109   CHARACTER*(*) :: Data, DateStr
1110   INTEGER ,       INTENT(OUT) :: Status
1111   INTEGER i
1112   REAL dummy
1113   INTEGER                 :: Count
1114   IF ( int_valid_handle ( Datahandle ) ) THEN
1115     IF ( int_handle_in_use( DataHandle ) ) THEN
1116       CALL int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize,  &
1117                                    DataHandle, DateStr, Element, Data, int_dom_td_char )
1118       WRITE( unit=DataHandle ) hdrbuf
1119     ENDIF
1120   ENDIF
1121   Status = 0
1122 RETURN
1123 END SUBROUTINE ext_int_put_dom_td_char
1124
1125 !--- get_var_ti_real
1126 SUBROUTINE ext_int_get_var_ti_real ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1127   IMPLICIT NONE
1128   INTEGER ,       INTENT(IN)  :: DataHandle
1129   CHARACTER*(*) :: Element
1130   CHARACTER*(*) :: VarName
1131   real ,            INTENT(OUT) :: Data(*)
1132   INTEGER ,       INTENT(IN)  :: Count
1133   INTEGER ,       INTENT(OUT)  :: OutCount
1134   INTEGER ,       INTENT(OUT) :: Status
1135 RETURN
1136 END SUBROUTINE ext_int_get_var_ti_real
1137
1138 !--- put_var_ti_real
1139 SUBROUTINE ext_int_put_var_ti_real ( DataHandle,Element,  Varname, Data, Count,  Status )
1140   IMPLICIT NONE
1141   INTEGER ,       INTENT(IN)  :: DataHandle
1142   CHARACTER*(*) :: Element
1143   CHARACTER*(*) :: VarName
1144   real ,            INTENT(IN) :: Data(*)
1145   INTEGER ,       INTENT(IN)  :: Count
1146   INTEGER ,       INTENT(OUT) :: Status
1147 RETURN
1148 END SUBROUTINE ext_int_put_var_ti_real
1149
1150 !--- get_var_ti_double
1151 SUBROUTINE ext_int_get_var_ti_double ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1152   IMPLICIT NONE
1153   INTEGER ,       INTENT(IN)  :: DataHandle
1154   CHARACTER*(*) :: Element
1155   CHARACTER*(*) :: VarName
1156   real*8 ,            INTENT(OUT) :: Data(*)
1157   INTEGER ,       INTENT(IN)  :: Count
1158   INTEGER ,       INTENT(OUT)  :: OutCount
1159   INTEGER ,       INTENT(OUT) :: Status
1160     CALL wrf_error_fatal('ext_int_get_var_ti_double not supported yet')
1161 RETURN
1162 END SUBROUTINE ext_int_get_var_ti_double
1163
1164 !--- put_var_ti_double
1165 SUBROUTINE ext_int_put_var_ti_double ( DataHandle,Element,  Varname, Data, Count,  Status )
1166   IMPLICIT NONE
1167   INTEGER ,       INTENT(IN)  :: DataHandle
1168   CHARACTER*(*) :: Element
1169   CHARACTER*(*) :: VarName
1170   real*8 ,            INTENT(IN) :: Data(*)
1171   INTEGER ,       INTENT(IN)  :: Count
1172   INTEGER ,       INTENT(OUT) :: Status
1173     CALL wrf_error_fatal('ext_int_put_var_ti_double not supported yet')
1174 RETURN
1175 END SUBROUTINE ext_int_put_var_ti_double
1176
1177 !--- get_var_ti_integer
1178 SUBROUTINE ext_int_get_var_ti_integer ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1179   USE module_ext_internal
1180   IMPLICIT NONE
1181 #include "intio_tags.h"
1182   INTEGER ,       INTENT(IN)  :: DataHandle
1183   CHARACTER*(*) :: Element
1184   CHARACTER*(*) :: VarName
1185   integer ,            INTENT(OUT) :: Data(*)
1186   INTEGER ,       INTENT(IN)  :: Count
1187   INTEGER ,       INTENT(OUT)  :: OutCount
1188   INTEGER ,       INTENT(OUT) :: Status
1189   INTEGER locDataHandle, code
1190   CHARACTER*132 locElement, locVarName
1191   IF ( int_valid_handle (DataHandle) ) THEN
1192      IF ( int_handle_in_use( DataHandle ) ) THEN
1193         READ( unit=DataHandle ) hdrbuf
1194         code=hdrbuf(2)
1195         IF ( code .NE. int_var_ti_integer ) THEN
1196            BACKSPACE ( unit=DataHandle )
1197            write(*,*) 'unexpected code=',code,' in ext_int_get_var_ti_integer'
1198            Status = 1
1199            return
1200         ENDIF
1201         CALL int_get_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize, typesize, &
1202              locDataHandle, locElement, locVarName, Data, Outcount, code )
1203      ELSE
1204         Status = 1
1205         write(*,*) 'int_handle_in_use(DataHandle)=.False. in ext_int_get_var_ti_integer'
1206         return
1207      ENDIF
1208   ELSE
1209      Status = 1
1210      write(*,*) 'int_valid_handle(DataHandle)=.False. in ext_int_get_var_ti_integer'
1211      return
1212   ENDIF
1213   Status = 0
1214 RETURN
1215 END SUBROUTINE ext_int_get_var_ti_integer
1216
1217 !--- put_var_ti_integer
1218 SUBROUTINE ext_int_put_var_ti_integer ( DataHandle,Element,  Varname, Data, Count,  Status )
1219   USE module_ext_internal
1220   USE module_internal_header_util, only: int_gen_ti_header_integer_varna
1221   IMPLICIT NONE
1222 #include "intio_tags.h"
1223   INTEGER ,       INTENT(IN)  :: DataHandle
1224   CHARACTER*(*) :: Element
1225   CHARACTER*(*) :: VarName
1226   integer ,            INTENT(IN) :: Data(*)
1227   INTEGER ,       INTENT(IN)  :: Count
1228   INTEGER ,       INTENT(OUT) :: Status
1229   IF ( int_valid_handle (DataHandle) ) THEN
1230     IF ( int_handle_in_use( DataHandle ) ) THEN
1231       CALL int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize,4,  &
1232                               DataHandle, TRIM(Element), TRIM(VarName), Data, Count, &
1233                               int_var_ti_integer )
1234       WRITE( unit=DataHandle ) hdrbuf
1235     ENDIF
1236   ENDIF
1237   Status = 0
1238 RETURN
1239 END SUBROUTINE ext_int_put_var_ti_integer
1240
1241 !--- get_var_ti_logical
1242 SUBROUTINE ext_int_get_var_ti_logical ( DataHandle,Element,  Varname, Data, Count, Outcount, Status )
1243   IMPLICIT NONE
1244   INTEGER ,       INTENT(IN)  :: DataHandle
1245   CHARACTER*(*) :: Element
1246   CHARACTER*(*) :: VarName
1247   logical ,            INTENT(OUT) :: Data(*)
1248   INTEGER ,       INTENT(IN)  :: Count
1249   INTEGER ,       INTENT(OUT)  :: OutCount
1250   INTEGER ,       INTENT(OUT) :: Status
1251 RETURN
1252 END SUBROUTINE ext_int_get_var_ti_logical
1253
1254 !--- put_var_ti_logical
1255 SUBROUTINE ext_int_put_var_ti_logical ( DataHandle,Element,  Varname, Data, Count,  Status )
1256   IMPLICIT NONE
1257   INTEGER ,       INTENT(IN)  :: DataHandle
1258   CHARACTER*(*) :: Element
1259   CHARACTER*(*) :: VarName
1260   logical ,            INTENT(IN) :: Data(*)
1261   INTEGER ,       INTENT(IN)  :: Count
1262   INTEGER ,       INTENT(OUT) :: Status
1263 RETURN
1264 END SUBROUTINE ext_int_put_var_ti_logical
1265
1266 !--- get_var_ti_char
1267 SUBROUTINE ext_int_get_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
1268   USE module_ext_internal
1269   IMPLICIT NONE
1270   INCLUDE 'intio_tags.h'
1271   INTEGER ,       INTENT(IN)  :: DataHandle
1272   CHARACTER*(*) :: Element
1273   CHARACTER*(*) :: VarName
1274   CHARACTER*(*) :: Data
1275   INTEGER ,       INTENT(OUT) :: Status
1276   INTEGER locDataHandle, code
1277   CHARACTER*132 locElement, locVarName
1278   IF ( int_valid_handle (DataHandle) ) THEN
1279     IF ( int_handle_in_use( DataHandle ) ) THEN
1280       READ( unit=DataHandle ) hdrbuf
1281        code=hdrbuf(2)
1282        IF ( code .NE. int_var_ti_char ) THEN
1283           BACKSPACE ( unit=DataHandle )
1284           Status = 1
1285           return
1286        ENDIF
1287        CALL int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
1288             locDataHandle, locElement, locVarName, Data, code )
1289     ELSE
1290        Status = 1
1291        return
1292     ENDIF
1293  ELSE
1294     Status = 1
1295     return
1296  ENDIF
1297   Status = 0
1298 RETURN
1299 END SUBROUTINE ext_int_get_var_ti_char
1300
1301 !--- put_var_ti_char
1302 SUBROUTINE ext_int_put_var_ti_char ( DataHandle,Element,  Varname, Data,  Status )
1303   USE module_ext_internal
1304   IMPLICIT NONE
1305   INCLUDE 'intio_tags.h'
1306   INTEGER ,       INTENT(IN)  :: DataHandle
1307   CHARACTER*(*) :: Element
1308   CHARACTER*(*) :: VarName
1309   CHARACTER*(*) :: Data
1310   INTEGER ,       INTENT(OUT) :: Status
1311   REAL dummy
1312   INTEGER                 :: Count
1313   IF ( int_valid_handle (DataHandle) ) THEN
1314     IF ( int_handle_in_use( DataHandle ) ) THEN
1315       CALL int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize,  &
1316                               DataHandle, TRIM(Element), TRIM(VarName), TRIM(Data), int_var_ti_char )
1317       WRITE( unit=DataHandle ) hdrbuf
1318     ENDIF
1319   ENDIF
1320   Status = 0
1321 RETURN
1322 END SUBROUTINE ext_int_put_var_ti_char
1323
1324 !--- get_var_td_real
1325 SUBROUTINE ext_int_get_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1326   IMPLICIT NONE
1327   INTEGER ,       INTENT(IN)  :: DataHandle
1328   CHARACTER*(*) :: Element
1329   CHARACTER*(*) :: DateStr
1330   CHARACTER*(*) :: VarName
1331   real ,            INTENT(OUT) :: Data(*)
1332   INTEGER ,       INTENT(IN)  :: Count
1333   INTEGER ,       INTENT(OUT)  :: OutCount
1334   INTEGER ,       INTENT(OUT) :: Status
1335 RETURN
1336 END SUBROUTINE ext_int_get_var_td_real
1337
1338 !--- put_var_td_real
1339 SUBROUTINE ext_int_put_var_td_real ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1340   IMPLICIT NONE
1341   INTEGER ,       INTENT(IN)  :: DataHandle
1342   CHARACTER*(*) :: Element
1343   CHARACTER*(*) :: DateStr
1344   CHARACTER*(*) :: VarName
1345   real ,            INTENT(IN) :: Data(*)
1346   INTEGER ,       INTENT(IN)  :: Count
1347   INTEGER ,       INTENT(OUT) :: Status
1348 RETURN
1349 END SUBROUTINE ext_int_put_var_td_real
1350
1351 !--- get_var_td_double
1352 SUBROUTINE ext_int_get_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1353   IMPLICIT NONE
1354   INTEGER ,       INTENT(IN)  :: DataHandle
1355   CHARACTER*(*) :: Element
1356   CHARACTER*(*) :: DateStr
1357   CHARACTER*(*) :: VarName
1358   real*8 ,            INTENT(OUT) :: Data(*)
1359   INTEGER ,       INTENT(IN)  :: Count
1360   INTEGER ,       INTENT(OUT)  :: OutCount
1361   INTEGER ,       INTENT(OUT) :: Status
1362     CALL wrf_error_fatal('ext_int_get_var_td_double not supported yet')
1363 RETURN
1364 END SUBROUTINE ext_int_get_var_td_double
1365
1366 !--- put_var_td_double
1367 SUBROUTINE ext_int_put_var_td_double ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1368   IMPLICIT NONE
1369   INTEGER ,       INTENT(IN)  :: DataHandle
1370   CHARACTER*(*) :: Element
1371   CHARACTER*(*) :: DateStr
1372   CHARACTER*(*) :: VarName
1373   real*8 ,            INTENT(IN) :: Data(*)
1374   INTEGER ,       INTENT(IN)  :: Count
1375   INTEGER ,       INTENT(OUT) :: Status
1376     CALL wrf_error_fatal('ext_int_put_var_td_double not supported yet')
1377 RETURN
1378 END SUBROUTINE ext_int_put_var_td_double
1379
1380 !--- get_var_td_integer
1381 SUBROUTINE ext_int_get_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1382   IMPLICIT NONE
1383   INTEGER ,       INTENT(IN)  :: DataHandle
1384   CHARACTER*(*) :: Element
1385   CHARACTER*(*) :: DateStr
1386   CHARACTER*(*) :: VarName
1387   integer ,            INTENT(OUT) :: Data(*)
1388   INTEGER ,       INTENT(IN)  :: Count
1389   INTEGER ,       INTENT(OUT)  :: OutCount
1390   INTEGER ,       INTENT(OUT) :: Status
1391 RETURN
1392 END SUBROUTINE ext_int_get_var_td_integer
1393
1394 !--- put_var_td_integer
1395 SUBROUTINE ext_int_put_var_td_integer ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1396   IMPLICIT NONE
1397   INTEGER ,       INTENT(IN)  :: DataHandle
1398   CHARACTER*(*) :: Element
1399   CHARACTER*(*) :: DateStr
1400   CHARACTER*(*) :: VarName
1401   integer ,            INTENT(IN) :: Data(*)
1402   INTEGER ,       INTENT(IN)  :: Count
1403   INTEGER ,       INTENT(OUT) :: Status
1404 RETURN
1405 END SUBROUTINE ext_int_put_var_td_integer
1406
1407 !--- get_var_td_logical
1408 SUBROUTINE ext_int_get_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count, Outcount, Status )
1409   IMPLICIT NONE
1410   INTEGER ,       INTENT(IN)  :: DataHandle
1411   CHARACTER*(*) :: Element
1412   CHARACTER*(*) :: DateStr
1413   CHARACTER*(*) :: VarName
1414   logical ,            INTENT(OUT) :: Data(*)
1415   INTEGER ,       INTENT(IN)  :: Count
1416   INTEGER ,       INTENT(OUT)  :: OutCount
1417   INTEGER ,       INTENT(OUT) :: Status
1418 RETURN
1419 END SUBROUTINE ext_int_get_var_td_logical
1420
1421 !--- put_var_td_logical
1422 SUBROUTINE ext_int_put_var_td_logical ( DataHandle,Element,  DateStr,Varname, Data, Count,  Status )
1423   IMPLICIT NONE
1424   INTEGER ,       INTENT(IN)  :: DataHandle
1425   CHARACTER*(*) :: Element
1426   CHARACTER*(*) :: DateStr
1427   CHARACTER*(*) :: VarName
1428   logical ,            INTENT(IN) :: Data(*)
1429   INTEGER ,       INTENT(IN)  :: Count
1430   INTEGER ,       INTENT(OUT) :: Status
1431 RETURN
1432 END SUBROUTINE ext_int_put_var_td_logical
1433
1434 !--- get_var_td_char
1435 SUBROUTINE ext_int_get_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1436   IMPLICIT NONE
1437   INTEGER ,       INTENT(IN)  :: DataHandle
1438   CHARACTER*(*) :: Element
1439   CHARACTER*(*) :: DateStr
1440   CHARACTER*(*) :: VarName
1441   CHARACTER*(*) :: Data
1442   INTEGER ,       INTENT(OUT) :: Status
1443 RETURN
1444 END SUBROUTINE ext_int_get_var_td_char
1445
1446 !--- put_var_td_char
1447 SUBROUTINE ext_int_put_var_td_char ( DataHandle,Element,  DateStr,Varname, Data,  Status )
1448   IMPLICIT NONE
1449   INTEGER ,       INTENT(IN)  :: DataHandle
1450   CHARACTER*(*) :: Element
1451   CHARACTER*(*) :: DateStr
1452   CHARACTER*(*) :: VarName
1453   CHARACTER*(*) :: Data
1454   INTEGER ,       INTENT(OUT) :: Status
1455 RETURN
1456 END SUBROUTINE ext_int_put_var_td_char
1457
1458 !--- read_field
1459 SUBROUTINE ext_int_read_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm, &
1460                             DomainDesc , MemoryOrder , Stagger , DimNames ,              &
1461                             DomainStart , DomainEnd ,                                    &
1462                             MemoryStart , MemoryEnd ,                                    &
1463                             PatchStart , PatchEnd ,                                      &
1464                             Status )
1465   USE module_ext_internal
1466   IMPLICIT NONE
1467 #include "wrf_io_flags.h"
1468   include 'intio_tags.h'
1469   INTEGER ,       INTENT(IN)    :: DataHandle
1470   CHARACTER*(*) :: DateStr
1471   CHARACTER*(*) :: VarName
1472   integer                       ,intent(inout)    :: FieldType
1473   integer                       ,intent(inout) :: Comm
1474   integer                       ,intent(inout) :: IOComm
1475   integer                       ,intent(inout)    :: DomainDesc
1476   character*(*)                 ,intent(inout)    :: MemoryOrder
1477   character*(*)                 ,intent(inout)    :: Stagger
1478   character*(*) , dimension (*) ,intent(inout)    :: DimNames
1479   integer ,dimension(*)         ,intent(inout)    :: DomainStart, DomainEnd
1480   integer ,dimension(*)         ,intent(inout)    :: MemoryStart, MemoryEnd
1481   integer ,dimension(*)         ,intent(inout)    :: PatchStart,  PatchEnd
1482   integer                       ,intent(out)   :: Status
1483
1484 !local
1485   INTEGER                        :: locDataHandle
1486   CHARACTER*132                  :: locDateStr
1487   CHARACTER*132                  :: locVarName
1488   integer                        :: locFieldType
1489   integer                        :: locComm
1490   integer                        :: locIOComm
1491   integer                        :: locDomainDesc
1492   character*132                  :: locMemoryOrder
1493   character*132                  :: locStagger
1494   character*132 , dimension (3)  :: locDimNames
1495   integer ,dimension(3)          :: locDomainStart, locDomainEnd
1496   integer ,dimension(3)          :: locMemoryStart, locMemoryEnd
1497   integer ,dimension(3)          :: locPatchStart,  locPatchEnd
1498
1499   character*132 mess
1500
1501   integer ii,jj,kk,myrank
1502
1503
1504   REAL, DIMENSION(*)    :: Field
1505
1506   INTEGER inttypesize, realtypesize, istat, code
1507
1508   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1509     CALL wrf_error_fatal("io_int.F90: ext_int_read_field: invalid data handle" )
1510   ENDIF
1511   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1512     CALL wrf_error_fatal("io_int.F90: ext_int_read_field: DataHandle not opened" )
1513   ENDIF
1514
1515   inttypesize = itypesize
1516   realtypesize = rtypesize
1517
1518   DO WHILE ( .TRUE. )
1519     READ( unit=DataHandle, iostat=istat ) hdrbuf   ! this is okay as long as no other record type has data that follows
1520     IF ( istat .EQ. 0 ) THEN
1521       code = hdrbuf(2)
1522       IF ( code .EQ. int_field ) THEN
1523         CALL int_get_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
1524                                  locDataHandle , locDateStr , locVarName , Field , locFieldType , locComm , locIOComm,  &
1525                                  locDomainDesc , locMemoryOrder , locStagger , locDimNames ,              &
1526                                  locDomainStart , locDomainEnd ,                                    &
1527                                  locMemoryStart , locMemoryEnd ,                                    &
1528                                  locPatchStart , locPatchEnd )
1529         IF ( TRIM(locVarName) .EQ. TRIM(VarName) ) THEN
1530           IF      ( FieldType .EQ. WRF_REAL ) THEN
1531             CALL rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1532           ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1533             CALL ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1534           ELSE
1535             CALL wrf_message('io_int.F90: ext_int_read_field: types other than WRF_REAL not supported yet')
1536             READ( unit=DataHandle )
1537           ENDIF
1538         ELSE
1539           WRITE(mess,*)'ext_int_read_field: ',TRIM(locVarName),' NE ',TRIM(VarName)
1540           CALL wrf_message(mess)
1541           READ( unit=DataHandle )
1542         ENDIF
1543         Status = 0
1544         GOTO 7717
1545       ENDIF
1546     ELSE
1547       Status = 1
1548       GOTO 7717
1549     ENDIF
1550   ENDDO
1551
1552 7717 CONTINUE
1553
1554   first_operation( DataHandle ) = .FALSE.
1555   RETURN
1556
1557 END SUBROUTINE ext_int_read_field
1558
1559 !--- write_field
1560 SUBROUTINE ext_int_write_field ( DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
1561                              DomainDesc , MemoryOrder , Stagger , DimNames ,              &
1562                              DomainStart , DomainEnd ,                                    &
1563                              MemoryStart , MemoryEnd ,                                    &
1564                              PatchStart , PatchEnd ,                                      &
1565                              Status )
1566   USE module_ext_internal
1567   IMPLICIT NONE
1568 #include "wrf_io_flags.h"
1569   INTEGER ,       INTENT(IN)    :: DataHandle
1570   CHARACTER*(*) :: DateStr
1571   CHARACTER*(*) :: VarName
1572   integer                       ,intent(in)    :: FieldType
1573   integer                       ,intent(inout) :: Comm
1574   integer                       ,intent(inout) :: IOComm
1575   integer                       ,intent(in)    :: DomainDesc
1576   character*(*)                 ,intent(in)    :: MemoryOrder
1577   character*(*)                 ,intent(in)    :: Stagger
1578   character*(*) , dimension (*) ,intent(in)    :: DimNames
1579   integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
1580   integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
1581   integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
1582   integer                       ,intent(out)   :: Status
1583
1584   integer ii,jj,kk,myrank
1585
1586 !  REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1587 !                   MemoryStart(2):MemoryEnd(2), &
1588 !                   MemoryStart(3):MemoryEnd(3) ) :: Field
1589
1590   REAL, DIMENSION(*)    :: Field
1591
1592   INTEGER inttypesize, realtypesize
1593
1594   IF ( .NOT. int_valid_handle( DataHandle ) ) THEN
1595     CALL wrf_error_fatal("io_int.F90: ext_int_write_field: invalid data handle" )
1596   ENDIF
1597   IF ( .NOT. int_handle_in_use( DataHandle ) ) THEN
1598     CALL wrf_error_fatal("io_int.F90: ext_int_write_field: DataHandle not opened" )
1599   ENDIF
1600
1601   inttypesize = itypesize
1602   realtypesize = rtypesize
1603   IF      ( FieldType .EQ. WRF_REAL .OR. FieldType .EQ. WRF_DOUBLE) THEN
1604     typesize = rtypesize
1605   ELSE IF ( FieldType .EQ. WRF_DOUBLE ) THEN
1606     CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_DOUBLE not yet supported')
1607   ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1608     typesize = itypesize
1609   ELSE IF ( FieldType .EQ. WRF_LOGICAL ) THEN
1610     CALL wrf_error_fatal( 'io_int.F90: ext_int_write_field, WRF_LOGICAL not yet supported')
1611   ENDIF
1612
1613   IF ( okay_for_io( DataHandle ) ) THEN
1614
1615     CALL int_gen_write_field_header ( hdrbuf, hdrbufsize, inttypesize, typesize,           &
1616                              DataHandle , DateStr , VarName , Field , FieldType , Comm , IOComm,  &
1617                              DomainDesc , MemoryOrder , Stagger , DimNames ,              &
1618                              DomainStart , DomainEnd ,                                    &
1619                              MemoryStart , MemoryEnd ,                                    &
1620                              PatchStart , PatchEnd )
1621     WRITE( unit=DataHandle ) hdrbuf
1622     IF      ( FieldType .EQ. WRF_REAL ) THEN
1623       CALL rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1624     ELSE IF ( FieldType .EQ. WRF_INTEGER ) THEN
1625       CALL ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1626     ENDIF
1627   ENDIF
1628   first_operation( DataHandle ) = .FALSE.
1629   Status = 0
1630   RETURN
1631 END SUBROUTINE ext_int_write_field
1632
1633 SUBROUTINE rfieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1634   INTEGER ,       INTENT(IN)    :: DataHandle
1635   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
1636   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
1637   REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1638                    MemoryStart(2):MemoryEnd(2), &
1639                    MemoryStart(3):MemoryEnd(3) ) :: Field
1640   WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1641   RETURN
1642 END SUBROUTINE rfieldwrite
1643
1644 SUBROUTINE ifieldwrite( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1645   INTEGER ,       INTENT(IN)    :: DataHandle
1646   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
1647   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
1648   INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1649                       MemoryStart(2):MemoryEnd(2), &
1650                       MemoryStart(3):MemoryEnd(3) ) :: Field
1651   WRITE( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1652   RETURN
1653 END SUBROUTINE ifieldwrite
1654
1655 SUBROUTINE rfieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1656   INTEGER ,       INTENT(IN)    :: DataHandle
1657   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
1658   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
1659   REAL, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1660                    MemoryStart(2):MemoryEnd(2), &
1661                    MemoryStart(3):MemoryEnd(3) ) :: Field
1662   READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1663   RETURN
1664 END SUBROUTINE rfieldread
1665
1666 SUBROUTINE ifieldread( DataHandle, Field, MemoryStart, MemoryEnd, PatchStart, PatchEnd )
1667   INTEGER ,       INTENT(IN)    :: DataHandle
1668   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: MemoryStart, MemoryEnd
1669   INTEGER ,DIMENSION(*)         ,INTENT(IN)    :: PatchStart,  PatchEnd
1670   INTEGER, DIMENSION( MemoryStart(1):MemoryEnd(1), &
1671                       MemoryStart(2):MemoryEnd(2), &
1672                       MemoryStart(3):MemoryEnd(3) ) :: Field
1673   READ( unit=DataHandle ) Field(PatchStart(1):PatchEnd(1),PatchStart(2):PatchEnd(2),PatchStart(3):PatchEnd(3))
1674   RETURN
1675 END SUBROUTINE ifieldread
1676