external/io_pio/wrf_io.F90

   1 !------------------------------------------------------------------
   2 !$Id$
   3 !------------------------------------------------------------------
   4
   5 subroutine ext_pio_open_for_read(DatasetName, grid, SysDepInfo, DataHandle, Status)
   6   use wrf_data_pio
   7   use pio_routines
   8   use module_domain
   9   implicit none
  10   include 'wrf_status_codes.h'
  11   character *(*), INTENT(IN)   :: DatasetName
  12   TYPE(domain)                 :: grid
  13   character *(*), INTENT(IN)   :: SysDepInfo
  14   integer       , INTENT(OUT)  :: DataHandle
  15   integer       , INTENT(OUT)  :: Status
  16   DataHandle = 0   ! dummy setting to quiet warning message
  17   CALL ext_pio_open_for_read_begin( DatasetName, grid, SysDepInfo, DataHandle, Status )
  18   IF ( Status .EQ. WRF_NO_ERR ) THEN
  19     CALL ext_pio_open_for_read_commit( DataHandle, Status )
  20   ENDIF
  21   return
  22 end subroutine ext_pio_open_for_read
  23
  24 !ends training phase; switches internal flag to enable input
  25 !must be paired with call to ext_pio_open_for_read_begin
  26 subroutine ext_pio_open_for_read_commit(DataHandle, Status)
  27   use wrf_data_pio
  28   use pio_routines
  29   implicit none
  30   include 'wrf_status_codes.h'
  31   integer, intent(in) :: DataHandle
  32   integer, intent(out) :: Status
  33   type(wrf_data_handle) ,pointer         :: DH
  34
  35   if(WrfIOnotInitialized) then
  36     Status = WRF_IO_NOT_INITIALIZED
  37     write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
  38     call wrf_debug ( FATAL , msg)
  39     return
  40   endif
  41   call GetDH(DataHandle,DH,Status)
  42   if(Status /= WRF_NO_ERR) then
  43     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
  44     call wrf_debug ( WARN , TRIM(msg))
  45     return
  46   endif
  47   DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
  48   Status = WRF_NO_ERR
  49   return
  50 end subroutine ext_pio_open_for_read_commit
  51
  52 subroutine upgrade_filename(FileName)
  53   implicit none
  54
  55   character*(*), intent(inout) :: FileName
  56   integer :: i
  57
  58   do i = 1, len(trim(FileName))
  59      if(FileName(i:i) == '-') then
  60         FileName(i:i) = '_'
  61      else if(FileName(i:i) == ':') then
  62         FileName(i:i) = '_'
  63      endif
  64   enddo
  65
  66 end subroutine upgrade_filename
  67
  68 subroutine ext_pio_open_for_read_begin( FileName, grid, SysDepInfo, DataHandle, Status)
  69   use wrf_data_pio
  70   use pio_routines
  71   use module_domain
  72   implicit none
  73   include 'wrf_status_codes.h'
  74   character*(*)         ,intent(INOUT)   :: FileName
  75   TYPE(domain)                           :: grid
  76   character*(*)         ,intent(in)      :: SysDepInfo
  77   integer               ,intent(out)     :: DataHandle
  78   integer               ,intent(out)     :: Status
  79   type(wrf_data_handle) ,pointer         :: DH
  80   integer                                :: XType
  81   integer                                :: stat
  82   integer                                :: StoredDim
  83   integer                                :: NAtts
  84   integer                                :: DimIDs(2)
  85   integer                                :: VStart(2)
  86   integer                                :: VLen(2)
  87   integer                                :: TotalNumVars
  88   integer                                :: NumVars
  89   integer                                :: i
  90   integer                                :: ndims, unlimitedDimID
  91   character(PIO_MAX_NAME)                :: Name
  92
  93   call upgrade_filename(FileName)
  94
  95   if(WrfIOnotInitialized) then
  96     Status = WRF_IO_NOT_INITIALIZED
  97     write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
  98     call wrf_debug ( FATAL , msg)
  99     return
 100   endif
 101   call allocHandle(DataHandle,DH,Status)
 102   if(Status /= WRF_NO_ERR) then
 103     write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
 104     call wrf_debug ( WARN , TRIM(msg))
 105     return
 106   endif
 107
 108   if(DH%first_operation) then
 109      call initialize_pio(grid, DH)
 110      call define_pio_iodesc(grid, DH)
 111      DH%first_operation = .false.
 112   end if
 113
 114   stat = pio_openfile(DH%iosystem, DH%file_handle, pio_iotype_pnetcdf, FileName)
 115   call netcdf_err(stat,Status)
 116   if(Status /= WRF_NO_ERR) then
 117      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 118      call wrf_debug ( WARN , TRIM(msg))
 119      return
 120   endif
 121
 122   stat = pio_inq_varid(DH%file_handle, DH%TimesName, DH%vtime)
 123   call netcdf_err(stat,Status)
 124   if(Status /= WRF_NO_ERR) then
 125      write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 126      call wrf_debug ( WARN , TRIM(msg))
 127      return
 128   endif
 129
 130   stat = pio_inquire_variable(DH%file_handle, DH%vtime, DH%TimesName, XType, StoredDim, DimIDs, NAtts)
 131   call netcdf_err(stat,Status)
 132   if(Status /= WRF_NO_ERR) then
 133     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 134     call wrf_debug ( WARN , TRIM(msg))
 135     return
 136   endif
 137   if(XType/=PIO_CHAR) then
 138     Status = WRF_WARN_TYPE_MISMATCH
 139     write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 140     call wrf_debug ( WARN , TRIM(msg))
 141     return
 142   endif
 143   stat = pio_inq_dimlen(DH%file_handle, DimIDs(1), VLen(1))
 144   call netcdf_err(stat,Status)
 145   if(Status /= WRF_NO_ERR) then
 146     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 147     call wrf_debug ( WARN , TRIM(msg))
 148     return
 149   endif
 150   if(VLen(1) /= DateStrLen) then
 151     Status = WRF_WARN_DATESTR_BAD_LENGTH
 152     write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
 153     call wrf_debug ( WARN , TRIM(msg))
 154     return
 155   endif
 156
 157   stat = pio_inq_dimlen(DH%file_handle, DimIDs(2), VLen(2))
 158   call netcdf_err(stat,Status)
 159   if(Status /= WRF_NO_ERR) then
 160     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 161     call wrf_debug ( WARN , TRIM(msg))
 162     return
 163   endif
 164   if(VLen(2) > MaxTimes) then
 165     Status = WRF_ERR_FATAL_TOO_MANY_TIMES
 166     write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
 167     call wrf_debug ( FATAL , TRIM(msg))
 168     return
 169   endif
 170
 171   VStart(1) = 1
 172   VStart(2) = 1
 173   stat = pio_get_var(DH%file_handle, DH%vtime, DH%Times(1:VLen(2)))
 174   call netcdf_err(stat,Status)
 175   if(Status /= WRF_NO_ERR) then
 176     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 177     call wrf_debug ( WARN , TRIM(msg))
 178     return
 179   endif
 180
 181   stat = pio_inquire(DH%file_handle, ndims, TotalNumVars, NAtts, unlimitedDimID)
 182   call netcdf_err(stat,Status)
 183   if(Status /= WRF_NO_ERR) then
 184     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 185     call wrf_debug ( WARN , TRIM(msg))
 186     return
 187   endif
 188
 189   NumVars = 0
 190   do i=1,TotalNumVars
 191     stat = pio_inq_varname(DH%file_handle,i,Name)
 192     call netcdf_err(stat,Status)
 193     if(Status /= WRF_NO_ERR) then
 194       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 195       call wrf_debug ( WARN , TRIM(msg))
 196       return
 197     elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
 198       NumVars              = NumVars+1
 199       DH%VarNames(NumVars) = Name
 200       DH%VarIDs(NumVars)   = i
 201     endif
 202   enddo
 203   DH%NumVars         = NumVars
 204   DH%NumberTimes     = VLen(2)
 205   DH%FileStatus      = WRF_FILE_OPENED_NOT_COMMITTED
 206   DH%FileName        = trim(FileName)
 207   DH%CurrentVariable = 0
 208   DH%CurrentTime     = 0
 209   DH%TimeIndex       = 0
 210
 211   do i = 1, ndims
 212     DH%DimIDs(i) = i
 213     stat = pio_inq_dimname(DH%file_handle,i,DH%DimNames(i))
 214     if(Status /= WRF_NO_ERR) then
 215       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 216       call wrf_debug ( WARN , TRIM(msg))
 217       return
 218     endif
 219
 220     if(unlimitedDimID == i) then
 221        DH%DimUnlimID = unlimitedDimID
 222        DH%DimUnlimName = DH%DimNames(i)
 223     endif
 224   enddo
 225   DH%NumDims = ndims
 226   return
 227 end subroutine ext_pio_open_for_read_begin
 228
 229 subroutine ext_pio_open_for_update( FileName, grid, SysDepInfo, DataHandle, Status)
 230   use wrf_data_pio
 231   use pio_routines
 232   use module_domain
 233   implicit none
 234   include 'wrf_status_codes.h'
 235   character*(*)         ,intent(INOUT)   :: FileName
 236   TYPE(domain)                           :: grid
 237   character*(*)         ,intent(in)      :: SysDepInfo
 238   integer               ,intent(out)     :: DataHandle
 239   integer               ,intent(out)     :: Status
 240   type(wrf_data_handle) ,pointer         :: DH
 241   integer                                :: XType
 242   integer                                :: stat
 243   integer                                :: StoredDim
 244   integer                                :: NAtts
 245   integer                                :: DimIDs(2)
 246   integer                                :: VStart(2)
 247   integer                                :: VLen(2)
 248   integer                                :: TotalNumVars
 249   integer                                :: NumVars
 250   integer                                :: i
 251   integer                                :: ndims, unlimitedDimID
 252   character(PIO_MAX_NAME)                :: Name
 253
 254   call upgrade_filename(FileName)
 255
 256   if(WrfIOnotInitialized) then
 257     Status = WRF_IO_NOT_INITIALIZED
 258     write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
 259     call wrf_debug ( FATAL , msg)
 260     return
 261   endif
 262   call allocHandle(DataHandle,DH,Status)
 263   if(Status /= WRF_NO_ERR) then
 264     write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
 265     call wrf_debug ( WARN , TRIM(msg))
 266     return
 267   endif
 268
 269   if(DH%first_operation) then
 270      call initialize_pio(grid, DH)
 271      call define_pio_iodesc(grid, DH)
 272      DH%first_operation = .false.
 273   end if
 274
 275   stat = pio_openfile(DH%iosystem, DH%file_handle, pio_iotype_pnetcdf, FileName)
 276   call netcdf_err(stat,Status)
 277   if(Status /= WRF_NO_ERR) then
 278     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 279     call wrf_debug ( WARN , TRIM(msg))
 280     return
 281   endif
 282   stat = pio_inq_varid(DH%file_handle, DH%TimesName, DH%vtime)
 283   call netcdf_err(stat,Status)
 284   if(Status /= WRF_NO_ERR) then
 285     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 286     call wrf_debug ( WARN , TRIM(msg))
 287     return
 288   endif
 289   stat = pio_inquire_variable(DH%file_handle, DH%vtime, DH%TimesName, &
 290                               XType, StoredDim, DimIDs, NAtts)
 291   call netcdf_err(stat,Status)
 292   if(Status /= WRF_NO_ERR) then
 293     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 294     call wrf_debug ( WARN , TRIM(msg))
 295     return
 296   endif
 297   if(XType/=PIO_CHAR) then
 298     Status = WRF_WARN_TYPE_MISMATCH
 299     write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 300     call wrf_debug ( WARN , TRIM(msg))
 301     return
 302   endif
 303   stat = pio_inq_dimlen(DH%file_handle, DimIDs(1), VLen(1))
 304   call netcdf_err(stat,Status)
 305   if(Status /= WRF_NO_ERR) then
 306     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 307     call wrf_debug ( WARN , TRIM(msg))
 308     return
 309   endif
 310   if(VLen(1) /= DateStrLen) then
 311     Status = WRF_WARN_DATESTR_BAD_LENGTH
 312     write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
 313     call wrf_debug ( WARN , TRIM(msg))
 314     return
 315   endif
 316   stat = pio_inq_dimlen(DH%file_handle, DimIDs(2), VLen(2))
 317   call netcdf_err(stat,Status)
 318   if(Status /= WRF_NO_ERR) then
 319     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 320     call wrf_debug ( WARN , TRIM(msg))
 321     return
 322   endif
 323   if(VLen(2) > MaxTimes) then
 324     Status = WRF_ERR_FATAL_TOO_MANY_TIMES
 325     write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
 326     call wrf_debug ( FATAL , TRIM(msg))
 327     return
 328   endif
 329   VStart(1) = 1
 330   VStart(2) = 1
 331  !stat = pio_get_var(DH%file_handle, DH%vtime, VStart, VLen, DH%Times)
 332   stat = pio_get_var(DH%file_handle, DH%vtime, DH%Times)
 333   call netcdf_err(stat,Status)
 334   if(Status /= WRF_NO_ERR) then
 335     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 336     call wrf_debug ( WARN , TRIM(msg))
 337     return
 338   endif
 339   stat = pio_inquire(DH%file_handle, ndims, TotalNumVars, NAtts, unlimitedDimID)
 340   call netcdf_err(stat,Status)
 341   if(Status /= WRF_NO_ERR) then
 342     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 343     call wrf_debug ( WARN , TRIM(msg))
 344     return
 345   endif
 346   NumVars = 0
 347   do i=1,TotalNumVars
 348     stat = pio_inq_varname(DH%file_handle, i, Name)
 349     call netcdf_err(stat,Status)
 350     if(Status /= WRF_NO_ERR) then
 351       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 352       call wrf_debug ( WARN , TRIM(msg))
 353       return
 354     elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
 355       NumVars              = NumVars+1
 356       DH%VarNames(NumVars) = Name
 357       DH%VarIDs(NumVars)   = i
 358     endif
 359   enddo
 360   DH%NumVars         = NumVars
 361   DH%NumberTimes     = VLen(2)
 362   DH%FileStatus      = WRF_FILE_OPENED_FOR_UPDATE
 363   DH%FileName        = trim(FileName)
 364   DH%CurrentVariable = 0
 365   DH%CurrentTime     = 0
 366   DH%TimeIndex       = 0
 367   return
 368 end subroutine ext_pio_open_for_update
 369
 370
 371 SUBROUTINE ext_pio_open_for_write_begin(FileName,grid,SysDepInfo,DataHandle,Status)
 372   use pio_types
 373   use pio
 374   use wrf_data_pio
 375   use pio_routines
 376   use module_domain
 377   implicit none
 378   include 'wrf_status_codes.h'
 379   character*(*)        ,intent(inout) :: FileName
 380   TYPE(domain)                      :: grid
 381   character*(*)        ,intent(in)  :: SysDepInfo
 382   integer              ,intent(out) :: DataHandle
 383   integer              ,intent(out) :: Status
 384   type(wrf_data_handle),pointer     :: DH
 385   integer                           :: i
 386   integer                           :: stat
 387   character (7)                     :: Buffer
 388   integer                           :: VDimIDs(2)
 389   integer                           :: info, ierr   ! added for Blue Gene (see PIO_CREAT below)
 390   character*128                     :: idstr,ntasks_x_str,loccomm_str
 391   integer                           :: gridid
 392   integer local_communicator_x, ntasks_x
 393
 394   call upgrade_filename(FileName)
 395
 396   if(WrfIOnotInitialized) then
 397     Status = WRF_IO_NOT_INITIALIZED
 398     write(msg,*) 'ext_pio_open_for_write_begin: ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
 399     call wrf_debug ( FATAL , msg)
 400     return
 401   endif
 402   call allocHandle(DataHandle,DH,Status)
 403   if(Status /= WRF_NO_ERR) then
 404     write(msg,*) 'Fatal ALLOCATION ERROR in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__
 405     call wrf_debug ( FATAL , TRIM(msg))
 406     return
 407   endif
 408   DH%TimeIndex = 0
 409   DH%Times     = ZeroDate
 410
 411   if(DH%first_operation) then
 412      call initialize_pio(grid, DH)
 413      call define_pio_iodesc(grid, DH)
 414      DH%first_operation = .false.
 415   end if
 416
 417  !call mpi_info_create( info, ierr )
 418   stat = pio_CreateFile(DH%iosystem, DH%file_handle, &
 419                         pio_iotype_pnetcdf, FileName, PIO_64BIT_OFFSET)
 420  !call mpi_info_free( info, ierr)
 421
 422   call netcdf_err(stat,Status)
 423
 424   if(Status /= WRF_NO_ERR) then
 425     write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__
 426     call wrf_debug ( WARN , TRIM(msg))
 427     return
 428   endif
 429
 430  !JPE added for performance
 431  !stat = nf90_set_fill(DH%file_handle, NF90_NOFILL, i)
 432
 433   DH%FileStatus  = WRF_FILE_OPENED_NOT_COMMITTED
 434   DH%FileName    = trim(FileName)
 435   stat = pio_def_dim(DH%file_handle, DH%DimUnlimName, PIO_UNLIMITED, DH%DimUnlimID)
 436  !stat = pio_def_dim(DH%file_handle, DH%DimUnlimName, 1, DH%DimUnlimID)
 437   call netcdf_err(stat,Status)
 438   if(Status /= WRF_NO_ERR) then
 439     write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__
 440     call wrf_debug ( WARN , TRIM(msg))
 441     return
 442   endif
 443
 444   DH%VarNames  (1:MaxVars) = NO_NAME
 445   do i=1,MaxDims
 446     write(Buffer,FMT="('DIM',i4.4)") i
 447     DH%DimNames  (i) = Buffer
 448     DH%DimLengths(i) = NO_DIM
 449   enddo
 450
 451   DH%DimNames(1) = 'DateStrLen'
 452   stat = pio_def_dim(DH%file_handle, DH%DimNames(1), DateStrLen, DH%DimIDs(1))
 453   call netcdf_err(stat,Status)
 454   if(Status /= WRF_NO_ERR) then
 455     write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__
 456     call wrf_debug ( WARN , TRIM(msg))
 457     return
 458   endif
 459
 460   VDimIDs(1) = DH%DimIDs(1)
 461   VDimIDs(2) = DH%DimUnlimID
 462   stat = pio_def_var(DH%file_handle,DH%TimesName,PIO_CHAR,VDimIDs,DH%vtime)
 463   call netcdf_err(stat,Status)
 464   if(Status /= WRF_NO_ERR) then
 465     write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__
 466     call wrf_debug ( WARN , TRIM(msg))
 467     return
 468   endif
 469   DH%DimLengths(1) = DateStrLen
 470
 471   return
 472 end subroutine ext_pio_open_for_write_begin
 473
 474 !opens a file for writing or coupler datastream for sending messages.
 475 !no training phase for this version of the open stmt.
 476 subroutine ext_pio_open_for_write (DatasetName, grid, &
 477                                    SysDepInfo, DataHandle, Status)
 478   use wrf_data_pio
 479   use pio_routines
 480   use module_domain
 481   implicit none
 482   include 'wrf_status_codes.h'
 483   character *(*), intent(in)  :: DatasetName
 484   type(domain)                :: grid
 485   character *(*), intent(in)  :: SysDepInfo
 486   integer       , intent(out) :: DataHandle
 487   integer       , intent(out) :: Status
 488   Status=WRF_WARN_NOOP
 489   DataHandle = 0    ! dummy setting to quiet warning message
 490   return
 491 end subroutine ext_pio_open_for_write
 492
 493 SUBROUTINE ext_pio_open_for_write_commit(DataHandle, Status)
 494   use wrf_data_pio
 495   use pio_routines
 496   implicit none
 497   include 'wrf_status_codes.h'
 498   integer              ,intent(in)  :: DataHandle
 499   integer              ,intent(out) :: Status
 500   type(wrf_data_handle),pointer     :: DH
 501   integer                           :: i
 502   integer                           :: stat
 503
 504   if(WrfIOnotInitialized) then
 505     Status = WRF_IO_NOT_INITIALIZED
 506     write(msg,*) 'ext_pio_open_for_write_commit: ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
 507     call wrf_debug ( FATAL , msg)
 508     return
 509   endif
 510   call GetDH(DataHandle,DH,Status)
 511   if(Status /= WRF_NO_ERR) then
 512     write(msg,*) 'Warning Status = ',Status,' in ext_pio_open_for_write_commit ',__FILE__,', line', __LINE__
 513     call wrf_debug ( WARN , TRIM(msg))
 514     return
 515   endif
 516   DH%Write = .true.
 517   stat = pio_enddef(DH%file_handle)
 518   call netcdf_err(stat,Status)
 519   if(Status /= WRF_NO_ERR) then
 520     write(msg,*) 'NetCDF error (',stat,') from pio_enddef in ext_pio_open_for_write_commit ',__FILE__,', line', __LINE__
 521     call wrf_debug ( WARN , TRIM(msg))
 522     return
 523   endif
 524   DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE
 525
 526   return
 527 end subroutine ext_pio_open_for_write_commit
 528
 529 subroutine ext_pio_ioclose(DataHandle, Status)
 530   use wrf_data_pio
 531   use pio_routines
 532   use pio
 533   use pio_kinds
 534   implicit none
 535   include 'wrf_status_codes.h'
 536   integer              ,intent(in)  :: DataHandle
 537   integer              ,intent(out) :: Status
 538   type(wrf_data_handle),pointer     :: DH
 539   integer                           :: stat
 540
 541   call GetDH(DataHandle,DH,Status)
 542   if(Status /= WRF_NO_ERR) then
 543     write(msg,*) 'Warning Status = ',Status,' in ext_pio_ioclose ',__FILE__,', line', __LINE__
 544     call wrf_debug ( WARN , TRIM(msg))
 545     return
 546   endif
 547   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 548     Status = WRF_WARN_FILE_NOT_OPENED
 549     write(msg,*) 'Warning FILE NOT OPENED in ext_pio_ioclose ',__FILE__,', line', __LINE__
 550     call wrf_debug ( WARN , TRIM(msg))
 551   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 552     Status = WRF_WARN_DRYRUN_CLOSE
 553     write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_pio_ioclose ',__FILE__,', line', __LINE__
 554     call wrf_debug ( WARN , TRIM(msg))
 555   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
 556     continue
 557   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 558     continue
 559   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
 560     continue
 561   else
 562     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 563     write(msg,*) 'Fatal error BAD FILE STATUS in ext_pio_ioclose ',__FILE__,', line', __LINE__
 564     call wrf_debug ( FATAL , TRIM(msg))
 565     return
 566   endif
 567
 568   call pio_closefile(DH%file_handle)
 569   CALL deallocHandle( DataHandle, Status )
 570   DH%Free=.true.
 571   return
 572 end subroutine ext_pio_ioclose
 573
 574 subroutine ext_pio_iosync( DataHandle, Status)
 575   use pio_kinds
 576   use pio
 577   use wrf_data_pio
 578   use pio_routines
 579   implicit none
 580   include 'wrf_status_codes.h'
 581   integer              ,intent(in)  :: DataHandle
 582   integer              ,intent(out) :: Status
 583   type(wrf_data_handle),pointer     :: DH
 584   integer                           :: stat
 585
 586   call GetDH(DataHandle,DH,Status)
 587   if(Status /= WRF_NO_ERR) then
 588     write(msg,*) 'Warning Status = ',Status,' in ext_pio_iosync ',__FILE__,', line', __LINE__
 589     call wrf_debug ( WARN , TRIM(msg))
 590     return
 591   endif
 592   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 593     Status = WRF_WARN_FILE_NOT_OPENED
 594     write(msg,*) 'Warning FILE NOT OPENED in ext_pio_iosync ',__FILE__,', line', __LINE__
 595     call wrf_debug ( WARN , TRIM(msg))
 596   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 597     Status = WRF_WARN_FILE_NOT_COMMITTED
 598     write(msg,*) 'Warning FILE NOT COMMITTED in ext_pio_iosync ',__FILE__,', line', __LINE__
 599     call wrf_debug ( WARN , TRIM(msg))
 600   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
 601     continue
 602   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 603     continue
 604   else
 605     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 606     write(msg,*) 'Fatal error BAD FILE STATUS in ext_pio_iosync ',__FILE__,', line', __LINE__
 607     call wrf_debug ( FATAL , TRIM(msg))
 608     return
 609   endif
 610   call pio_syncfile(DH%file_handle)
 611   call netcdf_err(stat,Status)
 612   if(Status /= WRF_NO_ERR) then
 613     write(msg,*) 'NetCDF error in ext_pio_iosync ',__FILE__,', line', __LINE__
 614     call wrf_debug ( WARN , TRIM(msg))
 615     return
 616   endif
 617   return
 618 end subroutine ext_pio_iosync
 619
 620 subroutine ext_pio_ioinit(SysDepInfo, Status)
 621   use wrf_data_pio
 622   implicit none
 623   include 'wrf_status_codes.h'
 624   CHARACTER*(*), INTENT(IN) :: SysDepInfo
 625   INTEGER ,INTENT(INOUT)    :: Status
 626
 627   WrfIOnotInitialized                             = .false.
 628   WrfDataHandles(1:WrfDataHandleMax)%Free         = .true.
 629   WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times'
 630   WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'
 631   WrfDataHandles(1:WrfDataHandleMax)%FileStatus   = WRF_FILE_NOT_OPENED
 632   Status = WRF_NO_ERR
 633   return
 634 end subroutine ext_pio_ioinit
 635
 636 subroutine ext_pio_inquiry (Inquiry, Result, Status)
 637   use wrf_data_pio
 638   implicit none
 639   include 'wrf_status_codes.h'
 640   character *(*), INTENT(IN)    :: Inquiry
 641   character *(*), INTENT(OUT)   :: Result
 642   integer        ,INTENT(INOUT) :: Status
 643   SELECT CASE (Inquiry)
 644   CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ")
 645         Result='ALLOW'
 646   CASE ("OPEN_READ","OPEN_COMMIT_WRITE")
 647         Result='REQUIRE'
 648   CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO")
 649         Result='NO'
 650   CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
 651         Result='YES'
 652   CASE ("MEDIUM")
 653         Result ='FILE'
 654   CASE DEFAULT
 655       Result = 'No Result for that inquiry!'
 656   END SELECT
 657   Status=WRF_NO_ERR
 658   return
 659 end subroutine ext_pio_inquiry
 660
 661 subroutine ext_pio_ioexit(Status)
 662   use wrf_data_pio
 663   use pio_routines
 664   implicit none
 665   include 'wrf_status_codes.h'
 666   integer       , INTENT(INOUT)     ::Status
 667   integer                           :: error
 668   type(wrf_data_handle),pointer     :: DH
 669   integer                           :: i
 670   integer                           :: stat
 671   if(WrfIOnotInitialized) then
 672     Status = WRF_IO_NOT_INITIALIZED
 673     write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__
 674     call wrf_debug ( FATAL , msg)
 675     return
 676   endif
 677   do i=1,WrfDataHandleMax
 678     CALL deallocHandle( i , stat )
 679   enddo
 680   return
 681 end subroutine ext_pio_ioexit
 682
 683 subroutine ext_pio_get_dom_ti_real_arr(DataHandle,Element,Data,Count,OutCount,Status)
 684   use pio_kinds
 685   use pio
 686   use wrf_data_pio
 687   use pio_routines
 688
 689   implicit none
 690
 691   include 'wrf_status_codes.h'
 692   integer               ,intent(in)     :: DataHandle
 693   character*(*)         ,intent(in)     :: Element
 694   real,                  intent(out)    :: Data(:)
 695   integer,               intent(in)     :: Count
 696   integer,               intent(out)    :: OutCOunt
 697   integer               ,intent(out)    :: Status
 698   type(wrf_data_handle) ,pointer        :: DH
 699   integer                               :: XType
 700   integer                               :: Len
 701   integer                               :: stat
 702   real,                  allocatable    :: Buffer(:)
 703
 704   call GetDH(DataHandle,DH,Status)
 705   if(Status /= WRF_NO_ERR) then
 706     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 707     call wrf_debug ( WARN , msg)
 708     return
 709   endif
 710
 711 ! Do nothing unless it is time to read time-independent domain metadata.
 712   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
 713      return
 714   ENDIF
 715
 716   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 717     Status = WRF_WARN_FILE_NOT_OPENED
 718     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
 719     call wrf_debug ( WARN , msg)
 720   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 721     Status = WRF_WARN_DRYRUN_READ
 722     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
 723     call wrf_debug ( WARN , msg)
 724   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
 725     Status = WRF_WARN_READ_WONLY_FILE
 726     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
 727     call wrf_debug ( WARN , msg)
 728   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 729     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
 730     call netcdf_err(stat,Status)
 731     if(Status /= WRF_NO_ERR) then
 732       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
 733       call wrf_debug ( WARN , msg)
 734       return
 735     endif
 736     if( XType/=PIO_REAL) then
 737       Status = WRF_WARN_TYPE_MISMATCH
 738       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 739       call wrf_debug ( WARN , msg)
 740       return
 741     endif
 742     if(Len<=0) then
 743       Status = WRF_WARN_LENGTH_LESS_THAN_1
 744       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 745       call wrf_debug ( WARN , msg)
 746       return
 747     endif
 748     allocate(Buffer(Len), STAT=stat)
 749     if(stat/= 0) then
 750       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
 751       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
 752       call wrf_debug ( FATAL , msg)
 753       return
 754     endif
 755     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
 756     call netcdf_err(stat,Status)
 757     if(Status /= WRF_NO_ERR) then
 758       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
 759       call wrf_debug ( WARN , msg)
 760       return
 761     endif
 762     Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
 763     deallocate(Buffer, STAT=stat)
 764     if(stat/= WRF_NO_ERR) then
 765       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
 766       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
 767       call wrf_debug ( FATAL , msg)
 768       return
 769     endif
 770     if(Len > Count) then
 771       OutCount = Count
 772       Status = WRF_WARN_MORE_DATA_IN_FILE
 773     else
 774       OutCount = Len
 775       Status = WRF_NO_ERR
 776     endif
 777   else
 778     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 779     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
 780     call wrf_debug ( FATAL , msg)
 781   endif
 782   return
 783 end subroutine ext_pio_get_dom_ti_real_arr
 784
 785 subroutine ext_pio_get_dom_ti_real_sca(DataHandle,Element,Data,Count,OutCount,Status)
 786   use pio_kinds
 787   use pio
 788   use wrf_data_pio
 789   use pio_routines
 790
 791   implicit none
 792
 793   include 'wrf_status_codes.h'
 794   integer               ,intent(in)     :: DataHandle
 795   character*(*)         ,intent(in)     :: Element
 796   real,                  intent(out)    :: Data
 797   integer,               intent(in)     :: Count
 798   integer,               intent(out)    :: OutCOunt
 799   integer               ,intent(out)    :: Status
 800   type(wrf_data_handle) ,pointer        :: DH
 801   integer                               :: XType
 802   integer                               :: Len
 803   integer                               :: stat
 804   real,                  allocatable    :: Buffer(:)
 805
 806   call GetDH(DataHandle,DH,Status)
 807   if(Status /= WRF_NO_ERR) then
 808     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 809     call wrf_debug ( WARN , msg)
 810     return
 811   endif
 812
 813 ! Do nothing unless it is time to read time-independent domain metadata.
 814   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
 815      return
 816   ENDIF
 817
 818   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 819     Status = WRF_WARN_FILE_NOT_OPENED
 820     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
 821     call wrf_debug ( WARN , msg)
 822   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 823     Status = WRF_WARN_DRYRUN_READ
 824     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
 825     call wrf_debug ( WARN , msg)
 826   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
 827     Status = WRF_WARN_READ_WONLY_FILE
 828     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
 829     call wrf_debug ( WARN , msg)
 830   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 831     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
 832     call netcdf_err(stat,Status)
 833     if(Status /= WRF_NO_ERR) then
 834       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
 835       call wrf_debug ( WARN , msg)
 836       return
 837     endif
 838     if( XType/=PIO_REAL) then
 839       Status = WRF_WARN_TYPE_MISMATCH
 840       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 841       call wrf_debug ( WARN , msg)
 842       return
 843     endif
 844     if(Len<=0) then
 845       Status = WRF_WARN_LENGTH_LESS_THAN_1
 846       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 847       call wrf_debug ( WARN , msg)
 848       return
 849     endif
 850     allocate(Buffer(Len), STAT=stat)
 851     if(stat/= 0) then
 852       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
 853       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
 854       call wrf_debug ( FATAL , msg)
 855       return
 856     endif
 857     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
 858     call netcdf_err(stat,Status)
 859     if(Status /= WRF_NO_ERR) then
 860       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
 861       call wrf_debug ( WARN , msg)
 862       return
 863     endif
 864     Data = Buffer(1)
 865     deallocate(Buffer, STAT=stat)
 866     if(stat/= WRF_NO_ERR) then
 867       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
 868       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
 869       call wrf_debug ( FATAL , msg)
 870       return
 871     endif
 872     if(Len > Count) then
 873       OutCount = Count
 874       Status = WRF_WARN_MORE_DATA_IN_FILE
 875     else
 876       OutCount = Len
 877       Status = WRF_NO_ERR
 878     endif
 879   else
 880     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 881     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
 882     call wrf_debug ( FATAL , msg)
 883   endif
 884   return
 885 end subroutine ext_pio_get_dom_ti_real_sca
 886
 887 subroutine ext_pio_get_dom_ti_integer_arr(DataHandle,Element,Data,Count,OutCount,Status)
 888   use pio_kinds
 889   use pio
 890   use wrf_data_pio
 891   use pio_routines
 892
 893   implicit none
 894
 895   include 'wrf_status_codes.h'
 896   integer               ,intent(in)     :: DataHandle
 897   character*(*)         ,intent(in)     :: Element
 898   integer,               intent(out)    :: Data(:)
 899   integer,               intent(in)     :: Count
 900   integer,               intent(out)    :: OutCOunt
 901   integer               ,intent(out)    :: Status
 902   type(wrf_data_handle) ,pointer        :: DH
 903   integer                               :: XType
 904   integer                               :: Len
 905   integer                               :: stat
 906   integer,               allocatable    :: Buffer(:)
 907
 908   call GetDH(DataHandle,DH,Status)
 909   if(Status /= WRF_NO_ERR) then
 910     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 911     call wrf_debug ( WARN , msg)
 912     return
 913   endif
 914
 915 ! Do nothing unless it is time to read time-independent domain metadata.
 916   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
 917      return
 918   ENDIF
 919
 920   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 921     Status = WRF_WARN_FILE_NOT_OPENED
 922     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
 923     call wrf_debug ( WARN , msg)
 924   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 925     Status = WRF_WARN_DRYRUN_READ
 926     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
 927     call wrf_debug ( WARN , msg)
 928   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
 929     Status = WRF_WARN_READ_WONLY_FILE
 930     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
 931     call wrf_debug ( WARN , msg)
 932   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 933     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
 934     call netcdf_err(stat,Status)
 935     if(Status /= WRF_NO_ERR) then
 936       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
 937       call wrf_debug ( WARN , msg)
 938       return
 939     endif
 940     if( XType/=PIO_INT) then
 941       Status = WRF_WARN_TYPE_MISMATCH
 942       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 943       call wrf_debug ( WARN , msg)
 944       return
 945     endif
 946     if(Len<=0) then
 947       Status = WRF_WARN_LENGTH_LESS_THAN_1
 948       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
 949       call wrf_debug ( WARN , msg)
 950       return
 951     endif
 952     allocate(Buffer(Len), STAT=stat)
 953     if(stat/= 0) then
 954       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
 955       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
 956       call wrf_debug ( FATAL , msg)
 957       return
 958     endif
 959     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
 960     call netcdf_err(stat,Status)
 961     if(Status /= WRF_NO_ERR) then
 962       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
 963       call wrf_debug ( WARN , msg)
 964       return
 965     endif
 966     Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
 967     deallocate(Buffer, STAT=stat)
 968     if(stat/= WRF_NO_ERR) then
 969       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
 970       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
 971       call wrf_debug ( FATAL , msg)
 972       return
 973     endif
 974     if(Len > Count) then
 975       OutCount = Count
 976       Status = WRF_WARN_MORE_DATA_IN_FILE
 977     else
 978       OutCount = Len
 979       Status = WRF_NO_ERR
 980     endif
 981   else
 982     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 983     write(msg,*)  'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
 984     call wrf_debug ( FATAL , msg)
 985   endif
 986   return
 987 end subroutine ext_pio_get_dom_ti_integer_arr
 988
 989 subroutine ext_pio_get_dom_ti_integer_sca(DataHandle,Element,Data,Count,OutCount,Status)
 990   use pio_kinds
 991   use pio
 992   use wrf_data_pio
 993   use pio_routines
 994
 995   implicit none
 996
 997   include 'wrf_status_codes.h'
 998   integer               ,intent(in)     :: DataHandle
 999   character*(*)         ,intent(in)     :: Element
1000   integer,               intent(out)    :: Data
1001   integer,               intent(in)     :: Count
1002   integer,               intent(out)    :: OutCOunt
1003   integer               ,intent(out)    :: Status
1004   type(wrf_data_handle) ,pointer        :: DH
1005   integer                               :: XType
1006   integer                               :: Len
1007   integer                               :: stat
1008   integer,               allocatable    :: Buffer(:)
1009
1010   call GetDH(DataHandle,DH,Status)
1011   if(Status /= WRF_NO_ERR) then
1012     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1013     call wrf_debug ( WARN , msg)
1014     return
1015   endif
1016
1017 ! Do nothing unless it is time to read time-independent domain metadata.
1018   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1019      return
1020   ENDIF
1021
1022   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1023     Status = WRF_WARN_FILE_NOT_OPENED
1024     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1025     call wrf_debug ( WARN , msg)
1026   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1027     Status = WRF_WARN_DRYRUN_READ
1028     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1029     call wrf_debug ( WARN , msg)
1030   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1031     Status = WRF_WARN_READ_WONLY_FILE
1032     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1033     call wrf_debug ( WARN , msg)
1034   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1035     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1036     call netcdf_err(stat,Status)
1037     if(Status /= WRF_NO_ERR) then
1038       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
1039       call wrf_debug ( WARN , msg)
1040       return
1041     endif
1042     if( XType/=PIO_INT) then
1043       Status = WRF_WARN_TYPE_MISMATCH
1044       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1045       call wrf_debug ( WARN , msg)
1046       return
1047     endif
1048     if(Len<=0) then
1049       Status = WRF_WARN_LENGTH_LESS_THAN_1
1050       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1051       call wrf_debug ( WARN , msg)
1052       return
1053     endif
1054     allocate(Buffer(Len), STAT=stat)
1055     if(stat/= 0) then
1056       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1057       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
1058       call wrf_debug ( FATAL , msg)
1059       return
1060     endif
1061     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
1062     call netcdf_err(stat,Status)
1063     if(Status /= WRF_NO_ERR) then
1064       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1065       call wrf_debug ( WARN , msg)
1066       return
1067     endif
1068     Data = Buffer(1)
1069     deallocate(Buffer, STAT=stat)
1070     if(stat/= WRF_NO_ERR) then
1071       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
1072       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
1073       call wrf_debug ( FATAL , msg)
1074       return
1075     endif
1076     if(Len > Count) then
1077       OutCount = Count
1078       Status = WRF_WARN_MORE_DATA_IN_FILE
1079     else
1080       OutCount = Len
1081       Status = WRF_NO_ERR
1082     endif
1083   else
1084     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1085     write(msg,*)  'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1086     call wrf_debug ( FATAL , msg)
1087   endif
1088   return
1089 end subroutine ext_pio_get_dom_ti_integer_sca
1090
1091 subroutine ext_pio_get_dom_ti_double_arr(DataHandle,Element,Data,Count,OutCount,Status)
1092   use pio_kinds
1093   use pio
1094   use wrf_data_pio
1095   use pio_routines
1096
1097   implicit none
1098
1099   include 'wrf_status_codes.h'
1100   integer               ,intent(in)     :: DataHandle
1101   character*(*)         ,intent(in)     :: Element
1102   real*8,                intent(out)    :: Data(:)
1103   integer,               intent(in)     :: Count
1104   integer,               intent(out)    :: OutCOunt
1105   integer               ,intent(out)    :: Status
1106   type(wrf_data_handle) ,pointer        :: DH
1107   integer                               :: XType
1108   integer                               :: Len
1109   integer                               :: stat
1110   real*8,                allocatable    :: Buffer(:)
1111
1112   call GetDH(DataHandle,DH,Status)
1113   if(Status /= WRF_NO_ERR) then
1114     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1115     call wrf_debug ( WARN , msg)
1116     return
1117   endif
1118
1119 ! Do nothing unless it is time to read time-independent domain metadata.
1120   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1121       return
1122   ENDIF
1123
1124   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1125     Status = WRF_WARN_FILE_NOT_OPENED
1126     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1127     call wrf_debug ( WARN , msg)
1128   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1129     Status = WRF_WARN_DRYRUN_READ
1130     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1131     call wrf_debug ( WARN , msg)
1132   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1133     Status = WRF_WARN_READ_WONLY_FILE
1134     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1135     call wrf_debug ( WARN , msg)
1136   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1137     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1138     call netcdf_err(stat,Status)
1139     if(Status /= WRF_NO_ERR) then
1140       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
1141       call wrf_debug ( WARN , msg)
1142       return
1143     endif
1144     if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
1145       Status = WRF_WARN_TYPE_MISMATCH
1146       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1147       call wrf_debug ( WARN , msg)
1148       return
1149     endif
1150     if(Len<=0) then
1151       Status = WRF_WARN_LENGTH_LESS_THAN_1
1152       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1153       call wrf_debug ( WARN , msg)
1154       return
1155     endif
1156     allocate(Buffer(Len), STAT=stat)
1157     if(stat/= 0) then
1158       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1159       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
1160       call wrf_debug ( FATAL , msg)
1161       return
1162     endif
1163     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
1164     call netcdf_err(stat,Status)
1165     if(Status /= WRF_NO_ERR) then
1166       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1167       call wrf_debug ( WARN , msg)
1168       return
1169     endif
1170     Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
1171     deallocate(Buffer, STAT=stat)
1172     if(stat/= WRF_NO_ERR) then
1173       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
1174       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
1175       call wrf_debug ( FATAL , msg)
1176       return
1177     endif
1178     if(Len > Count) then
1179       OutCount = Count
1180       Status = WRF_WARN_MORE_DATA_IN_FILE
1181     else
1182       OutCount = Len
1183       Status = WRF_NO_ERR
1184     endif
1185   else
1186     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1187     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1188     call wrf_debug ( FATAL , msg)
1189   endif
1190   return
1191 end subroutine ext_pio_get_dom_ti_double_arr
1192
1193 subroutine ext_pio_get_dom_ti_double_sca(DataHandle,Element,Data,Count,OutCount,Status)
1194   use pio_kinds
1195   use pio
1196   use wrf_data_pio
1197   use pio_routines
1198
1199   implicit none
1200
1201   include 'wrf_status_codes.h'
1202   integer               ,intent(in)     :: DataHandle
1203   character*(*)         ,intent(in)     :: Element
1204   real*8,                intent(out)    :: Data
1205   integer,               intent(in)     :: Count
1206   integer,               intent(out)    :: OutCOunt
1207   integer               ,intent(out)    :: Status
1208   type(wrf_data_handle) ,pointer        :: DH
1209   integer                               :: XType
1210   integer                               :: Len
1211   integer                               :: stat
1212   real*8,                allocatable    :: Buffer(:)
1213
1214   call GetDH(DataHandle,DH,Status)
1215   if(Status /= WRF_NO_ERR) then
1216     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1217     call wrf_debug ( WARN , msg)
1218     return
1219   endif
1220
1221 ! Do nothing unless it is time to read time-independent domain metadata.
1222   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1223      return
1224   ENDIF
1225
1226   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1227     Status = WRF_WARN_FILE_NOT_OPENED
1228     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1229     call wrf_debug ( WARN , msg)
1230   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1231     Status = WRF_WARN_DRYRUN_READ
1232     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1233     call wrf_debug ( WARN , msg)
1234   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1235     Status = WRF_WARN_READ_WONLY_FILE
1236     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1237     call wrf_debug ( WARN , msg)
1238   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1239     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1240     call netcdf_err(stat,Status)
1241     if(Status /= WRF_NO_ERR) then
1242       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element)
1243       call wrf_debug ( WARN , msg)
1244       return
1245     endif
1246     if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
1247       Status = WRF_WARN_TYPE_MISMATCH
1248       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1249       call wrf_debug ( WARN , msg)
1250       return
1251     endif
1252     if(Len<=0) then
1253       Status = WRF_WARN_LENGTH_LESS_THAN_1
1254       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element)
1255       call wrf_debug ( WARN , msg)
1256       return
1257     endif
1258     allocate(Buffer(Len), STAT=stat)
1259     if(stat/= 0) then
1260       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1261       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
1262       call wrf_debug ( FATAL , msg)
1263       return
1264     endif
1265     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
1266     call netcdf_err(stat,Status)
1267     if(Status /= WRF_NO_ERR) then
1268       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1269       call wrf_debug ( WARN , msg)
1270       return
1271     endif
1272     Data = Buffer(1)
1273     deallocate(Buffer, STAT=stat)
1274     if(stat/= WRF_NO_ERR) then
1275       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
1276       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
1277       call wrf_debug ( FATAL , msg)
1278       return
1279     endif
1280     if(Len > Count) then
1281       OutCount = Count
1282       Status = WRF_WARN_MORE_DATA_IN_FILE
1283     else
1284       OutCount = Len
1285       Status = WRF_NO_ERR
1286     endif
1287   else
1288     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1289     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1290     call wrf_debug ( FATAL , msg)
1291   endif
1292   return
1293 end subroutine ext_pio_get_dom_ti_double_sca
1294
1295 subroutine ext_pio_get_dom_ti_logical_arr(DataHandle,Element,Data,Count,OutCount,Status)
1296   use pio_kinds
1297   use pio
1298   use wrf_data_pio
1299   use pio_routines
1300
1301   implicit none
1302
1303   include 'wrf_status_codes.h'
1304   integer               ,intent(in)     :: DataHandle
1305   character*(*)         ,intent(in)     :: Element
1306   logical,               intent(out)    :: Data(:)
1307   integer,               intent(in)     :: Count
1308   integer,               intent(out)    :: OutCOunt
1309   integer               ,intent(out)    :: Status
1310   type(wrf_data_handle) ,pointer        :: DH
1311   integer                               :: XType
1312   integer                               :: Len
1313   integer                               :: stat
1314   integer,               allocatable    :: Buffer(:)
1315
1316   call GetDH(DataHandle,DH,Status)
1317   if(Status /= WRF_NO_ERR) then
1318     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
1319     call wrf_debug ( WARN , msg)
1320     return
1321   endif
1322
1323 ! Do nothing unless it is time to read time-independent domain metadata.
1324   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1325       return
1326   ENDIF
1327
1328   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1329     Status = WRF_WARN_FILE_NOT_OPENED
1330     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
1331     call wrf_debug ( WARN , msg)
1332   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1333     Status = WRF_WARN_DRYRUN_READ
1334     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
1335     call wrf_debug ( WARN , msg)
1336   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1337     Status = WRF_WARN_READ_WONLY_FILE
1338     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
1339     call wrf_debug ( WARN , msg)
1340   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1341     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1342     call netcdf_err(stat,Status)
1343     if(Status /= WRF_NO_ERR) then
1344       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',trim(Element)
1345       call wrf_debug ( WARN , msg)
1346       return
1347     endif
1348     if ( PIO_INT == PIO_DOUBLE .OR. PIO_INT == PIO_REAL ) then
1349       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
1350         Status = WRF_WARN_TYPE_MISMATCH
1351         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1352         call wrf_debug ( WARN , msg)
1353         return
1354       endif
1355     else
1356       if( XType/=PIO_INT) then
1357         Status = WRF_WARN_TYPE_MISMATCH
1358         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1359         call wrf_debug ( WARN , msg)
1360         return
1361       endif
1362     endif
1363     if(Len<=0) then
1364       Status = WRF_WARN_LENGTH_LESS_THAN_1
1365       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1366       call wrf_debug ( WARN , msg)
1367       return
1368     endif
1369     allocate(Buffer(Len), STAT=stat)
1370     if(stat/= 0) then
1371       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1372       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
1373       call wrf_debug ( FATAL , msg)
1374       return
1375     endif
1376     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
1377     call netcdf_err(stat,Status)
1378     if(Status /= WRF_NO_ERR) then
1379       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
1380       call wrf_debug ( WARN , msg)
1381       return
1382     endif
1383     Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1
1384     deallocate(Buffer, STAT=stat)
1385     if(stat/= WRF_NO_ERR) then
1386       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
1387       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
1388       call wrf_debug ( FATAL , msg)
1389       return
1390     endif
1391     if(Len > Count) then
1392       OutCount = Count
1393       Status = WRF_WARN_MORE_DATA_IN_FILE
1394     else
1395       OutCount = Len
1396       Status = WRF_NO_ERR
1397     endif
1398   else
1399     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1400     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
1401     call wrf_debug ( FATAL , msg)
1402   endif
1403   return
1404 end subroutine ext_pio_get_dom_ti_logical_arr
1405
1406 subroutine ext_pio_get_dom_ti_logical_sca(DataHandle,Element,Data,Count,OutCount,Status)
1407   use pio_kinds
1408   use pio
1409   use wrf_data_pio
1410   use pio_routines
1411
1412   implicit none
1413
1414   include 'wrf_status_codes.h'
1415   integer               ,intent(in)     :: DataHandle
1416   character*(*)         ,intent(in)     :: Element
1417   logical,               intent(out)    :: Data
1418   integer,               intent(in)     :: Count
1419   integer,               intent(out)    :: OutCOunt
1420   integer               ,intent(out)    :: Status
1421   type(wrf_data_handle) ,pointer        :: DH
1422   integer                               :: XType
1423   integer                               :: Len
1424   integer                               :: stat
1425   integer,               allocatable    :: Buffer(:)
1426
1427   call GetDH(DataHandle,DH,Status)
1428   if(Status /= WRF_NO_ERR) then
1429     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
1430     call wrf_debug ( WARN , msg)
1431     return
1432   endif
1433
1434 ! Do nothing unless it is time to read time-independent domain metadata.
1435   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1436       return
1437   ENDIF
1438
1439   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1440     Status = WRF_WARN_FILE_NOT_OPENED
1441     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
1442     call wrf_debug ( WARN , msg)
1443   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1444     Status = WRF_WARN_DRYRUN_READ
1445     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
1446     call wrf_debug ( WARN , msg)
1447   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1448     Status = WRF_WARN_READ_WONLY_FILE
1449     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
1450     call wrf_debug ( WARN , msg)
1451   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1452     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1453     call netcdf_err(stat,Status)
1454     if(Status /= WRF_NO_ERR) then
1455       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',trim(Element)
1456       call wrf_debug ( WARN , msg)
1457       return
1458     endif
1459     if ( PIO_INT == PIO_DOUBLE .OR. PIO_INT == PIO_REAL ) then
1460       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
1461         Status = WRF_WARN_TYPE_MISMATCH
1462         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1463         call wrf_debug ( WARN , msg)
1464         return
1465       endif
1466     else
1467       if( XType/=PIO_INT) then
1468         Status = WRF_WARN_TYPE_MISMATCH
1469         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1470         call wrf_debug ( WARN , msg)
1471         return
1472       endif
1473     endif
1474     if(Len<=0) then
1475       Status = WRF_WARN_LENGTH_LESS_THAN_1
1476       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element)
1477       call wrf_debug ( WARN , msg)
1478       return
1479     endif
1480     allocate(Buffer(Len), STAT=stat)
1481     if(stat/= 0) then
1482       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1483       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
1484       call wrf_debug ( FATAL , msg)
1485       return
1486     endif
1487     stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer)
1488     call netcdf_err(stat,Status)
1489     if(Status /= WRF_NO_ERR) then
1490       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
1491       call wrf_debug ( WARN , msg)
1492       return
1493     endif
1494     Data = Buffer(1)
1495     deallocate(Buffer, STAT=stat)
1496     if(stat/= WRF_NO_ERR) then
1497       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
1498       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
1499       call wrf_debug ( FATAL , msg)
1500       return
1501     endif
1502     if(Len > Count) then
1503       OutCount = Count
1504       Status = WRF_WARN_MORE_DATA_IN_FILE
1505     else
1506       OutCount = Len
1507       Status = WRF_NO_ERR
1508     endif
1509   else
1510     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1511     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
1512     call wrf_debug ( FATAL , msg)
1513   endif
1514   return
1515 end subroutine ext_pio_get_dom_ti_logical_sca
1516
1517 subroutine ext_pio_get_dom_ti_char_arr(DataHandle,Element,Data,Status)
1518   use pio_kinds
1519   use pio
1520   use wrf_data_pio
1521   use pio_routines
1522
1523   implicit none
1524
1525   include 'wrf_status_codes.h'
1526   integer               ,intent(in)     :: DataHandle
1527   character*(*)         ,intent(in)     :: Element
1528   character*(*),         intent(out)    :: Data
1529
1530
1531   integer               ,intent(out)    :: Status
1532   type(wrf_data_handle) ,pointer        :: DH
1533   integer                               :: XType
1534   integer                               :: Len
1535   integer                               :: stat
1536
1537
1538   call GetDH(DataHandle,DH,Status)
1539   if(Status /= WRF_NO_ERR) then
1540     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
1541     call wrf_debug ( WARN , msg)
1542     return
1543   endif
1544
1545   ! Do nothing unless it is time to read time-independent domain metadata.
1546   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1547      return
1548   ENDIF
1549
1550   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1551     Status = WRF_WARN_FILE_NOT_OPENED
1552     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
1553     call wrf_debug ( WARN , msg)
1554   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1555     Status = WRF_WARN_DRYRUN_READ
1556     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
1557   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1558     Status = WRF_WARN_READ_WONLY_FILE
1559     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
1560     call wrf_debug ( WARN , msg)
1561   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1562     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1563     call netcdf_err(stat,Status)
1564     if(Status /= WRF_NO_ERR) then
1565       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',trim(Element)
1566       call wrf_debug ( WARN , msg)
1567       return
1568     endif
1569     if(Len<=0) then
1570       Status = WRF_WARN_LENGTH_LESS_THAN_1
1571       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ', trim(Element)
1572       call wrf_debug ( WARN , msg)
1573       return
1574     endif
1575     Data = ''
1576     stat = pio_get_att(DH%file_handle,PIO_GLOBAL,Element,Data)
1577     call netcdf_err(stat,Status)
1578     if(Status /= WRF_NO_ERR) then
1579       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
1580       call wrf_debug ( WARN , msg)
1581       return
1582     endif
1583   else
1584     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1585     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
1586     call wrf_debug ( FATAL , msg)
1587   endif
1588
1589   return
1590 end subroutine ext_pio_get_dom_ti_char_arr
1591
1592 subroutine ext_pio_get_dom_ti_char_sca(DataHandle,Element,Data,Status)
1593   use pio_kinds
1594   use pio
1595   use wrf_data_pio
1596   use pio_routines
1597
1598   implicit none
1599
1600   include 'wrf_status_codes.h'
1601   integer               ,intent(in)     :: DataHandle
1602   character*(*)         ,intent(in)     :: Element
1603   character*(*),         intent(out)    :: Data
1604
1605
1606   integer               ,intent(out)    :: Status
1607   type(wrf_data_handle) ,pointer        :: DH
1608   integer                               :: XType
1609   integer                               :: Len
1610   integer                               :: stat
1611
1612
1613   call GetDH(DataHandle,DH,Status)
1614   if(Status /= WRF_NO_ERR) then
1615     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
1616     call wrf_debug ( WARN , msg)
1617     return
1618   endif
1619
1620   ! Do nothing unless it is time to read time-independent domain metadata.
1621   IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN
1622      return
1623   ENDIF
1624
1625   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1626     Status = WRF_WARN_FILE_NOT_OPENED
1627     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
1628     call wrf_debug ( WARN , msg)
1629   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1630     Status = WRF_WARN_DRYRUN_READ
1631     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
1632   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1633     Status = WRF_WARN_READ_WONLY_FILE
1634     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
1635     call wrf_debug ( WARN , msg)
1636   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1637     stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len)
1638     call netcdf_err(stat,Status)
1639     if(Status /= WRF_NO_ERR) then
1640       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',trim(Element)
1641       call wrf_debug ( WARN , msg)
1642       return
1643     endif
1644     if(Len<=0) then
1645       Status = WRF_WARN_LENGTH_LESS_THAN_1
1646       write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ', trim(Element)
1647       call wrf_debug ( WARN , msg)
1648       return
1649     endif
1650     Data = ''
1651     stat = pio_get_att(DH%file_handle,PIO_GLOBAL,Element,Data)
1652     call netcdf_err(stat,Status)
1653     if(Status /= WRF_NO_ERR) then
1654       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
1655       call wrf_debug ( WARN , msg)
1656       return
1657     endif
1658   else
1659     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1660     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
1661     call wrf_debug ( FATAL , msg)
1662   endif
1663
1664   return
1665 end subroutine ext_pio_get_dom_ti_char_sca
1666
1667 subroutine ext_pio_put_dom_ti_real_arr(DataHandle,Element,Data,Count,Status)
1668   use pio_kinds
1669   use pio
1670   use wrf_data_pio
1671   use pio_routines
1672   implicit none
1673   include 'wrf_status_codes.h'
1674   integer               ,intent(in)     :: DataHandle
1675   character*(*)         ,intent(in)     :: Element
1676   real,                  intent(in)     :: Data(*)
1677   integer,               intent(in)     :: Count
1678   integer               ,intent(out)    :: Status
1679   type(wrf_data_handle) ,pointer        :: DH
1680   integer                               :: stat
1681   integer                               :: i
1682   real, dimension(1:Count)              :: tmparr
1683
1684   tmparr(1:Count) = Data(1:Count)
1685
1686   call GetDH(DataHandle,DH,Status)
1687   if(Status /= WRF_NO_ERR) then
1688     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1689     call wrf_debug ( WARN , msg)
1690     return
1691   endif
1692
1693 ! Do nothing unless it is time to write time-independent domain metadata.
1694   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
1695      return
1696   ENDIF
1697
1698   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1699     Status = WRF_WARN_FILE_NOT_OPENED
1700     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1701     call wrf_debug ( WARN , msg)
1702   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1703     STATUS = WRF_WARN_WRITE_RONLY_FILE
1704     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
1705     call wrf_debug ( WARN , msg)
1706   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1707    !stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr)
1708     if(1 == Count) then
1709        stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1))
1710     else
1711        stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count))
1712     endif
1713     call netcdf_err(stat,Status)
1714     if(Status /= WRF_NO_ERR) then
1715       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1716       call wrf_debug ( WARN , msg)
1717       return
1718     endif
1719   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1720     DH%Write = .false.
1721     stat = pio_redef(DH%file_handle)
1722     call netcdf_err(stat,Status)
1723     if(Status /= WRF_NO_ERR) then
1724       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1725       call wrf_debug ( WARN , msg)
1726       return
1727     endif
1728
1729     if(1 == Count) then
1730        stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1))
1731     else
1732        stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count))
1733     endif
1734     call netcdf_err(stat,Status)
1735     if(Status /= WRF_NO_ERR) then
1736       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1737       call wrf_debug ( WARN , msg)
1738       return
1739     endif
1740   else
1741     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1742     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1743     call wrf_debug ( FATAL , msg)
1744   endif
1745   return
1746 end subroutine ext_pio_put_dom_ti_real_arr
1747
1748 subroutine ext_pio_put_dom_ti_real_sca(DataHandle,Element,Data,Count,Status)
1749   use pio_kinds
1750   use pio
1751   use wrf_data_pio
1752   use pio_routines
1753   implicit none
1754   include 'wrf_status_codes.h'
1755   integer               ,intent(in)     :: DataHandle
1756   character*(*)         ,intent(in)     :: Element
1757   real,                  intent(in)     :: Data
1758   integer,               intent(in)     :: Count
1759   integer               ,intent(out)    :: Status
1760   type(wrf_data_handle) ,pointer        :: DH
1761   integer                               :: stat
1762   integer                               :: i
1763
1764   call GetDH(DataHandle,DH,Status)
1765   if(Status /= WRF_NO_ERR) then
1766     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1767     call wrf_debug ( WARN , msg)
1768     return
1769   endif
1770
1771 ! Do nothing unless it is time to write time-independent domain metadata.
1772   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
1773      return
1774   ENDIF
1775
1776   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1777     Status = WRF_WARN_FILE_NOT_OPENED
1778     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1779     call wrf_debug ( WARN , msg)
1780   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1781     STATUS = WRF_WARN_WRITE_RONLY_FILE
1782     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
1783     call wrf_debug ( WARN , msg)
1784   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1785       stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
1786     call netcdf_err(stat,Status)
1787     if(Status /= WRF_NO_ERR) then
1788       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1789       call wrf_debug ( WARN , msg)
1790       return
1791     endif
1792   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1793     DH%Write = .false.
1794     stat = pio_redef(DH%file_handle)
1795     call netcdf_err(stat,Status)
1796     if(Status /= WRF_NO_ERR) then
1797       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1798       call wrf_debug ( WARN , msg)
1799       return
1800     endif
1801     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
1802     call netcdf_err(stat,Status)
1803     if(Status /= WRF_NO_ERR) then
1804       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1805       call wrf_debug ( WARN , msg)
1806       return
1807     endif
1808   else
1809     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1810     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1811     call wrf_debug ( FATAL , msg)
1812   endif
1813   return
1814 end subroutine ext_pio_put_dom_ti_real_sca
1815
1816 subroutine ext_pio_put_dom_ti_integer_arr(DataHandle,Element,Data,Count,Status)
1817   use pio_kinds
1818   use pio
1819
1820   use wrf_data_pio
1821   use pio_routines
1822   implicit none
1823   include 'wrf_status_codes.h'
1824   integer               ,intent(in)     :: DataHandle
1825   character*(*)         ,intent(in)     :: Element
1826   integer,               intent(in)     :: Data(*)
1827   integer,               intent(in)     :: Count
1828   integer               ,intent(out)    :: Status
1829   type(wrf_data_handle) ,pointer        :: DH
1830   integer                               :: stat
1831   integer                               :: i
1832   integer, dimension(Count)             :: tmparr
1833
1834   call GetDH(DataHandle,DH,Status)
1835   if(Status /= WRF_NO_ERR) then
1836     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1837     call wrf_debug ( WARN , msg)
1838     return
1839   endif
1840
1841   tmparr(1:Count) = Data(1:Count)
1842
1843 !-Do nothing unless it is time to write time-independent domain metadata.
1844   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
1845      return
1846   ENDIF
1847
1848   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1849     Status = WRF_WARN_FILE_NOT_OPENED
1850     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1851     call wrf_debug ( WARN , msg)
1852   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1853     STATUS = WRF_WARN_WRITE_RONLY_FILE
1854     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
1855     call wrf_debug ( WARN , msg)
1856   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1857     stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr)
1858     call netcdf_err(stat,Status)
1859     if(Status /= WRF_NO_ERR) then
1860       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1861       call wrf_debug ( WARN , msg)
1862       return
1863     endif
1864   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1865     DH%Write = .false.
1866     stat = pio_redef(DH%file_handle)
1867     call netcdf_err(stat,Status)
1868     if(Status /= WRF_NO_ERR) then
1869       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1870       call wrf_debug ( WARN , msg)
1871       return
1872     endif
1873     tmparr(1:Count) = Data(1:Count)
1874     if(1 == Count) then
1875        stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1))
1876     else
1877        stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count))
1878     endif
1879     call netcdf_err(stat,Status)
1880     if(Status /= WRF_NO_ERR) then
1881       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1882       call wrf_debug ( WARN , msg)
1883       return
1884     endif
1885   else
1886     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1887     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1888     call wrf_debug ( FATAL , msg)
1889   endif
1890   return
1891 end subroutine ext_pio_put_dom_ti_integer_arr
1892
1893 subroutine ext_pio_put_dom_ti_integer_sca(DataHandle,Element,Data,Count,Status)
1894   use pio_kinds
1895   use pio
1896
1897   use wrf_data_pio
1898   use pio_routines
1899   implicit none
1900   include 'wrf_status_codes.h'
1901   integer               ,intent(in)     :: DataHandle
1902   character*(*)         ,intent(in)     :: Element
1903   integer,               intent(in)     :: Data
1904   integer,               intent(in)     :: Count
1905   integer               ,intent(out)    :: Status
1906   type(wrf_data_handle) ,pointer        :: DH
1907   integer                               :: stat
1908   integer                               :: i
1909
1910   call GetDH(DataHandle,DH,Status)
1911   if(Status /= WRF_NO_ERR) then
1912     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1913     call wrf_debug ( WARN , msg)
1914     return
1915   endif
1916
1917 ! Do nothing unless it is time to write time-independent domain metadata.
1918   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
1919      return
1920   ENDIF
1921
1922   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1923     Status = WRF_WARN_FILE_NOT_OPENED
1924     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1925     call wrf_debug ( WARN , msg)
1926   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1927     STATUS = WRF_WARN_WRITE_RONLY_FILE
1928     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
1929     call wrf_debug ( WARN , msg)
1930   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1931       stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data)
1932     call netcdf_err(stat,Status)
1933     if(Status /= WRF_NO_ERR) then
1934       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1935       call wrf_debug ( WARN , msg)
1936       return
1937     endif
1938   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1939     if(DH%Write) then
1940       DH%Write = .false.
1941       stat = pio_redef(DH%file_handle)
1942       call netcdf_err(stat,Status)
1943       if(Status /= WRF_NO_ERR) then
1944         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1945         call wrf_debug ( WARN , msg)
1946         return
1947       endif
1948     endif
1949     stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data)
1950     call netcdf_err(stat,Status)
1951     if(Status /= WRF_NO_ERR) then
1952       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
1953       call wrf_debug ( WARN , msg)
1954       return
1955     endif
1956   else
1957     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1958     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1959     call wrf_debug ( FATAL , msg)
1960   endif
1961   return
1962 end subroutine ext_pio_put_dom_ti_integer_sca
1963
1964 subroutine ext_pio_put_dom_ti_double_arr(DataHandle,Element,Data,Count,Status)
1965   use pio_kinds
1966   use pio
1967   use wrf_data_pio
1968   use pio_routines
1969   implicit none
1970   include 'wrf_status_codes.h'
1971   integer               ,intent(in)     :: DataHandle
1972   character*(*)         ,intent(in)     :: Element
1973   real*8,                intent(in)     :: Data(:)
1974   integer,               intent(in)     :: Count
1975   integer               ,intent(out)    :: Status
1976   type(wrf_data_handle) ,pointer        :: DH
1977   integer                               :: stat
1978   integer                               :: i
1979   real*8, dimension(1:Count)            :: tmparr
1980
1981   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
1982   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
1983   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
1984
1985 #if 0
1986   tmparr(1:Count) = Data(1:Count)
1987
1988   call GetDH(DataHandle,DH,Status)
1989   if(Status /= WRF_NO_ERR) then
1990     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1991     call wrf_debug ( WARN , msg)
1992     return
1993   endif
1994
1995 ! Do nothing unless it is time to write time-independent domain metadata.
1996   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
1997      return
1998   ENDIF
1999
2000   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2001     Status = WRF_WARN_FILE_NOT_OPENED
2002     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2003     call wrf_debug ( WARN , msg)
2004   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2005     STATUS = WRF_WARN_WRITE_RONLY_FILE
2006     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2007     call wrf_debug ( WARN , msg)
2008   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2009     stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count))
2010     call netcdf_err(stat,Status)
2011     if(Status /= WRF_NO_ERR) then
2012       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2013       call wrf_debug ( WARN , msg)
2014       return
2015     endif
2016   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2017     if(DH%Write) then
2018       DH%Write = .false.
2019       stat = pio_redef(DH%file_handle)
2020       call netcdf_err(stat,Status)
2021       if(Status /= WRF_NO_ERR) then
2022         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2023         call wrf_debug ( WARN , msg)
2024         return
2025       endif
2026     endif
2027
2028     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count))
2029     call netcdf_err(stat,Status)
2030     if(Status /= WRF_NO_ERR) then
2031       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2032       call wrf_debug ( WARN , msg)
2033       return
2034     endif
2035   else
2036     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2037     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2038     call wrf_debug ( FATAL , msg)
2039   endif
2040 #endif
2041   return
2042 end subroutine ext_pio_put_dom_ti_double_arr
2043
2044 subroutine ext_pio_put_dom_ti_double_sca(DataHandle,Element,Data,Count,Status)
2045   use pio_kinds
2046   use pio
2047   use wrf_data_pio
2048   use pio_routines
2049   implicit none
2050   include 'wrf_status_codes.h'
2051   integer               ,intent(in)     :: DataHandle
2052   character*(*)         ,intent(in)     :: Element
2053   real*8,                intent(in)     :: Data
2054   integer,               intent(in)     :: Count
2055   integer               ,intent(out)    :: Status
2056   type(wrf_data_handle) ,pointer        :: DH
2057   integer                               :: stat
2058   integer                               :: i
2059
2060   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2061   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2062   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2063
2064 #if 0
2065   call GetDH(DataHandle,DH,Status)
2066   if(Status /= WRF_NO_ERR) then
2067     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2068     call wrf_debug ( WARN , msg)
2069     return
2070   endif
2071
2072 ! Do nothing unless it is time to write time-independent domain metadata.
2073   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
2074      return
2075   ENDIF
2076
2077   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2078     Status = WRF_WARN_FILE_NOT_OPENED
2079     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2080     call wrf_debug ( WARN , msg)
2081   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2082     STATUS = WRF_WARN_WRITE_RONLY_FILE
2083     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2084     call wrf_debug ( WARN , msg)
2085   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2086     stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data)
2087     call netcdf_err(stat,Status)
2088     if(Status /= WRF_NO_ERR) then
2089       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2090       call wrf_debug ( WARN , msg)
2091       return
2092     endif
2093   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2094     if(DH%Write) then
2095       DH%Write = .false.
2096       stat = pio_redef(DH%file_handle)
2097       call netcdf_err(stat,Status)
2098       if(Status /= WRF_NO_ERR) then
2099         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2100         call wrf_debug ( WARN , msg)
2101         return
2102       endif
2103     endif
2104
2105     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
2106     call netcdf_err(stat,Status)
2107     if(Status /= WRF_NO_ERR) then
2108       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2109       call wrf_debug ( WARN , msg)
2110       return
2111     endif
2112   else
2113     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2114     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2115     call wrf_debug ( FATAL , msg)
2116   endif
2117 #endif
2118   return
2119 end subroutine ext_pio_put_dom_ti_double_sca
2120
2121 subroutine ext_pio_put_dom_ti_logical_arr(DataHandle,Element,Data,Count,Status)
2122   use pio
2123   use pio_kinds
2124
2125   use wrf_data_pio
2126   use pio_routines
2127   implicit none
2128   include 'wrf_status_codes.h'
2129   integer               ,intent(in)     :: DataHandle
2130   character*(*)         ,intent(in)     :: Element
2131   logical,               intent(in)     :: Data(:)
2132   integer,               intent(in)     :: Count
2133   integer               ,intent(out)    :: Status
2134   type(wrf_data_handle) ,pointer        :: DH
2135   integer                               :: stat
2136   integer               ,allocatable    :: Buffer(:)
2137   integer                               :: i
2138
2139   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2140   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2141   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2142
2143 #if 0
2144   call GetDH(DataHandle,DH,Status)
2145   if(Status /= WRF_NO_ERR) then
2146     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
2147     call wrf_debug ( WARN , msg)
2148     return
2149   endif
2150
2151 ! Do nothing unless it is time to write time-independent domain metadata.
2152   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
2153      return
2154   ENDIF
2155
2156   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2157     Status = WRF_WARN_FILE_NOT_OPENED
2158     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
2159     call wrf_debug ( WARN , msg)
2160   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2161     STATUS = WRF_WARN_WRITE_RONLY_FILE
2162     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
2163     call wrf_debug ( WARN , msg)
2164   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2165       allocate(Buffer(Count), STAT=stat)
2166       if(stat/= 0) then
2167         Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2168         write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2169         call wrf_debug ( FATAL , msg)
2170         return
2171       endif
2172       do i=1,Count
2173         if(data(i)) then
2174            Buffer(i)=1
2175         else
2176            Buffer(i)=0
2177         endif
2178       enddo
2179       stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer)
2180       deallocate(Buffer, STAT=stat)
2181       if(stat /= 0) then
2182         Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2183         write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2184         call wrf_debug ( FATAL , msg)
2185         return
2186       endif
2187     call netcdf_err(stat,Status)
2188     if(Status /= WRF_NO_ERR) then
2189       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
2190       call wrf_debug ( WARN , msg)
2191       return
2192     endif
2193   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2194     if(DH%Write) then
2195       DH%Write = .false.
2196       stat = pio_redef(DH%file_handle)
2197       call netcdf_err(stat,Status)
2198       if(Status /= WRF_NO_ERR) then
2199         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2200         call wrf_debug ( WARN , msg)
2201         return
2202       endif
2203     endif
2204
2205     allocate(Buffer(Count), STAT=stat)
2206     if(stat/= 0) then
2207       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2208       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2209       call wrf_debug ( FATAL , msg)
2210       return
2211     endif
2212     do i=1,Count
2213       if(data(i)) then
2214          Buffer(i)=1
2215       else
2216          Buffer(i)=0
2217       endif
2218     enddo
2219     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer)
2220     deallocate(Buffer, STAT=stat)
2221     if(stat /= 0) then
2222       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2223       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2224       call wrf_debug ( FATAL , msg)
2225       return
2226     endif
2227     call netcdf_err(stat,Status)
2228     if(Status /= WRF_NO_ERR) then
2229       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
2230       call wrf_debug ( WARN , msg)
2231       return
2232     endif
2233   else
2234     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2235     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
2236     call wrf_debug ( FATAL , msg)
2237   endif
2238 #endif
2239   return
2240 end subroutine ext_pio_put_dom_ti_logical_arr
2241
2242 subroutine ext_pio_put_dom_ti_logical_sca(DataHandle,Element,Data,Count,Status)
2243   use pio
2244   use pio_kinds
2245
2246   use wrf_data_pio
2247   use pio_routines
2248   implicit none
2249   include 'wrf_status_codes.h'
2250   integer               ,intent(in)     :: DataHandle
2251   character*(*)         ,intent(in)     :: Element
2252   logical,               intent(in)     :: Data
2253   integer,               intent(in)     :: Count
2254   integer               ,intent(out)    :: Status
2255   type(wrf_data_handle) ,pointer        :: DH
2256   integer                               :: stat
2257   integer               ,allocatable    :: Buffer(:)
2258   integer                               :: i
2259
2260   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2261   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2262   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2263
2264 #if 0
2265   call GetDH(DataHandle,DH,Status)
2266   if(Status /= WRF_NO_ERR) then
2267     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
2268     call wrf_debug ( WARN , msg)
2269     return
2270   endif
2271
2272 ! Do nothing unless it is time to write time-independent domain metadata.
2273   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
2274      return
2275   ENDIF
2276
2277   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2278     Status = WRF_WARN_FILE_NOT_OPENED
2279     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
2280     call wrf_debug ( WARN , msg)
2281   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2282     STATUS = WRF_WARN_WRITE_RONLY_FILE
2283     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
2284     call wrf_debug ( WARN , msg)
2285   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2286     allocate(Buffer(Count), STAT=stat)
2287     if(stat/= 0) then
2288       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2289       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2290       call wrf_debug ( FATAL , msg)
2291       return
2292     endif
2293     if(data) then
2294        Buffer(1)=1
2295     else
2296        Buffer(1)=0
2297     endif
2298     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer)
2299     deallocate(Buffer, STAT=stat)
2300     if(stat /= 0) then
2301       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2302       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2303       call wrf_debug ( FATAL , msg)
2304       return
2305     endif
2306     call netcdf_err(stat,Status)
2307     if(Status /= WRF_NO_ERR) then
2308       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
2309       call wrf_debug ( WARN , msg)
2310       return
2311     endif
2312   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2313     if(DH%Write) then
2314       DH%Write = .false.
2315       stat = pio_redef(DH%file_handle)
2316       call netcdf_err(stat,Status)
2317       if(Status /= WRF_NO_ERR) then
2318         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2319         call wrf_debug ( WARN , msg)
2320         return
2321       endif
2322     endif
2323     allocate(Buffer(Count), STAT=stat)
2324     if(stat/= 0) then
2325       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2326       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2327       call wrf_debug ( FATAL , msg)
2328       return
2329     endif
2330     if(data) then
2331        Buffer(1)=1
2332     else
2333        Buffer(1)=0
2334     endif
2335     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer)
2336     deallocate(Buffer, STAT=stat)
2337     if(stat /= 0) then
2338       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2339       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
2340       call wrf_debug ( FATAL , msg)
2341       return
2342     endif
2343     call netcdf_err(stat,Status)
2344     if(Status /= WRF_NO_ERR) then
2345       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
2346       call wrf_debug ( WARN , msg)
2347       return
2348     endif
2349   else
2350     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2351     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
2352     call wrf_debug ( FATAL , msg)
2353   endif
2354 #endif
2355   return
2356 end subroutine ext_pio_put_dom_ti_logical_sca
2357
2358 subroutine ext_pio_put_dom_ti_char_arr(DataHandle,Element,Data,Status)
2359   use pio
2360   use pio_kinds
2361
2362   use wrf_data_pio
2363   use pio_routines
2364   implicit none
2365   include 'wrf_status_codes.h'
2366   integer               ,intent(in)     :: DataHandle
2367   character*(*)         ,intent(in)     :: Element
2368   character*(*),         intent(in)     :: Data
2369   integer,               parameter      :: Count=1
2370   integer               ,intent(out)    :: Status
2371   type(wrf_data_handle) ,pointer        :: DH
2372   integer                               :: stat
2373   integer                               :: i
2374
2375   call GetDH(DataHandle,DH,Status)
2376   if(Status /= WRF_NO_ERR) then
2377     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
2378     call wrf_debug ( WARN , msg)
2379     return
2380   endif
2381
2382 ! Do nothing unless it is time to write time-independent domain metadata.
2383   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
2384      return
2385   ENDIF
2386
2387   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2388     Status = WRF_WARN_FILE_NOT_OPENED
2389     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
2390     call wrf_debug ( WARN , msg)
2391   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2392     STATUS = WRF_WARN_WRITE_RONLY_FILE
2393     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
2394     call wrf_debug ( WARN , msg)
2395   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2396       stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
2397     call netcdf_err(stat,Status)
2398     if(Status /= WRF_NO_ERR) then
2399       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
2400       call wrf_debug ( WARN , msg)
2401       return
2402     endif
2403   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2404     if(DH%Write) then
2405       DH%Write = .false.
2406       stat = pio_redef(DH%file_handle)
2407       call netcdf_err(stat,Status)
2408       if(Status /= WRF_NO_ERR) then
2409         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2410         call wrf_debug ( WARN , msg)
2411         return
2412       endif
2413     endif
2414     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
2415     call netcdf_err(stat,Status)
2416     if(Status /= WRF_NO_ERR) then
2417       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
2418       call wrf_debug ( WARN , msg)
2419       return
2420     endif
2421   else
2422     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2423     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
2424     call wrf_debug ( FATAL , msg)
2425   endif
2426   return
2427 end subroutine ext_pio_put_dom_ti_char_arr
2428
2429 subroutine ext_pio_put_dom_ti_char_sca(DataHandle,Element,Data,Status)
2430   use pio
2431   use pio_kinds
2432
2433   use wrf_data_pio
2434   use pio_routines
2435   implicit none
2436   include 'wrf_status_codes.h'
2437   integer               ,intent(in)     :: DataHandle
2438   character*(*)         ,intent(in)     :: Element
2439   character*(*),         intent(in)     :: Data
2440   integer,               parameter      :: Count=1
2441   integer               ,intent(out)    :: Status
2442   type(wrf_data_handle) ,pointer        :: DH
2443   integer                               :: stat
2444   integer                               :: i
2445
2446   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2447   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2448   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2449
2450 #if 0
2451   call GetDH(DataHandle,DH,Status)
2452   if(Status /= WRF_NO_ERR) then
2453     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
2454     call wrf_debug ( WARN , msg)
2455     return
2456   endif
2457
2458 ! Do nothing unless it is time to write time-independent domain metadata.
2459   IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN
2460      return
2461   ENDIF
2462
2463   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2464     Status = WRF_WARN_FILE_NOT_OPENED
2465     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
2466     call wrf_debug ( WARN , msg)
2467   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2468     STATUS = WRF_WARN_WRITE_RONLY_FILE
2469     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
2470     call wrf_debug ( WARN , msg)
2471   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2472       stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
2473     call netcdf_err(stat,Status)
2474     if(Status /= WRF_NO_ERR) then
2475       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
2476       call wrf_debug ( WARN , msg)
2477       return
2478     endif
2479   elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2480     if(DH%Write) then
2481       DH%Write = .false.
2482       stat = pio_redef(DH%file_handle)
2483       call netcdf_err(stat,Status)
2484       if(Status /= WRF_NO_ERR) then
2485         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2486         call wrf_debug ( WARN , msg)
2487         return
2488       endif
2489     endif
2490     stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data)
2491     call netcdf_err(stat,Status)
2492     if(Status /= WRF_NO_ERR) then
2493       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
2494       call wrf_debug ( WARN , msg)
2495       return
2496     endif
2497   else
2498     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2499     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
2500     call wrf_debug ( FATAL , msg)
2501   endif
2502 #endif
2503   return
2504 end subroutine ext_pio_put_dom_ti_char_sca
2505
2506 subroutine ext_pio_put_var_ti_real_arr(DataHandle,Element,Var,Data,Count,Status)
2507   use pio
2508   use pio_kinds
2509
2510   use wrf_data_pio
2511   use pio_routines
2512   implicit none
2513   include 'wrf_status_codes.h'
2514   integer               ,intent(in)     :: DataHandle
2515   character*(*)         ,intent(in)     :: Element
2516   character*(*)         ,intent(in)     :: Var
2517   real,                  intent(in)     :: Data(:)
2518   integer,               intent(in)     :: Count
2519   integer               ,intent(out)    :: Status
2520   type(wrf_data_handle) ,pointer        :: DH
2521   character (VarNameLen)                :: VarName
2522   integer                               :: stat
2523   integer                               :: i
2524   integer                               :: NVar
2525   character*1                           :: null
2526
2527   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2528   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2529   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2530
2531 #if 0
2532   null=char(0)
2533   VarName = Var
2534   call GetDH(DataHandle,DH,Status)
2535   if(Status /= WRF_NO_ERR) then
2536     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2537     call wrf_debug ( WARN , msg)
2538     return
2539   endif
2540   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2541     Status = WRF_WARN_FILE_NOT_OPENED
2542     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2543     call wrf_debug ( WARN , msg)
2544   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2545     Status = WRF_WARN_WRITE_RONLY_FILE
2546     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2547     call wrf_debug ( WARN , msg)
2548   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2549     Status = WRF_WARN_MD_AFTER_OPEN
2550     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
2551     call wrf_debug ( WARN , msg)
2552     return
2553   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2554     do NVar=1,MaxVars
2555       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
2556         exit
2557       elseif(NVar == MaxVars) then
2558         Status = WRF_WARN_VAR_NF
2559         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
2560                         ,NVar,VarName
2561         call wrf_debug ( WARN , msg)
2562         return
2563       endif
2564     enddo
2565     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data)
2566     call netcdf_err(stat,Status)
2567     if(Status /= WRF_NO_ERR) then
2568       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
2569         ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
2570       call wrf_debug ( WARN , msg)
2571     endif
2572   else
2573     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2574     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2575     call wrf_debug ( FATAL , msg)
2576     return
2577   endif
2578 #endif
2579   return
2580 end subroutine ext_pio_put_var_ti_real_arr
2581
2582 subroutine ext_pio_put_var_ti_real_sca(DataHandle,Element,Var,Data,Count,Status)
2583   use pio
2584   use pio_kinds
2585
2586   use wrf_data_pio
2587   use pio_routines
2588   implicit none
2589   include 'wrf_status_codes.h'
2590   integer               ,intent(in)     :: DataHandle
2591   character*(*)         ,intent(in)     :: Element
2592   character*(*)         ,intent(in)     :: Var
2593   real,                  intent(in)     :: Data
2594   integer,               intent(in)     :: Count
2595   integer               ,intent(out)    :: Status
2596   type(wrf_data_handle) ,pointer        :: DH
2597   character (VarNameLen)                :: VarName
2598   integer                               :: stat
2599   integer                               :: i
2600   integer                               :: NVar
2601   character*1                           :: null
2602
2603   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2604   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2605   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2606
2607 #if 0
2608   null=char(0)
2609   VarName = Var
2610   call GetDH(DataHandle,DH,Status)
2611   if(Status /= WRF_NO_ERR) then
2612     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2613     call wrf_debug ( WARN , msg)
2614     return
2615   endif
2616   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2617     Status = WRF_WARN_FILE_NOT_OPENED
2618     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2619     call wrf_debug ( WARN , msg)
2620   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2621     Status = WRF_WARN_WRITE_RONLY_FILE
2622     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2623     call wrf_debug ( WARN , msg)
2624   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2625     Status = WRF_WARN_MD_AFTER_OPEN
2626     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
2627     call wrf_debug ( WARN , msg)
2628     return
2629   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2630     do NVar=1,MaxVars
2631       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
2632         exit
2633       elseif(NVar == MaxVars) then
2634         Status = WRF_WARN_VAR_NF
2635         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
2636                         ,NVar,VarName
2637         call wrf_debug ( WARN , msg)
2638         return
2639       endif
2640     enddo
2641     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data)
2642     call netcdf_err(stat,Status)
2643     if(Status /= WRF_NO_ERR) then
2644       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
2645         ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
2646       call wrf_debug ( WARN , msg)
2647     endif
2648   else
2649     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2650     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2651     call wrf_debug ( FATAL , msg)
2652     return
2653   endif
2654 #endif
2655   return
2656 end subroutine ext_pio_put_var_ti_real_sca
2657
2658 subroutine ext_pio_put_var_td_real_arr(DataHandle,Element,DateStr,Var,Data,Count,Status)
2659   use pio
2660   use pio_kinds
2661
2662   use wrf_data_pio
2663   use pio_routines
2664   implicit none
2665   include 'wrf_status_codes.h'
2666   integer               ,intent(in)     :: DataHandle
2667   character*(*)         ,intent(in)     :: Element
2668   character*(*)         ,intent(in)     :: DateStr
2669   character*(*)         ,intent(in)     :: Var
2670   real                  ,intent(in)     :: Data(:)
2671   integer               ,intent(in)     :: Count
2672   integer               ,intent(out)    :: Status
2673   type(wrf_data_handle) ,pointer        :: DH
2674   character (VarNameLen)                :: VarName
2675   character (40+len(Element))           :: Name
2676   integer                               :: stat
2677   integer                               :: i
2678   integer                               :: VDims (2)
2679   integer                               :: VStart(2)
2680   integer                               :: VCount(2)
2681   integer                               :: NVar
2682   integer                               :: TimeIndex
2683
2684   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2685   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2686   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2687
2688 #if 0
2689   VarName = Var
2690   call DateCheck(DateStr,Status)
2691   if(Status /= WRF_NO_ERR) then
2692     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2693     call wrf_debug ( WARN , msg)
2694     return
2695   endif
2696   call GetDH(DataHandle,DH,Status)
2697   if(Status /= WRF_NO_ERR) then
2698     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2699     call wrf_debug ( WARN , msg)
2700     return
2701   endif
2702   call GetName(Element, VarName, Name, Status)
2703   if(Status /= WRF_NO_ERR) then
2704     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2705     call wrf_debug ( WARN , msg)
2706     return
2707   endif
2708   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2709     Status = WRF_WARN_FILE_NOT_OPENED
2710     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2711     call wrf_debug ( WARN , msg)
2712   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2713     Status = WRF_WARN_WRITE_RONLY_FILE
2714     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2715     call wrf_debug ( WARN , msg)
2716   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2717     if(Count < 1) then
2718       Status = WRF_WARN_ZERO_LENGTH_PUT
2719       return
2720     endif
2721     do i=1,MaxVars
2722       if(DH%VarNames(i) == Name) then
2723         Status = WRF_WARN_2DRYRUNS_1VARIABLE
2724         NVar=i
2725         return
2726       elseif(DH%VarNames(i) == NO_NAME) then
2727         DH%VarNames(i) = Name
2728         exit
2729       elseif(i == MaxVars) then
2730         Status = WRF_WARN_TOO_MANY_VARIABLES
2731         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
2732         call wrf_debug ( WARN , msg)
2733         return
2734       endif
2735     enddo
2736     do i=1,MaxDims
2737       if(DH%DimLengths(i) == Count) then
2738         exit
2739       elseif(DH%DimLengths(i) == NO_DIM) then
2740         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
2741         call netcdf_err(stat,Status)
2742         if(Status /= WRF_NO_ERR) then
2743           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2744           call wrf_debug ( WARN , msg)
2745           return
2746         endif
2747         DH%DimLengths(i) = Count
2748         exit
2749       elseif(i == MaxDims) then
2750         Status = WRF_WARN_TOO_MANY_DIMS
2751         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
2752         call wrf_debug ( WARN , msg)
2753         return
2754       endif
2755     enddo
2756     DH%VarDimLens(1, NVar) = Count
2757     VDims(1) = DH%DimIDs(i)
2758     VDims(2) = DH%DimUnlimID
2759     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2760     write(unit=0, fmt='(3a,i6)') '2 Define Var <', trim(Var), '> as NVar:', NVar
2761     stat = pio_def_var(DH%file_handle,Name,PIO_REAL,DH%descVar(NVar))
2762     call netcdf_err(stat,Status)
2763     if(Status /= WRF_NO_ERR) then
2764       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2765       call wrf_debug ( WARN , msg)
2766       return
2767     endif
2768   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2769     do i=1,MaxVars
2770       if(DH%VarNames(i) == Name) then
2771         NVar=i
2772         exit
2773       elseif(DH%VarNames(i) == NO_NAME) then
2774         Status = WRF_WARN_MD_NF
2775         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
2776         call wrf_debug ( WARN , msg)
2777         return
2778       elseif(i == MaxVars) then
2779         Status = WRF_WARN_TOO_MANY_VARIABLES
2780         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
2781         call wrf_debug ( WARN , msg)
2782         return
2783       endif
2784     enddo
2785     if(Count > DH%VarDimLens(1,NVar)) then
2786       Status = WRF_WARN_COUNT_TOO_LONG
2787       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
2788       call wrf_debug ( WARN , msg)
2789       return
2790     elseif(Count < 1) then
2791       Status = WRF_WARN_ZERO_LENGTH_PUT
2792       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
2793       call wrf_debug ( WARN , msg)
2794       return
2795     endif
2796     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2797     if(Status /= WRF_NO_ERR) then
2798       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
2799       call wrf_debug ( WARN , msg)
2800       return
2801     endif
2802     VStart(1) = 1
2803     VStart(2) = TimeIndex
2804     VCount(1) = Count
2805     VCount(2) = 1
2806     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data)
2807     call netcdf_err(stat,Status)
2808     if(Status /= WRF_NO_ERR) then
2809       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2810       call wrf_debug ( WARN , msg)
2811       return
2812     endif
2813   else
2814     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2815     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2816     call wrf_debug ( FATAL , msg)
2817     return
2818   endif
2819 #endif
2820   return
2821 end subroutine ext_pio_put_var_td_real_arr
2822
2823 subroutine ext_pio_put_var_td_real_sca(DataHandle,Element,DateStr,Var,Data,Count,Status)
2824   use pio
2825   use pio_kinds
2826
2827   use wrf_data_pio
2828   use pio_routines
2829   implicit none
2830   include 'wrf_status_codes.h'
2831   integer               ,intent(in)     :: DataHandle
2832   character*(*)         ,intent(in)     :: Element
2833   character*(*)         ,intent(in)     :: DateStr
2834   character*(*)         ,intent(in)     :: Var
2835   real                  ,intent(in)     :: Data
2836   integer               ,intent(in)     :: Count
2837   integer               ,intent(out)    :: Status
2838   type(wrf_data_handle) ,pointer        :: DH
2839   character (VarNameLen)                :: VarName
2840   character (40+len(Element))           :: Name
2841   integer                               :: stat
2842   integer                               :: Buffer(1)
2843   integer                               :: i
2844   integer                               :: VDims (2)
2845   integer                               :: VStart(2)
2846   integer                               :: VCount(2)
2847   integer                               :: NVar
2848   integer                               :: TimeIndex
2849
2850   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2851   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2852   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2853
2854 #if 0
2855   VarName = Var
2856   call DateCheck(DateStr,Status)
2857   if(Status /= WRF_NO_ERR) then
2858     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2859     call wrf_debug ( WARN , msg)
2860     return
2861   endif
2862   call GetDH(DataHandle,DH,Status)
2863   if(Status /= WRF_NO_ERR) then
2864     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2865     call wrf_debug ( WARN , msg)
2866     return
2867   endif
2868   call GetName(Element, VarName, Name, Status)
2869   if(Status /= WRF_NO_ERR) then
2870     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2871     call wrf_debug ( WARN , msg)
2872     return
2873   endif
2874   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2875     Status = WRF_WARN_FILE_NOT_OPENED
2876     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2877     call wrf_debug ( WARN , msg)
2878   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2879     Status = WRF_WARN_WRITE_RONLY_FILE
2880     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2881     call wrf_debug ( WARN , msg)
2882   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2883     if(Count < 1) then
2884       Status = WRF_WARN_ZERO_LENGTH_PUT
2885       return
2886     endif
2887     do i=1,MaxVars
2888       if(DH%VarNames(i) == Name) then
2889         Status = WRF_WARN_2DRYRUNS_1VARIABLE
2890         NVar=i
2891         return
2892       elseif(DH%VarNames(i) == NO_NAME) then
2893         DH%VarNames(i) = Name
2894         exit
2895       elseif(i == MaxVars) then
2896         Status = WRF_WARN_TOO_MANY_VARIABLES
2897         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
2898         call wrf_debug ( WARN , msg)
2899         return
2900       endif
2901     enddo
2902     do i=1,MaxDims
2903       if(DH%DimLengths(i) == Count) then
2904         exit
2905       elseif(DH%DimLengths(i) == NO_DIM) then
2906         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
2907         call netcdf_err(stat,Status)
2908         if(Status /= WRF_NO_ERR) then
2909           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2910           call wrf_debug ( WARN , msg)
2911           return
2912         endif
2913         DH%DimLengths(i) = Count
2914         exit
2915       elseif(i == MaxDims) then
2916         Status = WRF_WARN_TOO_MANY_DIMS
2917         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
2918         call wrf_debug ( WARN , msg)
2919         return
2920       endif
2921     enddo
2922     DH%VarDimLens(1,NVar) = Count
2923     VDims(1) = DH%DimIDs(i)
2924     VDims(2) = DH%DimUnlimID
2925     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
2926     write(unit=0, fmt='(3a,i6)') '3 Define Var <', trim(Var), '> as NVar:', NVar
2927     stat = pio_def_var(DH%file_handle,Name,PIO_REAL,DH%descVar(NVar))
2928     call netcdf_err(stat,Status)
2929     if(Status /= WRF_NO_ERR) then
2930       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2931       call wrf_debug ( WARN , msg)
2932       return
2933     endif
2934   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2935     do NVar=1,MaxVars
2936       if(DH%VarNames(NVar) == Name) then
2937         exit
2938       elseif(DH%VarNames(NVar) == NO_NAME) then
2939         Status = WRF_WARN_MD_NF
2940         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
2941         call wrf_debug ( WARN , msg)
2942         return
2943       elseif(NVar == MaxVars) then
2944         Status = WRF_WARN_TOO_MANY_VARIABLES
2945         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
2946         call wrf_debug ( WARN , msg)
2947         return
2948       endif
2949     enddo
2950     if(Count > DH%VarDimLens(1,NVar)) then
2951       Status = WRF_WARN_COUNT_TOO_LONG
2952       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
2953       call wrf_debug ( WARN , msg)
2954       return
2955     elseif(Count < 1) then
2956       Status = WRF_WARN_ZERO_LENGTH_PUT
2957       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
2958       call wrf_debug ( WARN , msg)
2959       return
2960     endif
2961     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2962     if(Status /= WRF_NO_ERR) then
2963       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
2964       call wrf_debug ( WARN , msg)
2965       return
2966     endif
2967     VStart(1) = 1
2968     VStart(2) = TimeIndex
2969     VCount(1) = Count
2970     VCount(2) = 1
2971     Buffer(1) = Data
2972    !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Buffer)
2973     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer)
2974     call netcdf_err(stat,Status)
2975     if(Status /= WRF_NO_ERR) then
2976       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
2977       call wrf_debug ( WARN , msg)
2978       return
2979     endif
2980   else
2981     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2982     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2983     call wrf_debug ( FATAL , msg)
2984     return
2985   endif
2986 #endif
2987   return
2988 end subroutine ext_pio_put_var_td_real_sca
2989
2990 subroutine ext_pio_put_var_ti_double_arr(DataHandle,Element,Var,Data,Count,Status)
2991   use pio_kinds
2992   use pio
2993   use wrf_data_pio
2994   use pio_routines
2995   implicit none
2996   include 'wrf_status_codes.h'
2997   integer               ,intent(in)     :: DataHandle
2998   character*(*)         ,intent(in)     :: Element
2999   character*(*)         ,intent(in)     :: Var
3000   real*8                ,intent(in)     :: Data(:)
3001   integer               ,intent(in)     :: Count
3002   integer               ,intent(out)    :: Status
3003   type(wrf_data_handle) ,pointer        :: DH
3004   character (VarNameLen)                :: VarName
3005   integer                               :: stat
3006   integer                               :: i
3007   integer                               :: NVar
3008   character*1                           :: null
3009
3010   null=char(0)
3011   VarName = Var
3012   call GetDH(DataHandle,DH,Status)
3013   if(Status /= WRF_NO_ERR) then
3014     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3015     call wrf_debug ( WARN , msg)
3016     return
3017   endif
3018   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3019     Status = WRF_WARN_FILE_NOT_OPENED
3020     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3021     call wrf_debug ( WARN , msg)
3022   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3023     Status = WRF_WARN_WRITE_RONLY_FILE
3024     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3025     call wrf_debug ( WARN , msg)
3026   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3027     Status = WRF_WARN_MD_AFTER_OPEN
3028     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
3029     call wrf_debug ( WARN , msg)
3030     return
3031   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3032     do NVar=1,MaxVars
3033       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
3034         exit
3035       elseif(NVar == MaxVars) then
3036         Status = WRF_WARN_VAR_NF
3037         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
3038                         ,NVar,VarName
3039         call wrf_debug ( WARN , msg)
3040         return
3041       endif
3042     enddo
3043     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data )
3044     call netcdf_err(stat,Status)
3045     if(Status /= WRF_NO_ERR) then
3046       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
3047                    ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
3048       call wrf_debug ( WARN , msg)
3049     endif
3050   else
3051     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3052     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3053     call wrf_debug ( FATAL , msg)
3054     return
3055   endif
3056   return
3057 end subroutine ext_pio_put_var_ti_double_arr
3058
3059 subroutine ext_pio_put_var_ti_double_sca(DataHandle,Element,Var,Data,Count,Status)
3060   use pio_kinds
3061   use pio
3062   use wrf_data_pio
3063   use pio_routines
3064   implicit none
3065   include 'wrf_status_codes.h'
3066   integer               ,intent(in)     :: DataHandle
3067   character*(*)         ,intent(in)     :: Element
3068   character*(*)         ,intent(in)     :: Var
3069   real*8                ,intent(in)     :: Data
3070   integer               ,intent(in)     :: Count
3071   integer               ,intent(out)    :: Status
3072   type(wrf_data_handle) ,pointer        :: DH
3073   character (VarNameLen)                :: VarName
3074   integer                               :: stat
3075   real*8                                :: Buffer(1)
3076   integer                               :: i
3077   integer                               :: NVar
3078   character*1                           :: null
3079
3080   null=char(0)
3081   VarName = Var
3082   call GetDH(DataHandle,DH,Status)
3083   if(Status /= WRF_NO_ERR) then
3084     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3085     call wrf_debug ( WARN , msg)
3086     return
3087   endif
3088   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3089     Status = WRF_WARN_FILE_NOT_OPENED
3090     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3091     call wrf_debug ( WARN , msg)
3092   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3093     Status = WRF_WARN_WRITE_RONLY_FILE
3094     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3095     call wrf_debug ( WARN , msg)
3096   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3097     Status = WRF_WARN_MD_AFTER_OPEN
3098     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
3099     call wrf_debug ( WARN , msg)
3100     return
3101   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3102     do NVar=1,MaxVars
3103       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
3104         exit
3105       elseif(NVar == MaxVars) then
3106         Status = WRF_WARN_VAR_NF
3107         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
3108                         ,NVar,VarName
3109         call wrf_debug ( WARN , msg)
3110         return
3111       endif
3112     enddo
3113     Buffer(1) = Data
3114     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer)
3115     call netcdf_err(stat,Status)
3116     if(Status /= WRF_NO_ERR) then
3117       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
3118                    ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
3119       call wrf_debug ( WARN , msg)
3120     endif
3121   else
3122     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3123     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3124     call wrf_debug ( FATAL , msg)
3125     return
3126   endif
3127   return
3128 end subroutine ext_pio_put_var_ti_double_sca
3129
3130 subroutine ext_pio_put_var_td_double_arr(DataHandle,Element,DateStr,Var,Data,Count,Status)
3131   use pio_kinds
3132   use pio
3133   use wrf_data_pio
3134   use pio_routines
3135   implicit none
3136   include 'wrf_status_codes.h'
3137   integer               ,intent(in)     :: DataHandle
3138   character*(*)         ,intent(in)     :: Element
3139   character*(*)         ,intent(in)     :: DateStr
3140   character*(*)         ,intent(in)     :: Var
3141   real*8                ,intent(in)     :: Data(:)
3142   integer               ,intent(in)     :: Count
3143   integer               ,intent(out)    :: Status
3144   type(wrf_data_handle) ,pointer        :: DH
3145   character (VarNameLen)                :: VarName
3146   character (40+len(Element))           :: Name
3147   integer                               :: stat
3148   integer                               :: i
3149   integer                               :: VDims (2)
3150   integer                               :: VStart(2)
3151   integer                               :: VCount(2)
3152   integer                               :: NVar
3153   integer                               :: TimeIndex
3154
3155   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3156   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3157   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3158
3159 #if 0
3160   VarName = Var
3161   call DateCheck(DateStr,Status)
3162   if(Status /= WRF_NO_ERR) then
3163     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3164     call wrf_debug ( WARN , msg)
3165     return
3166   endif
3167   call GetDH(DataHandle,DH,Status)
3168   if(Status /= WRF_NO_ERR) then
3169     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3170     call wrf_debug ( WARN , msg)
3171     return
3172   endif
3173   call GetName(Element, VarName, Name, Status)
3174   if(Status /= WRF_NO_ERR) then
3175     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3176     call wrf_debug ( WARN , msg)
3177     return
3178   endif
3179   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3180     Status = WRF_WARN_FILE_NOT_OPENED
3181     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3182     call wrf_debug ( WARN , msg)
3183   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3184     Status = WRF_WARN_WRITE_RONLY_FILE
3185     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3186     call wrf_debug ( WARN , msg)
3187   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3188     if(Count < 1) then
3189       Status = WRF_WARN_ZERO_LENGTH_PUT
3190       return
3191     endif
3192     do NVar=1,MaxVars
3193       if(DH%VarNames(NVar) == Name) then
3194         Status = WRF_WARN_2DRYRUNS_1VARIABLE
3195         return
3196       elseif(DH%VarNames(NVar) == NO_NAME) then
3197         DH%VarNames(NVar) = Name
3198         exit
3199       elseif(NVar == MaxVars) then
3200         Status = WRF_WARN_TOO_MANY_VARIABLES
3201         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3202         call wrf_debug ( WARN , msg)
3203         return
3204       endif
3205     enddo
3206     do i=1,MaxDims
3207       if(DH%DimLengths(i) == Count) then
3208         exit
3209       elseif(DH%DimLengths(i) == NO_DIM) then
3210         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
3211         call netcdf_err(stat,Status)
3212         if(Status /= WRF_NO_ERR) then
3213           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3214           call wrf_debug ( WARN , msg)
3215           return
3216         endif
3217         DH%DimLengths(i) = Count
3218         exit
3219       elseif(i == MaxDims) then
3220         Status = WRF_WARN_TOO_MANY_DIMS
3221         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
3222         call wrf_debug ( WARN , msg)
3223         return
3224       endif
3225     enddo
3226     DH%VarDimLens(1,NVar) = Count
3227     VDims(1) = DH%DimIDs(i)
3228     VDims(2) = DH%DimUnlimID
3229     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3230     write(unit=0, fmt='(3a,i6)') '4 Define Var <', trim(Var), '> as NVvar:', NVar
3231     stat = pio_def_var(DH%file_handle,Name,PIO_DOUBLE,DH%descVar(NVar))
3232     call netcdf_err(stat,Status)
3233     if(Status /= WRF_NO_ERR) then
3234       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3235       call wrf_debug ( WARN , msg)
3236       return
3237     endif
3238   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3239     do NVar=1,MaxVars
3240       if(DH%VarNames(NVar) == Name) then
3241         exit
3242       elseif(DH%VarNames(NVar) == NO_NAME) then
3243         Status = WRF_WARN_MD_NF
3244         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
3245         call wrf_debug ( WARN , msg)
3246         return
3247       elseif(NVar == MaxVars) then
3248         Status = WRF_WARN_TOO_MANY_VARIABLES
3249         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3250         call wrf_debug ( WARN , msg)
3251         return
3252       endif
3253     enddo
3254     if(Count > DH%VarDimLens(1,NVar)) then
3255       Status = WRF_WARN_COUNT_TOO_LONG
3256       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
3257       call wrf_debug ( WARN , msg)
3258       return
3259     elseif(Count < 1) then
3260       Status = WRF_WARN_ZERO_LENGTH_PUT
3261       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
3262       call wrf_debug ( WARN , msg)
3263       return
3264     endif
3265     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
3266     if(Status /= WRF_NO_ERR) then
3267       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
3268       call wrf_debug ( WARN , msg)
3269       return
3270     endif
3271     VStart(1) = 1
3272     VStart(2) = TimeIndex
3273     VCount(1) = Count
3274     VCount(2) = 1
3275    !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Data)
3276     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data)
3277     call netcdf_err(stat,Status)
3278     if(Status /= WRF_NO_ERR) then
3279       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3280       call wrf_debug ( WARN , msg)
3281       return
3282     endif
3283   else
3284     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3285     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3286     call wrf_debug ( FATAL , msg)
3287     return
3288   endif
3289 #endif
3290   return
3291 end subroutine ext_pio_put_var_td_double_arr
3292
3293 subroutine ext_pio_put_var_td_double_sca(DataHandle,Element,DateStr,Var,Data,Count,Status)
3294   use pio_kinds
3295   use pio
3296   use wrf_data_pio
3297   use pio_routines
3298   implicit none
3299   include 'wrf_status_codes.h'
3300   integer               ,intent(in)     :: DataHandle
3301   character*(*)         ,intent(in)     :: Element
3302   character*(*)         ,intent(in)     :: DateStr
3303   character*(*)         ,intent(in)     :: Var
3304   real*8                ,intent(in)     :: Data
3305   integer               ,intent(in)     :: Count
3306   integer               ,intent(out)    :: Status
3307   type(wrf_data_handle) ,pointer        :: DH
3308   character (VarNameLen)                :: VarName
3309   character (40+len(Element))           :: Name
3310   integer                               :: stat
3311   integer                               :: i
3312   integer                               :: VDims (2)
3313   integer                               :: VStart(2)
3314   integer                               :: VCount(2)
3315   integer                               :: NVar
3316   integer                               :: TimeIndex
3317   real*8                                :: Buffer(1)
3318
3319   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3320   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3321   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3322
3323 #if 0
3324   VarName = Var
3325   call DateCheck(DateStr,Status)
3326   if(Status /= WRF_NO_ERR) then
3327     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3328     call wrf_debug ( WARN , msg)
3329     return
3330   endif
3331   call GetDH(DataHandle,DH,Status)
3332   if(Status /= WRF_NO_ERR) then
3333     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3334     call wrf_debug ( WARN , msg)
3335     return
3336   endif
3337   call GetName(Element, VarName, Name, Status)
3338   if(Status /= WRF_NO_ERR) then
3339     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3340     call wrf_debug ( WARN , msg)
3341     return
3342   endif
3343   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3344     Status = WRF_WARN_FILE_NOT_OPENED
3345     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3346     call wrf_debug ( WARN , msg)
3347   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3348     Status = WRF_WARN_WRITE_RONLY_FILE
3349     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3350     call wrf_debug ( WARN , msg)
3351   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3352     if(Count < 1) then
3353       Status = WRF_WARN_ZERO_LENGTH_PUT
3354       return
3355     endif
3356     do NVar=1,MaxVars
3357       if(DH%VarNames(NVar) == Name) then
3358         Status = WRF_WARN_2DRYRUNS_1VARIABLE
3359         return
3360       elseif(DH%VarNames(NVar) == NO_NAME) then
3361         DH%VarNames(NVar) = Name
3362         exit
3363       elseif(NVar == MaxVars) then
3364         Status = WRF_WARN_TOO_MANY_VARIABLES
3365         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3366         call wrf_debug ( WARN , msg)
3367         return
3368       endif
3369     enddo
3370     do i=1,MaxDims
3371       if(DH%DimLengths(i) == Count) then
3372         exit
3373       elseif(DH%DimLengths(i) == NO_DIM) then
3374         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
3375         call netcdf_err(stat,Status)
3376         if(Status /= WRF_NO_ERR) then
3377           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3378           call wrf_debug ( WARN , msg)
3379           return
3380         endif
3381         DH%DimLengths(i) = Count
3382         exit
3383       elseif(i == MaxDims) then
3384         Status = WRF_WARN_TOO_MANY_DIMS
3385         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
3386         call wrf_debug ( WARN , msg)
3387         return
3388       endif
3389     enddo
3390     DH%VarDimLens(1,NVar) = Count
3391     VDims(1) = DH%DimIDs(i)
3392     VDims(2) = DH%DimUnlimID
3393     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3394     write(unit=0, fmt='(3a,i6)') '5 Define Var <', trim(Var), '> as NVar:', NVar
3395     stat = pio_def_var(DH%file_handle,Name,PIO_DOUBLE,DH%descVar(NVar))
3396     call netcdf_err(stat,Status)
3397     if(Status /= WRF_NO_ERR) then
3398       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3399       call wrf_debug ( WARN , msg)
3400       return
3401     endif
3402   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3403     do NVar=1,MaxVars
3404       if(DH%VarNames(NVar) == Name) then
3405         exit
3406       elseif(DH%VarNames(NVar) == NO_NAME) then
3407         Status = WRF_WARN_MD_NF
3408         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
3409         call wrf_debug ( WARN , msg)
3410         return
3411       elseif(NVar == MaxVars) then
3412         Status = WRF_WARN_TOO_MANY_VARIABLES
3413         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3414         call wrf_debug ( WARN , msg)
3415         return
3416       endif
3417     enddo
3418     if(Count > DH%VarDimLens(1,NVar)) then
3419       Status = WRF_WARN_COUNT_TOO_LONG
3420       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
3421       call wrf_debug ( WARN , msg)
3422       return
3423     elseif(Count < 1) then
3424       Status = WRF_WARN_ZERO_LENGTH_PUT
3425       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
3426       call wrf_debug ( WARN , msg)
3427       return
3428     endif
3429     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
3430     if(Status /= WRF_NO_ERR) then
3431       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
3432       call wrf_debug ( WARN , msg)
3433       return
3434     endif
3435     VStart(1) = 1
3436     VStart(2) = TimeIndex
3437     VCount(1) = Count
3438     VCount(2) = 1
3439     Buffer(1) = Data
3440    !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Buffer)
3441     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer)
3442     call netcdf_err(stat,Status)
3443     if(Status /= WRF_NO_ERR) then
3444       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3445       call wrf_debug ( WARN , msg)
3446       return
3447     endif
3448   else
3449     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3450     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3451     call wrf_debug ( FATAL , msg)
3452     return
3453   endif
3454 #endif
3455   return
3456 end subroutine ext_pio_put_var_td_double_sca
3457
3458 subroutine ext_pio_put_var_ti_integer_arr(DataHandle,Element,Var,Data,Count,Status)
3459   use pio_kinds
3460   use pio
3461   use wrf_data_pio
3462   use pio_routines
3463   implicit none
3464   include 'wrf_status_codes.h'
3465   integer               ,intent(in)     :: DataHandle
3466   character*(*)         ,intent(in)     :: Element
3467   character*(*)         ,intent(in)     :: Var
3468   integer,               intent(in)     :: Data(:)
3469   integer,               intent(in)     :: Count
3470   integer               ,intent(out)    :: Status
3471   type(wrf_data_handle) ,pointer        :: DH
3472   character (VarNameLen)                :: VarName
3473   integer                               :: stat
3474   integer                               :: i
3475   integer                               :: NVar
3476   character*1                           :: null
3477
3478   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3479   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3480   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3481
3482 #if 0
3483   null=char(0)
3484   VarName = Var
3485   call GetDH(DataHandle,DH,Status)
3486   if(Status /= WRF_NO_ERR) then
3487     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3488     return
3489   endif
3490   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3491     Status = WRF_WARN_FILE_NOT_OPENED
3492     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3493     call wrf_debug ( WARN , msg)
3494   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3495     Status = WRF_WARN_WRITE_RONLY_FILE
3496     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3497     call wrf_debug ( WARN , msg)
3498   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3499     Status = WRF_WARN_MD_AFTER_OPEN
3500     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
3501     call wrf_debug ( WARN , msg)
3502     return
3503   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3504     do NVar=1,MaxVars
3505       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
3506         exit
3507       elseif(NVar == MaxVars) then
3508         Status = WRF_WARN_VAR_NF
3509         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
3510                         ,NVar,VarName
3511         call wrf_debug ( WARN , msg)
3512         return
3513       endif
3514     enddo
3515     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data)
3516     call netcdf_err(stat,Status)
3517     if(Status /= WRF_NO_ERR) then
3518       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
3519         ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
3520       call wrf_debug ( WARN , msg)
3521     endif
3522   else
3523     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3524     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3525     call wrf_debug ( FATAL , msg)
3526     return
3527   endif
3528 #endif
3529   return
3530 end subroutine ext_pio_put_var_ti_integer_arr
3531
3532 subroutine ext_pio_put_var_ti_integer_sca(DataHandle,Element,Var,Data,Count,Status)
3533   use pio_kinds
3534   use pio
3535   use wrf_data_pio
3536   use pio_routines
3537   implicit none
3538   include 'wrf_status_codes.h'
3539   integer               ,intent(in)     :: DataHandle
3540   character*(*)         ,intent(in)     :: Element
3541   character*(*)         ,intent(in)     :: Var
3542   integer,               intent(in)     :: Data
3543   integer,               intent(in)     :: Count
3544   integer               ,intent(out)    :: Status
3545   type(wrf_data_handle) ,pointer        :: DH
3546   character (VarNameLen)                :: VarName
3547   integer                               :: stat
3548   integer                               :: Buffer(1)
3549   integer                               :: i
3550   integer                               :: NVar
3551   character*1                           :: null
3552
3553   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3554   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3555   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3556
3557 #if 0
3558   null=char(0)
3559   VarName = Var
3560   call GetDH(DataHandle,DH,Status)
3561   if(Status /= WRF_NO_ERR) then
3562     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3563     return
3564   endif
3565   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3566     Status = WRF_WARN_FILE_NOT_OPENED
3567     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3568     call wrf_debug ( WARN , msg)
3569   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3570     Status = WRF_WARN_WRITE_RONLY_FILE
3571     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3572     call wrf_debug ( WARN , msg)
3573   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3574     Status = WRF_WARN_MD_AFTER_OPEN
3575     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__
3576     call wrf_debug ( WARN , msg)
3577     return
3578   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3579     do NVar=1,MaxVars
3580       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
3581         exit
3582       elseif(NVar == MaxVars) then
3583         Status = WRF_WARN_VAR_NF
3584         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ &
3585                         ,NVar,VarName
3586         call wrf_debug ( WARN , msg)
3587         return
3588       endif
3589     enddo
3590     Buffer(1) = Data
3591     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer)
3592     call netcdf_err(stat,Status)
3593     if(Status /= WRF_NO_ERR) then
3594       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
3595         ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__
3596       call wrf_debug ( WARN , msg)
3597     endif
3598   else
3599     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3600     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3601     call wrf_debug ( FATAL , msg)
3602     return
3603   endif
3604 #endif
3605   return
3606 end subroutine ext_pio_put_var_ti_integer_sca
3607
3608 subroutine ext_pio_put_var_td_integer_arr(DataHandle,Element,DateStr,Var,Data,Count,Status)
3609   use pio_kinds
3610   use pio
3611   use wrf_data_pio
3612   use pio_routines
3613   implicit none
3614   include 'wrf_status_codes.h'
3615   integer               ,intent(in)     :: DataHandle
3616   character*(*)         ,intent(in)     :: Element
3617   character*(*)         ,intent(in)     :: DateStr
3618   character*(*)         ,intent(in)     :: Var
3619   integer,               intent(in)     :: Data(:)
3620   integer,               intent(in)     :: Count
3621   integer               ,intent(out)    :: Status
3622   type(wrf_data_handle) ,pointer        :: DH
3623   character (VarNameLen)                :: VarName
3624   character (40+len(Element))           :: Name
3625   integer                               :: stat
3626   integer                               :: i
3627   integer                               :: VDims (2)
3628   integer                               :: VStart(2)
3629   integer                               :: VCount(2)
3630   integer                               :: NVar
3631   integer                               :: TimeIndex
3632
3633   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3634   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3635   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3636
3637 #if 0
3638   VarName = Var
3639   call DateCheck(DateStr,Status)
3640   if(Status /= WRF_NO_ERR) then
3641     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3642     call wrf_debug ( WARN , msg)
3643     return
3644   endif
3645   call GetDH(DataHandle,DH,Status)
3646   if(Status /= WRF_NO_ERR) then
3647     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3648     call wrf_debug ( WARN , msg)
3649     return
3650   endif
3651   call GetName(Element, VarName, Name, Status)
3652   if(Status /= WRF_NO_ERR) then
3653     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3654     call wrf_debug ( WARN , msg)
3655     return
3656   endif
3657   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3658     Status = WRF_WARN_FILE_NOT_OPENED
3659     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3660     call wrf_debug ( WARN , msg)
3661   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3662     Status = WRF_WARN_WRITE_RONLY_FILE
3663     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3664     call wrf_debug ( WARN , msg)
3665   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3666     if(Count < 1) then
3667       Status = WRF_WARN_ZERO_LENGTH_PUT
3668       return
3669     endif
3670     do NVar=1,MaxVars
3671       if(DH%VarNames(NVar) == Name) then
3672         Status = WRF_WARN_2DRYRUNS_1VARIABLE
3673         return
3674       elseif(DH%VarNames(NVar) == NO_NAME) then
3675         DH%VarNames(NVar) = Name
3676         exit
3677       elseif(NVar == MaxVars) then
3678         Status = WRF_WARN_TOO_MANY_VARIABLES
3679         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3680         call wrf_debug ( WARN , msg)
3681         return
3682       endif
3683     enddo
3684     do i=1,MaxDims
3685       if(DH%DimLengths(i) == Count) then
3686         exit
3687       elseif(DH%DimLengths(i) == NO_DIM) then
3688         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
3689         call netcdf_err(stat,Status)
3690         if(Status /= WRF_NO_ERR) then
3691           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3692           call wrf_debug ( WARN , msg)
3693           return
3694         endif
3695         DH%DimLengths(i) = Count
3696         exit
3697       elseif(i == MaxDims) then
3698         Status = WRF_WARN_TOO_MANY_DIMS
3699         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
3700         call wrf_debug ( WARN , msg)
3701         return
3702       endif
3703     enddo
3704     DH%VarDimLens(1,NVar) = Count
3705     VDims(1) = DH%DimIDs(i)
3706     VDims(2) = DH%DimUnlimID
3707     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3708     write(unit=0, fmt='(3a,i6)') '6 Define Var <', trim(Var), '> as NVar:', NVar
3709     stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar))
3710     call netcdf_err(stat,Status)
3711     if(Status /= WRF_NO_ERR) then
3712       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3713       call wrf_debug ( WARN , msg)
3714       return
3715     endif
3716   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3717     do NVar=1,MaxVars
3718       if(DH%VarNames(NVar) == Name) then
3719         exit
3720       elseif(DH%VarNames(NVar) == NO_NAME) then
3721         Status = WRF_WARN_MD_NF
3722         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
3723         call wrf_debug ( WARN , msg)
3724         return
3725       elseif(NVar == MaxVars) then
3726         Status = WRF_WARN_TOO_MANY_VARIABLES
3727         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3728         call wrf_debug ( WARN , msg)
3729         return
3730       endif
3731     enddo
3732     if(Count > DH%VarDimLens(1,NVar)) then
3733       Status = WRF_WARN_COUNT_TOO_LONG
3734       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
3735       call wrf_debug ( WARN , msg)
3736       return
3737     elseif(Count < 1) then
3738       Status = WRF_WARN_ZERO_LENGTH_PUT
3739       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
3740       call wrf_debug ( WARN , msg)
3741       return
3742     endif
3743     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
3744     if(Status /= WRF_NO_ERR) then
3745       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
3746       call wrf_debug ( WARN , msg)
3747       return
3748     endif
3749     VStart(1) = 1
3750     VStart(2) = TimeIndex
3751     VCount(1) = Count
3752     VCount(2) = 1
3753    !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Data)
3754     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data)
3755     call netcdf_err(stat,Status)
3756     if(Status /= WRF_NO_ERR) then
3757       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3758       call wrf_debug ( WARN , msg)
3759       return
3760     endif
3761   else
3762     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3763     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3764     call wrf_debug ( FATAL , msg)
3765     return
3766   endif
3767 #endif
3768   return
3769 end subroutine ext_pio_put_var_td_integer_arr
3770
3771 subroutine ext_pio_put_var_td_integer_sca(DataHandle,Element,DateStr,Var,Data,Count,Status)
3772   use pio_kinds
3773   use pio
3774   use wrf_data_pio
3775   use pio_routines
3776   implicit none
3777   include 'wrf_status_codes.h'
3778   integer               ,intent(in)     :: DataHandle
3779   character*(*)         ,intent(in)     :: Element
3780   character*(*)         ,intent(in)     :: DateStr
3781   character*(*)         ,intent(in)     :: Var
3782   integer,               intent(in)     :: Data
3783   integer,               intent(in)     :: Count
3784   integer               ,intent(out)    :: Status
3785   type(wrf_data_handle) ,pointer        :: DH
3786   character (VarNameLen)                :: VarName
3787   character (40+len(Element))           :: Name
3788   integer                               :: stat
3789   integer                               :: i
3790   integer                               :: VDims (2)
3791   integer                               :: VStart(2)
3792   integer                               :: VCount(2)
3793   integer                               :: NVar
3794   integer                               :: TimeIndex
3795   integer                               :: Buffer(1)
3796
3797   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3798   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3799   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3800
3801 #if 0
3802   VarName = Var
3803   call DateCheck(DateStr,Status)
3804   if(Status /= WRF_NO_ERR) then
3805     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3806     call wrf_debug ( WARN , msg)
3807     return
3808   endif
3809   call GetDH(DataHandle,DH,Status)
3810   if(Status /= WRF_NO_ERR) then
3811     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3812     call wrf_debug ( WARN , msg)
3813     return
3814   endif
3815   call GetName(Element, VarName, Name, Status)
3816   if(Status /= WRF_NO_ERR) then
3817     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3818     call wrf_debug ( WARN , msg)
3819     return
3820   endif
3821   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3822     Status = WRF_WARN_FILE_NOT_OPENED
3823     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3824     call wrf_debug ( WARN , msg)
3825   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3826     Status = WRF_WARN_WRITE_RONLY_FILE
3827     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
3828     call wrf_debug ( WARN , msg)
3829   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3830     if(Count < 1) then
3831       Status = WRF_WARN_ZERO_LENGTH_PUT
3832       return
3833     endif
3834     do NVar=1,MaxVars
3835       if(DH%VarNames(NVar) == Name) then
3836         Status = WRF_WARN_2DRYRUNS_1VARIABLE
3837         return
3838       elseif(DH%VarNames(NVar) == NO_NAME) then
3839         DH%VarNames(NVar) = Name
3840         exit
3841       elseif(NVar == MaxVars) then
3842         Status = WRF_WARN_TOO_MANY_VARIABLES
3843         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3844         call wrf_debug ( WARN , msg)
3845         return
3846       endif
3847     enddo
3848     do i=1,MaxDims
3849       if(DH%DimLengths(i) == Count) then
3850         exit
3851       elseif(DH%DimLengths(i) == NO_DIM) then
3852         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
3853         call netcdf_err(stat,Status)
3854         if(Status /= WRF_NO_ERR) then
3855           write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3856           call wrf_debug ( WARN , msg)
3857           return
3858         endif
3859         DH%DimLengths(i) = Count
3860         exit
3861       elseif(i == MaxDims) then
3862         Status = WRF_WARN_TOO_MANY_DIMS
3863         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
3864         call wrf_debug ( WARN , msg)
3865         return
3866       endif
3867     enddo
3868     DH%VarDimLens(1,NVar) = Count
3869     VDims(1) = DH%DimIDs(i)
3870     VDims(2) = DH%DimUnlimID
3871     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3872     write(unit=0, fmt='(3a,i6)') '7 Define Var <', trim(Var), '> as NVar:', NVar
3873     stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar))
3874     call netcdf_err(stat,Status)
3875     if(Status /= WRF_NO_ERR) then
3876       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3877       call wrf_debug ( WARN , msg)
3878       return
3879     endif
3880   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3881     do NVar=1,MaxVars
3882       if(DH%VarNames(NVar) == Name) then
3883         exit
3884       elseif(DH%VarNames(NVar) == NO_NAME) then
3885         Status = WRF_WARN_MD_NF
3886         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__
3887         call wrf_debug ( WARN , msg)
3888         return
3889       elseif(NVar == MaxVars) then
3890         Status = WRF_WARN_TOO_MANY_VARIABLES
3891         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
3892         call wrf_debug ( WARN , msg)
3893         return
3894       endif
3895     enddo
3896     if(Count > DH%VarDimLens(1,NVar)) then
3897       Status = WRF_WARN_COUNT_TOO_LONG
3898       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__
3899       call wrf_debug ( WARN , msg)
3900       return
3901     elseif(Count < 1) then
3902       Status = WRF_WARN_ZERO_LENGTH_PUT
3903       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__
3904       call wrf_debug ( WARN , msg)
3905       return
3906     endif
3907     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
3908     if(Status /= WRF_NO_ERR) then
3909       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
3910       call wrf_debug ( WARN , msg)
3911       return
3912     endif
3913     VStart(1) = 1
3914     VStart(2) = TimeIndex
3915     VCount(1) = Count
3916     VCount(2) = 1
3917     Buffer(1) = Data
3918    !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
3919     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer)
3920     call netcdf_err(stat,Status)
3921     if(Status /= WRF_NO_ERR) then
3922       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
3923       call wrf_debug ( WARN , msg)
3924       return
3925     endif
3926   else
3927     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3928     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3929     call wrf_debug ( FATAL , msg)
3930     return
3931   endif
3932 #endif
3933   return
3934 end subroutine ext_pio_put_var_td_integer_sca
3935
3936 subroutine ext_pio_put_var_ti_logical_arr(DataHandle,Element,Var,Data,Count,Status)
3937   use pio_kinds
3938   use pio
3939   use wrf_data_pio
3940   use pio_routines
3941   implicit none
3942   include 'wrf_status_codes.h'
3943   integer               ,intent(in)     :: DataHandle
3944   character*(*)         ,intent(in)     :: Element
3945   character*(*)         ,intent(in)     :: Var
3946   logical,               intent(in)     :: Data(:)
3947   integer,               intent(in)     :: Count
3948   integer               ,intent(out)    :: Status
3949   type(wrf_data_handle) ,pointer        :: DH
3950   character (VarNameLen)                :: VarName
3951   integer                               :: stat
3952   integer               ,allocatable    :: Buffer(:)
3953   integer                               :: i
3954   integer                               :: NVar
3955   character*1                           :: null
3956
3957   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3958   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3959   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
3960
3961 #if 0
3962   null=char(0)
3963   VarName = Var
3964   call GetDH(DataHandle,DH,Status)
3965   if(Status /= WRF_NO_ERR) then
3966     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
3967     call wrf_debug ( WARN , msg)
3968     return
3969   endif
3970   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3971     Status = WRF_WARN_FILE_NOT_OPENED
3972     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
3973     call wrf_debug ( WARN , msg)
3974   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3975     Status = WRF_WARN_WRITE_RONLY_FILE
3976     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
3977     call wrf_debug ( WARN , msg)
3978   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3979     Status = WRF_WARN_MD_AFTER_OPEN
3980     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','LOGICAL',', line', __LINE__
3981     call wrf_debug ( WARN , msg)
3982     return
3983   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3984     do NVar=1,MaxVars
3985       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
3986         exit
3987       elseif(NVar == MaxVars) then
3988         Status = WRF_WARN_VAR_NF
3989         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ &
3990                         ,NVar,VarName
3991         call wrf_debug ( WARN , msg)
3992         return
3993       endif
3994     enddo
3995     allocate(Buffer(Count), STAT=stat)
3996     if(stat/= 0) then
3997       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
3998       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
3999       call wrf_debug ( FATAL , msg)
4000       return
4001     endif
4002     do i=1,Count
4003       if(data(i)) then
4004          Buffer(i)=1
4005       else
4006          Buffer(i)=0
4007       endif
4008     enddo
4009     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer)
4010     call netcdf_err(stat,Status)
4011     if(Status /= WRF_NO_ERR) then
4012       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
4013         ' Element ',trim(Element),' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4014       call wrf_debug ( WARN , msg)
4015     endif
4016     deallocate(Buffer, STAT=stat)
4017     if(stat/= 0) then
4018       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
4019       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4020       call wrf_debug ( FATAL , msg)
4021       return
4022     endif
4023   else
4024     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4025     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4026     call wrf_debug ( FATAL , msg)
4027     return
4028   endif
4029 #endif
4030   return
4031 end subroutine ext_pio_put_var_ti_logical_arr
4032
4033 subroutine ext_pio_put_var_ti_logical_sca(DataHandle,Element,Var,Data,Count,Status)
4034   use pio_kinds
4035   use pio
4036   use wrf_data_pio
4037   use pio_routines
4038   implicit none
4039   include 'wrf_status_codes.h'
4040   integer               ,intent(in)     :: DataHandle
4041   character*(*)         ,intent(in)     :: Element
4042   character*(*)         ,intent(in)     :: Var
4043   logical,               intent(in)     :: Data
4044   integer,               intent(in)     :: Count
4045   integer               ,intent(out)    :: Status
4046   type(wrf_data_handle) ,pointer        :: DH
4047   character (VarNameLen)                :: VarName
4048   integer                               :: stat
4049   integer                               :: Buffer(1)
4050   integer                               :: i
4051   integer                               :: NVar
4052   character*1                           :: null
4053
4054   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4055   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4056   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4057
4058 #if 0
4059   null=char(0)
4060   VarName = Var
4061   call GetDH(DataHandle,DH,Status)
4062   if(Status /= WRF_NO_ERR) then
4063     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4064     call wrf_debug ( WARN , msg)
4065     return
4066   endif
4067   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4068     Status = WRF_WARN_FILE_NOT_OPENED
4069     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
4070     call wrf_debug ( WARN , msg)
4071   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4072     Status = WRF_WARN_WRITE_RONLY_FILE
4073     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
4074     call wrf_debug ( WARN , msg)
4075   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4076     Status = WRF_WARN_MD_AFTER_OPEN
4077     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','LOGICAL',', line', __LINE__
4078     call wrf_debug ( WARN , msg)
4079     return
4080   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4081     do NVar=1,MaxVars
4082       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
4083         exit
4084       elseif(NVar == MaxVars) then
4085         Status = WRF_WARN_VAR_NF
4086         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ &
4087                         ,NVar,VarName
4088         call wrf_debug ( WARN , msg)
4089         return
4090       endif
4091     enddo
4092     if(Data) then
4093        Buffer(1)=1
4094     else
4095        Buffer(1)=0
4096     endif
4097     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer)
4098     call netcdf_err(stat,Status)
4099     if(Status /= WRF_NO_ERR) then
4100       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
4101         ' Element ',trim(Element),' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4102       call wrf_debug ( WARN , msg)
4103     endif
4104     if(stat/= 0) then
4105       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
4106       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4107       call wrf_debug ( FATAL , msg)
4108       return
4109     endif
4110   else
4111     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4112     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4113     call wrf_debug ( FATAL , msg)
4114     return
4115   endif
4116 #endif
4117   return
4118 end subroutine ext_pio_put_var_ti_logical_sca
4119
4120 subroutine ext_pio_put_var_td_logical_arr(DataHandle,Element,DateStr,Var,Data,Count,Status)
4121   use pio_kinds
4122   use pio
4123   use wrf_data_pio
4124   use pio_routines
4125   implicit none
4126   include 'wrf_status_codes.h'
4127   integer               ,intent(in)     :: DataHandle
4128   character*(*)         ,intent(in)     :: Element
4129   character*(*)         ,intent(in)     :: DateStr
4130   character*(*)         ,intent(in)     :: Var
4131   logical,               intent(in)     :: Data(:)
4132   integer,               intent(in)     :: Count
4133   integer               ,intent(out)    :: Status
4134   type(wrf_data_handle) ,pointer        :: DH
4135   character (VarNameLen)                :: VarName
4136   character (40+len(Element))           :: Name
4137   integer                               :: stat
4138   integer               ,allocatable    :: Buffer(:)
4139   integer                               :: i
4140   integer                               :: VDims (2)
4141   integer                               :: VStart(2)
4142   integer                               :: VCount(2)
4143   integer                               :: NVar
4144   integer                               :: TimeIndex
4145
4146   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4147   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4148   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4149
4150 #if 0
4151   VarName = Var
4152   call DateCheck(DateStr,Status)
4153   if(Status /= WRF_NO_ERR) then
4154     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4155     call wrf_debug ( WARN , msg)
4156     return
4157   endif
4158   call GetDH(DataHandle,DH,Status)
4159   if(Status /= WRF_NO_ERR) then
4160     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4161     call wrf_debug ( WARN , msg)
4162     return
4163   endif
4164   call GetName(Element, VarName, Name, Status)
4165   if(Status /= WRF_NO_ERR) then
4166     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4167     call wrf_debug ( WARN , msg)
4168     return
4169   endif
4170   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4171     Status = WRF_WARN_FILE_NOT_OPENED
4172     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
4173     call wrf_debug ( WARN , msg)
4174   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4175     Status = WRF_WARN_WRITE_RONLY_FILE
4176     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
4177     call wrf_debug ( WARN , msg)
4178   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4179     if(Count < 1) then
4180       Status = WRF_WARN_ZERO_LENGTH_PUT
4181       return
4182     endif
4183     do NVar=1,MaxVars
4184       if(DH%VarNames(NVar) == Name) then
4185         Status = WRF_WARN_2DRYRUNS_1VARIABLE
4186         return
4187       elseif(DH%VarNames(NVar) == NO_NAME) then
4188         DH%VarNames(NVar) = Name
4189         exit
4190       elseif(NVar == MaxVars) then
4191         Status = WRF_WARN_TOO_MANY_VARIABLES
4192         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__
4193         call wrf_debug ( WARN , msg)
4194         return
4195       endif
4196     enddo
4197     do i=1,MaxDims
4198       if(DH%DimLengths(i) == Count) then
4199         exit
4200       elseif(DH%DimLengths(i) == NO_DIM) then
4201         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
4202         call netcdf_err(stat,Status)
4203         if(Status /= WRF_NO_ERR) then
4204           write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4205           call wrf_debug ( WARN , msg)
4206           return
4207         endif
4208         DH%DimLengths(i) = Count
4209         exit
4210       elseif(i == MaxDims) then
4211         Status = WRF_WARN_TOO_MANY_DIMS
4212         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4213         call wrf_debug ( WARN , msg)
4214         return
4215       endif
4216     enddo
4217     DH%VarDimLens(1,NVar) = Count
4218     VDims(1) = DH%DimIDs(i)
4219     VDims(2) = DH%DimUnlimID
4220     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4221     write(unit=0, fmt='(3a,i6)') '8 Define Var <', trim(Var), '> as NVar:', NVar
4222     stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar))
4223     call netcdf_err(stat,Status)
4224     if(Status /= WRF_NO_ERR) then
4225       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4226       call wrf_debug ( WARN , msg)
4227       return
4228     endif
4229   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4230     do NVar=1,MaxVars
4231       if(DH%VarNames(NVar) == Name) then
4232         exit
4233       elseif(DH%VarNames(NVar) == NO_NAME) then
4234         Status = WRF_WARN_MD_NF
4235         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__
4236         call wrf_debug ( WARN , msg)
4237         return
4238       elseif(NVar == MaxVars) then
4239         Status = WRF_WARN_TOO_MANY_VARIABLES
4240         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__
4241         call wrf_debug ( WARN , msg)
4242         return
4243       endif
4244     enddo
4245     if(Count > DH%VarDimLens(1,NVar)) then
4246       Status = WRF_WARN_COUNT_TOO_LONG
4247       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','LOGICAL',', line', __LINE__
4248       call wrf_debug ( WARN , msg)
4249       return
4250     elseif(Count < 1) then
4251       Status = WRF_WARN_ZERO_LENGTH_PUT
4252       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','LOGICAL',', line', __LINE__
4253       call wrf_debug ( WARN , msg)
4254       return
4255     endif
4256     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
4257     if(Status /= WRF_NO_ERR) then
4258       write(msg,*)  'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__
4259       call wrf_debug ( WARN , msg)
4260       return
4261     endif
4262     VStart(1) = 1
4263     VStart(2) = TimeIndex
4264     VCount(1) = Count
4265     VCount(2) = 1
4266       allocate(Buffer(Count), STAT=stat)
4267       if(stat/= 0) then
4268         Status = WRF_ERR_FATAL_ALLOCATION_ERROR
4269         write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4270         call wrf_debug ( FATAL , msg)
4271         return
4272       endif
4273       do i=1,Count
4274         if(data(i)) then
4275            Buffer(i)=1
4276         else
4277            Buffer(i)=0
4278         endif
4279       enddo
4280      !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
4281       stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer)
4282       deallocate(Buffer, STAT=stat)
4283       if(stat /= 0) then
4284         Status = WRF_ERR_FATAL_DEALLOCATION_ERR
4285         write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4286         call wrf_debug ( FATAL , msg)
4287         return
4288       endif
4289     call netcdf_err(stat,Status)
4290     if(Status /= WRF_NO_ERR) then
4291       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4292       call wrf_debug ( WARN , msg)
4293       return
4294     endif
4295   else
4296     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4297     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4298     call wrf_debug ( FATAL , msg)
4299     return
4300   endif
4301 #endif
4302   return
4303 end subroutine ext_pio_put_var_td_logical_arr
4304
4305 subroutine ext_pio_put_var_td_logical_sca(DataHandle,Element,DateStr,Var,Data,Count,Status)
4306   use pio_kinds
4307   use pio
4308   use wrf_data_pio
4309   use pio_routines
4310   implicit none
4311   include 'wrf_status_codes.h'
4312   integer               ,intent(in)     :: DataHandle
4313   character*(*)         ,intent(in)     :: Element
4314   character*(*)         ,intent(in)     :: DateStr
4315   character*(*)         ,intent(in)     :: Var
4316   logical,               intent(in)     :: Data
4317   integer,               intent(in)     :: Count
4318   integer               ,intent(out)    :: Status
4319   type(wrf_data_handle) ,pointer        :: DH
4320   character (VarNameLen)                :: VarName
4321   character (40+len(Element))           :: Name
4322   integer                               :: stat
4323   integer                               :: Buffer(1)
4324   integer                               :: i
4325   integer                               :: VDims (2)
4326   integer                               :: VStart(2)
4327   integer                               :: VCount(2)
4328   integer                               :: NVar
4329   integer                               :: TimeIndex
4330
4331   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4332   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4333   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4334
4335 #if 0
4336   VarName = Var
4337   call DateCheck(DateStr,Status)
4338   if(Status /= WRF_NO_ERR) then
4339     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
4340     call wrf_debug ( WARN , msg)
4341     return
4342   endif
4343   call GetDH(DataHandle,DH,Status)
4344   if(Status /= WRF_NO_ERR) then
4345     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4346     call wrf_debug ( WARN , msg)
4347     return
4348   endif
4349   call GetName(Element, VarName, Name, Status)
4350   if(Status /= WRF_NO_ERR) then
4351     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
4352     call wrf_debug ( WARN , msg)
4353     return
4354   endif
4355   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4356     Status = WRF_WARN_FILE_NOT_OPENED
4357     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
4358     call wrf_debug ( WARN , msg)
4359   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4360     Status = WRF_WARN_WRITE_RONLY_FILE
4361     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
4362     call wrf_debug ( WARN , msg)
4363   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4364     if(Count < 1) then
4365       Status = WRF_WARN_ZERO_LENGTH_PUT
4366       return
4367     endif
4368     do NVar=1,MaxVars
4369       if(DH%VarNames(NVar) == Name) then
4370         Status = WRF_WARN_2DRYRUNS_1VARIABLE
4371         return
4372       elseif(DH%VarNames(NVar) == NO_NAME) then
4373         DH%VarNames(NVar) = Name
4374         exit
4375       elseif(NVar == MaxVars) then
4376         Status = WRF_WARN_TOO_MANY_VARIABLES
4377         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__
4378         call wrf_debug ( WARN , msg)
4379         return
4380       endif
4381     enddo
4382     do i=1,MaxDims
4383       if(DH%DimLengths(i) == Count) then
4384         exit
4385       elseif(DH%DimLengths(i) == NO_DIM) then
4386         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i))
4387         call netcdf_err(stat,Status)
4388         if(Status /= WRF_NO_ERR) then
4389           write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4390           call wrf_debug ( WARN , msg)
4391           return
4392         endif
4393         DH%DimLengths(i) = Count
4394         exit
4395       elseif(i == MaxDims) then
4396         Status = WRF_WARN_TOO_MANY_DIMS
4397         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4398         call wrf_debug ( WARN , msg)
4399         return
4400       endif
4401     enddo
4402     DH%VarDimLens(1,NVar) = Count
4403     VDims(1) = DH%DimIDs(i)
4404     VDims(2) = DH%DimUnlimID
4405     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4406     write(unit=0, fmt='(3a,i6)') '9 Define Var <', trim(Var), '> as NVar:', NVar
4407     stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar))
4408     call netcdf_err(stat,Status)
4409     if(Status /= WRF_NO_ERR) then
4410       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4411       call wrf_debug ( WARN , msg)
4412       return
4413     endif
4414   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4415     do NVar=1,MaxVars
4416       if(DH%VarNames(NVar) == Name) then
4417         exit
4418       elseif(DH%VarNames(NVar) == NO_NAME) then
4419         Status = WRF_WARN_MD_NF
4420         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__
4421         call wrf_debug ( WARN , msg)
4422         return
4423       elseif(NVar == MaxVars) then
4424         Status = WRF_WARN_TOO_MANY_VARIABLES
4425         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__
4426         call wrf_debug ( WARN , msg)
4427         return
4428       endif
4429     enddo
4430     if(Count > DH%VarDimLens(1,NVar)) then
4431       Status = WRF_WARN_COUNT_TOO_LONG
4432       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','LOGICAL',', line', __LINE__
4433       call wrf_debug ( WARN , msg)
4434       return
4435     elseif(Count < 1) then
4436       Status = WRF_WARN_ZERO_LENGTH_PUT
4437       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','LOGICAL',', line', __LINE__
4438       call wrf_debug ( WARN , msg)
4439       return
4440     endif
4441     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
4442     if(Status /= WRF_NO_ERR) then
4443       write(msg,*)  'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__
4444       call wrf_debug ( WARN , msg)
4445       return
4446     endif
4447     VStart(1) = 1
4448     VStart(2) = TimeIndex
4449     VCount(1) = Count
4450     VCount(2) = 1
4451     if(Data) then
4452        Buffer(1)=1
4453     else
4454        Buffer(1)=0
4455     endif
4456    !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
4457     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer)
4458     call netcdf_err(stat,Status)
4459     if(Status /= WRF_NO_ERR) then
4460       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
4461       call wrf_debug ( WARN , msg)
4462       return
4463     endif
4464   else
4465     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4466     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
4467     call wrf_debug ( FATAL , msg)
4468     return
4469   endif
4470 #endif
4471   return
4472 end subroutine ext_pio_put_var_td_logical_sca
4473
4474 subroutine ext_pio_put_var_ti_char_arr(DataHandle,Element,Var,Data,Status)
4475   use pio_kinds
4476   use pio
4477   use wrf_data_pio
4478   use pio_routines
4479   implicit none
4480   include 'wrf_status_codes.h'
4481   integer               ,intent(in)     :: DataHandle
4482   character*(*)         ,intent(in)     :: Element
4483   character*(*)         ,intent(in)     :: Var
4484   character*(*)         ,intent(in)     :: Data
4485
4486   integer               ,intent(out)    :: Status
4487   type(wrf_data_handle) ,pointer        :: DH
4488   character (VarNameLen)                :: VarName
4489   integer                               :: stat
4490   integer                               :: i
4491   integer                               :: NVar
4492   character(len=1)                      :: null
4493   character(len=4096)                   :: tmpdata
4494   integer                               :: length
4495
4496   length = len(Data)
4497   if(1 > length) then
4498      length = 0
4499      null = char(0)
4500   else if(4096 < length) then
4501      length = 4096
4502      tmpdata = Data(1:4096)
4503   else
4504      tmpdata = trim(Data)
4505   end if
4506
4507   VarName = Var
4508   call GetDH(DataHandle,DH,Status)
4509   if(Status /= WRF_NO_ERR) then
4510     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4511     call wrf_debug ( WARN , msg)
4512     return
4513   endif
4514   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4515     Status = WRF_WARN_FILE_NOT_OPENED
4516     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
4517     call wrf_debug ( WARN , msg)
4518   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4519     Status = WRF_WARN_WRITE_RONLY_FILE
4520     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
4521     call wrf_debug ( WARN , msg)
4522   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4523     Status = WRF_WARN_MD_AFTER_OPEN
4524     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','CHAR',', line', __LINE__
4525     call wrf_debug ( WARN , msg)
4526     return
4527   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4528     do i=1,MaxVars
4529       if(TRIM(DH%VarNames(i)) == TRIM(VarName)) then
4530         NVar = i
4531         exit
4532       elseif(i == MaxVars) then
4533         Status = WRF_WARN_VAR_NF
4534         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ &
4535                         ,NVar,VarName
4536         call wrf_debug ( WARN , msg)
4537         return
4538       endif
4539     enddo
4540
4541    !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4542    !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Data: ', trim(Data), ', tmpdata: ', trim(tmpdata)
4543    !write(unit=0, fmt='(3a,i6)') 'Element = ', trim(Element), ', NVar = ', NVar
4544    !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, &
4545    !     ', length = ', length
4546
4547     if(DH%Write) then
4548       DH%Write = .false.
4549       stat = pio_redef(DH%file_handle)
4550       call netcdf_err(stat,Status)
4551       if(Status /= WRF_NO_ERR) then
4552         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
4553         call wrf_debug ( WARN , msg)
4554         return
4555       endif
4556     endif
4557
4558     if(1 > length) then
4559      !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4560      !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Element: ', trim(Element), ', tmpdata: ', trim(tmpdata)
4561      !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, &
4562      !   ', length = ', length
4563       stat = pio_put_att(DH%file_handle,DH%descVar(NVar),trim(Element),null)
4564     else
4565      !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4566      !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Element: ', trim(Element), ', tmpdata: ', trim(tmpdata)
4567      !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, &
4568      !   ', length = ', length
4569       stat = pio_put_att(DH%file_handle,DH%descVar(NVar),trim(Element),tmpdata)
4570     endif
4571     call netcdf_err(stat,Status)
4572     if(Status /= WRF_NO_ERR) then
4573       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
4574         ' Element ',trim(Element),' in ',__FILE__,' ','CHAR',', line', __LINE__
4575       call wrf_debug ( WARN , msg)
4576     endif
4577   else
4578     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4579     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
4580     call wrf_debug ( FATAL , msg)
4581     return
4582   endif
4583   return
4584 end subroutine ext_pio_put_var_ti_char_arr
4585
4586 subroutine ext_pio_put_var_ti_char_sca(DataHandle,Element,Var,Data,Status)
4587   use pio_kinds
4588   use pio
4589   use wrf_data_pio
4590   use pio_routines
4591   implicit none
4592   include 'wrf_status_codes.h'
4593   integer               ,intent(in)     :: DataHandle
4594   character*(*)         ,intent(in)     :: Element
4595   character*(*)         ,intent(in)     :: Var
4596   character*(*) ,intent(in) :: Data
4597
4598   integer               ,intent(out)    :: Status
4599   type(wrf_data_handle) ,pointer        :: DH
4600   character (VarNameLen)                :: VarName
4601   integer                               :: stat
4602   integer                               :: i
4603   integer                               :: NVar
4604   character*1                           :: null
4605
4606   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4607   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4608   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4609
4610 #if 0
4611   null=char(0)
4612   VarName = Var
4613   call GetDH(DataHandle,DH,Status)
4614   if(Status /= WRF_NO_ERR) then
4615     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4616     call wrf_debug ( WARN , msg)
4617     return
4618   endif
4619   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4620     Status = WRF_WARN_FILE_NOT_OPENED
4621     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
4622     call wrf_debug ( WARN , msg)
4623   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4624     Status = WRF_WARN_WRITE_RONLY_FILE
4625     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
4626     call wrf_debug ( WARN , msg)
4627   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4628     Status = WRF_WARN_MD_AFTER_OPEN
4629     write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','CHAR',', line', __LINE__
4630     call wrf_debug ( WARN , msg)
4631     return
4632   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4633     do NVar=1,MaxVars
4634       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
4635         exit
4636       elseif(NVar == MaxVars) then
4637         Status = WRF_WARN_VAR_NF
4638         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ &
4639                         ,NVar,VarName
4640         call wrf_debug ( WARN , msg)
4641         return
4642       endif
4643     enddo
4644     if(len_trim(Data).le.0) then
4645       stat = pio_put_var(DH%file_handle,DH%descVar(NVar),null)
4646     else
4647       stat = pio_put_var(DH%file_handle,DH%descVar(NVar),trim(Data))
4648     endif
4649     call netcdf_err(stat,Status)
4650     if(Status /= WRF_NO_ERR) then
4651       write(msg,*) 'NetCDF error for Var ',TRIM(Var),&
4652         ' Element ',trim(Element),' in ',__FILE__,' ','CHAR',', line', __LINE__
4653       call wrf_debug ( WARN , msg)
4654     endif
4655   else
4656     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4657     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
4658     call wrf_debug ( FATAL , msg)
4659     return
4660   endif
4661 #endif
4662   return
4663 end subroutine ext_pio_put_var_ti_char_sca
4664
4665 subroutine ext_pio_put_var_td_char_arr(DataHandle,Element,DateStr,Var,Data,Status)
4666   use pio_kinds
4667   use pio
4668   use wrf_data_pio
4669   use pio_routines
4670   implicit none
4671   include 'wrf_status_codes.h'
4672   integer               ,intent(in)     :: DataHandle
4673   character*(*)         ,intent(in)     :: Element
4674   character*(*)         ,intent(in)     :: DateStr
4675   character*(*)         ,intent(in)     :: Var
4676   character*(*)         ,intent(in)     :: Data
4677   integer               ,intent(out)    :: Status
4678   type(wrf_data_handle) ,pointer        :: DH
4679   character (VarNameLen)                :: VarName
4680   character (40+len(Element))           :: Name
4681   integer                               :: stat
4682   integer                               :: i
4683   integer                               :: VDims (2)
4684   integer                               :: VStart(2)
4685   integer                               :: VCount(2)
4686   integer                               :: NVar
4687   integer                               :: TimeIndex
4688   character(len=4096)                   :: tmpdata(1)
4689   integer                               :: length
4690
4691   length = len(Data)
4692   if(1 > length) then
4693      length = 1
4694      tmpdata(1) = ""
4695   else if(4096 < length) then
4696      length = 4096
4697      tmpdata(1) = Data(1:4096)
4698   else
4699      tmpdata(1) = trim(Data)
4700   end if
4701
4702   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4703   write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1)
4704   write(unit=0, fmt='(4a)') 'Name: ', trim(Name), ', Element = ', trim(Element)
4705
4706   VarName = Var
4707   call DateCheck(DateStr,Status)
4708   if(Status /= WRF_NO_ERR) then
4709     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__
4710     call wrf_debug ( WARN , msg)
4711     return
4712   endif
4713   call GetDH(DataHandle,DH,Status)
4714   if(Status /= WRF_NO_ERR) then
4715     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4716     call wrf_debug ( WARN , msg)
4717     return
4718   endif
4719   call GetName(Element, VarName, Name, Status)
4720   if(Status /= WRF_NO_ERR) then
4721     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4722     call wrf_debug ( WARN , msg)
4723     return
4724   endif
4725   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4726     Status = WRF_WARN_FILE_NOT_OPENED
4727     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
4728     call wrf_debug ( WARN , msg)
4729   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4730     Status = WRF_WARN_WRITE_RONLY_FILE
4731     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
4732     call wrf_debug ( WARN , msg)
4733   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4734     if(len(Data) < 1) then
4735       Status = WRF_WARN_ZERO_LENGTH_PUT
4736       return
4737     endif
4738     do NVar=1,MaxVars
4739       if(DH%VarNames(NVar) == Name) then
4740         Status = WRF_WARN_2DRYRUNS_1VARIABLE
4741         return
4742       elseif(DH%VarNames(NVar) == NO_NAME) then
4743         DH%VarNames(NVar) = Name
4744         exit
4745       elseif(NVar == MaxVars) then
4746         Status = WRF_WARN_TOO_MANY_VARIABLES
4747         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__
4748         call wrf_debug ( WARN , msg)
4749         return
4750       endif
4751     enddo
4752     do i=1,MaxDims
4753       if(DH%DimLengths(i) == len(Data)) then
4754         exit
4755       elseif(DH%DimLengths(i) == NO_DIM) then
4756         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),len(Data),DH%DimIDs(i))
4757         call netcdf_err(stat,Status)
4758         if(Status /= WRF_NO_ERR) then
4759           write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
4760           call wrf_debug ( WARN , msg)
4761           return
4762         endif
4763         DH%DimLengths(i) = len(Data)
4764         exit
4765       elseif(i == MaxDims) then
4766         Status = WRF_WARN_TOO_MANY_DIMS
4767         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','CHAR',', line', __LINE__
4768         call wrf_debug ( WARN , msg)
4769         return
4770       endif
4771     enddo
4772     DH%VarDimLens(1,NVar) = len(Data)
4773     VDims(1) = DH%DimIDs(i)
4774     VDims(2) = DH%DimUnlimID
4775     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4776     write(unit=0, fmt='(3a,i6)') '10 Define Var <', trim(Var), '> as NVar:', NVar
4777     stat = pio_def_var(DH%file_handle,Name,PIO_CHAR,DH%descVar(NVar))
4778     call netcdf_err(stat,Status)
4779     if(Status /= WRF_NO_ERR) then
4780       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
4781       call wrf_debug ( WARN , msg)
4782       return
4783     endif
4784   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4785     do NVar=1,MaxVars
4786       if(DH%VarNames(NVar) == Name) then
4787         exit
4788       elseif(DH%VarNames(NVar) == NO_NAME) then
4789         Status = WRF_WARN_MD_NF
4790         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__
4791         call wrf_debug ( WARN , msg)
4792         return
4793       elseif(NVar == MaxVars) then
4794         Status = WRF_WARN_TOO_MANY_VARIABLES
4795         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__
4796         call wrf_debug ( WARN , msg)
4797         return
4798       endif
4799     enddo
4800     if(len(Data) > DH%VarDimLens(1,NVar)) then
4801       Status = WRF_WARN_COUNT_TOO_LONG
4802       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','CHAR',', line', __LINE__
4803       call wrf_debug ( WARN , msg)
4804       return
4805     elseif(len(Data) < 1) then
4806       Status = WRF_WARN_ZERO_LENGTH_PUT
4807       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','CHAR',', line', __LINE__
4808       call wrf_debug ( WARN , msg)
4809       return
4810     endif
4811     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
4812     if(Status /= WRF_NO_ERR) then
4813       write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__
4814       call wrf_debug ( WARN , msg)
4815       return
4816     endif
4817     VStart(1) = 1
4818     VStart(2) = TimeIndex
4819     VCount(1) = length
4820     VCount(2) = 1
4821     tmpdata = Data
4822     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,tmpdata)
4823     call netcdf_err(stat,Status)
4824     if(Status /= WRF_NO_ERR) then
4825       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
4826       call wrf_debug ( WARN , msg)
4827       return
4828     endif
4829   else
4830     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
4831     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line: ', __LINE__
4832     call wrf_debug ( FATAL , msg)
4833     return
4834   endif
4835   return
4836 end subroutine ext_pio_put_var_td_char_arr
4837
4838 subroutine ext_pio_put_var_td_char_sca(DataHandle,Element,DateStr,Var,Data,Status)
4839   use pio_kinds
4840   use pio
4841   use wrf_data_pio
4842   use pio_routines
4843   implicit none
4844   include 'wrf_status_codes.h'
4845   integer               ,intent(in)     :: DataHandle
4846   character*(*)         ,intent(in)     :: Element
4847   character*(*)         ,intent(in)     :: DateStr
4848   character*(*)         ,intent(in)     :: Var
4849   character*(*)         ,intent(in)     :: Data
4850   integer               ,intent(out)    :: Status
4851   type(wrf_data_handle) ,pointer        :: DH
4852   character (VarNameLen)                :: VarName
4853   character (40+len(Element))           :: Name
4854   integer                               :: stat
4855   integer                               :: i
4856   integer                               :: VDims (2)
4857   integer                               :: VStart(2)
4858   integer                               :: VCount(2)
4859   integer                               :: NVar
4860   integer                               :: TimeIndex
4861   character(len=DateStrLen)             :: tmpdata(1)
4862   integer                               :: length
4863
4864   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4865   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4866   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4867
4868 #if 0
4869   length = len(Data)
4870   if(1 > length) then
4871      length = 1
4872      tmpdata(1) = ""
4873   else if(4096 < length) then
4874      length = 4096
4875      tmpdata(1) = Data(1:4096)
4876   else
4877      tmpdata(1) = trim(Data)
4878   end if
4879
4880   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4881   write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1)
4882
4883   write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4884   write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1)
4885   write(unit=0, fmt='(4a)') 'Name: ', trim(Name), ', Element = ', trim(Element)
4886
4887   VarName = Var
4888   call DateCheck(DateStr,Status)
4889   if(Status /= WRF_NO_ERR) then
4890     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__
4891     call wrf_debug ( WARN , msg)
4892     return
4893   endif
4894   call GetDH(DataHandle,DH,Status)
4895   if(Status /= WRF_NO_ERR) then
4896     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4897     call wrf_debug ( WARN , msg)
4898     return
4899   endif
4900   call GetName(Element, VarName, Name, Status)
4901   if(Status /= WRF_NO_ERR) then
4902     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
4903     call wrf_debug ( WARN , msg)
4904     return
4905   endif
4906   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
4907     Status = WRF_WARN_FILE_NOT_OPENED
4908     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
4909     call wrf_debug ( WARN , msg)
4910   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
4911     Status = WRF_WARN_WRITE_RONLY_FILE
4912     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
4913     call wrf_debug ( WARN , msg)
4914   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4915     if(len(Data) < 1) then
4916       Status = WRF_WARN_ZERO_LENGTH_PUT
4917       return
4918     endif
4919     do NVar=1,MaxVars
4920       if(DH%VarNames(NVar) == Name) then
4921         Status = WRF_WARN_2DRYRUNS_1VARIABLE
4922         return
4923       elseif(DH%VarNames(NVar) == NO_NAME) then
4924         DH%VarNames(NVar) = Name
4925         exit
4926       elseif(NVar == MaxVars) then
4927         Status = WRF_WARN_TOO_MANY_VARIABLES
4928         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__
4929         call wrf_debug ( WARN , msg)
4930         return
4931       endif
4932     enddo
4933     do i=1,MaxDims
4934       if(DH%DimLengths(i) == len(Data)) then
4935         exit
4936       elseif(DH%DimLengths(i) == NO_DIM) then
4937         stat = pio_def_dim(DH%file_handle,DH%DimNames(i),len(Data),DH%DimIDs(i))
4938         call netcdf_err(stat,Status)
4939         if(Status /= WRF_NO_ERR) then
4940           write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
4941           call wrf_debug ( WARN , msg)
4942           return
4943         endif
4944         DH%DimLengths(i) = len(Data)
4945         exit
4946       elseif(i == MaxDims) then
4947         Status = WRF_WARN_TOO_MANY_DIMS
4948         write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','CHAR',', line', __LINE__
4949         call wrf_debug ( WARN , msg)
4950         return
4951       endif
4952     enddo
4953     DH%VarDimLens(1,NVar) = len(Data)
4954     VDims(1) = DH%DimIDs(i)
4955     VDims(2) = DH%DimUnlimID
4956     write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
4957     write(unit=0, fmt='(3a,i6)') '11 Define Var <', trim(Var), '> as NVar:', NVar
4958     stat = pio_def_var(DH%file_handle,Name,PIO_CHAR,DH%descVar(NVar))
4959     call netcdf_err(stat,Status)
4960     if(Status /= WRF_NO_ERR) then
4961       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
4962       call wrf_debug ( WARN , msg)
4963       return
4964     endif
4965   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
4966     do NVar=1,MaxVars
4967       if(DH%VarNames(NVar) == Name) then
4968         exit
4969       elseif(DH%VarNames(NVar) == NO_NAME) then
4970         Status = WRF_WARN_MD_NF
4971         write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__
4972         call wrf_debug ( WARN , msg)
4973         return
4974       elseif(NVar == MaxVars) then
4975         Status = WRF_WARN_TOO_MANY_VARIABLES
4976         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__
4977         call wrf_debug ( WARN , msg)
4978         return
4979       endif
4980     enddo
4981     if(len(Data) > DH%VarDimLens(1,NVar)) then
4982       Status = WRF_WARN_COUNT_TOO_LONG
4983       write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','CHAR',', line', __LINE__
4984       call wrf_debug ( WARN , msg)
4985       return
4986     elseif(len(Data) < 1) then
4987       Status = WRF_WARN_ZERO_LENGTH_PUT
4988       write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','CHAR',', line', __LINE__
4989       call wrf_debug ( WARN , msg)
4990       return
4991     endif
4992     call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
4993     if(Status /= WRF_NO_ERR) then
4994       write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__
4995       call wrf_debug ( WARN , msg)
4996       return
4997     endif
4998     VStart(1) = 1
4999     VStart(2) = TimeIndex
5000     VCount(1) = len(Data)
5001     VCount(2) = 1
5002     tmpdata = Data
5003    !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Data)
5004     stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,tmpdata)
5005     call netcdf_err(stat,Status)
5006     if(Status /= WRF_NO_ERR) then
5007       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
5008       call wrf_debug ( WARN , msg)
5009       return
5010     endif
5011   else
5012     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5013     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line: ', __LINE__
5014     call wrf_debug ( FATAL , msg)
5015     return
5016   endif
5017 #endif
5018   return
5019 end subroutine ext_pio_put_var_td_char_sca
5020
5021 subroutine ext_pio_get_var_ti_real_arr(DataHandle,Element,Var,Data,Count,OutCount,Status)
5022   use pio_kinds
5023   use pio
5024   use wrf_data_pio
5025   use pio_routines
5026   implicit none
5027   include 'wrf_status_codes.h'
5028   integer               ,intent(in)     :: DataHandle
5029   character*(*)         ,intent(in)     :: Element
5030   character*(*)         ,intent(in)     :: Var
5031   real,                  intent(out)    :: Data(:)
5032   integer,               intent(in)     :: Count
5033   integer,               intent(out)    :: OutCount
5034   integer               ,intent(out)    :: Status
5035   type(wrf_data_handle) ,pointer        :: DH
5036   integer                               :: XLen
5037   real,                     allocatable :: Buffer(:)
5038   character (VarNameLen)                :: VarName
5039   integer                               :: stat
5040   integer                               :: NVar
5041   integer                               :: XType
5042
5043   if(Count <= 0) then
5044     Status = WRF_WARN_ZERO_LENGTH_GET
5045     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line: ', __LINE__
5046     call wrf_debug ( WARN , msg)
5047     return
5048   endif
5049   VarName = Var
5050   call GetDH(DataHandle,DH,Status)
5051   if(Status /= WRF_NO_ERR) then
5052     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line: ', __LINE__
5053     call wrf_debug ( WARN , msg)
5054     return
5055   endif
5056   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5057     Status = WRF_WARN_FILE_NOT_OPENED
5058     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line: ', __LINE__
5059     call wrf_debug ( WARN , msg)
5060   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5061     Status = WRF_WARN_DRYRUN_READ
5062     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5063     call wrf_debug ( WARN , msg)
5064   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5065     Status = WRF_WARN_READ_WONLY_FILE
5066     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5067     call wrf_debug ( WARN , msg)
5068   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5069     do NVar=1,DH%NumVars
5070       if(DH%VarNames(NVar) == VarName) then
5071         exit
5072       elseif(NVar == DH%NumVars) then
5073         Status = WRF_WARN_VAR_NF
5074         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
5075         call wrf_debug ( WARN , msg)
5076         return
5077       endif
5078     enddo
5079     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
5080     call netcdf_err(stat,Status)
5081     if(Status /= WRF_NO_ERR) then
5082       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5083       call wrf_debug ( WARN , msg)
5084     endif
5085       if(XType /= PIO_REAL) then
5086         Status = WRF_WARN_TYPE_MISMATCH
5087         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5088         call wrf_debug ( WARN , msg)
5089         return
5090       endif
5091     allocate(Buffer(XLen), STAT=stat)
5092     if(stat/= 0) then
5093       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5094       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5095       call wrf_debug ( FATAL , msg)
5096       return
5097     endif
5098     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
5099     call netcdf_err(stat,Status)
5100     if(Status /= WRF_NO_ERR) then
5101       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5102       call wrf_debug ( WARN , msg)
5103     endif
5104     Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
5105     deallocate(Buffer, STAT=stat)
5106     if(stat/= 0) then
5107       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5108       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5109       call wrf_debug ( FATAL , msg)
5110       return
5111     endif
5112     if(XLen > Count) then
5113       OutCount = Count
5114       Status   = WRF_WARN_MORE_DATA_IN_FILE
5115     else
5116       OutCount = XLen
5117       Status   = WRF_NO_ERR
5118     endif
5119   else
5120     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5121     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5122     call wrf_debug ( FATAL , msg)
5123     return
5124   endif
5125   return
5126 end subroutine ext_pio_get_var_ti_real_arr
5127
5128 subroutine ext_pio_get_var_ti_real_sca(DataHandle,Element,Var,Data,Count,OutCount,Status)
5129   use pio_kinds
5130   use pio
5131   use wrf_data_pio
5132   use pio_routines
5133   implicit none
5134   include 'wrf_status_codes.h'
5135   integer               ,intent(in)     :: DataHandle
5136   character*(*)         ,intent(in)     :: Element
5137   character*(*)         ,intent(in)     :: Var
5138   real,                  intent(out)    :: Data
5139   integer,               intent(in)     :: Count
5140   integer,               intent(out)    :: OutCount
5141   integer               ,intent(out)    :: Status
5142   type(wrf_data_handle) ,pointer        :: DH
5143   integer                               :: XLen
5144   real,                     allocatable :: Buffer(:)
5145   character (VarNameLen)                :: VarName
5146   integer                               :: stat
5147   integer                               :: NVar
5148   integer                               :: XType
5149
5150   if(Count <= 0) then
5151     Status = WRF_WARN_ZERO_LENGTH_GET
5152     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line: ', __LINE__
5153     call wrf_debug ( WARN , msg)
5154     return
5155   endif
5156   VarName = Var
5157   call GetDH(DataHandle,DH,Status)
5158   if(Status /= WRF_NO_ERR) then
5159     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line: ', __LINE__
5160     call wrf_debug ( WARN , msg)
5161     return
5162   endif
5163   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5164     Status = WRF_WARN_FILE_NOT_OPENED
5165     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line: ', __LINE__
5166     call wrf_debug ( WARN , msg)
5167   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5168     Status = WRF_WARN_DRYRUN_READ
5169     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5170     call wrf_debug ( WARN , msg)
5171   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5172     Status = WRF_WARN_READ_WONLY_FILE
5173     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5174     call wrf_debug ( WARN , msg)
5175   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5176     do NVar=1,DH%NumVars
5177       if(DH%VarNames(NVar) == VarName) then
5178         exit
5179       elseif(NVar == DH%NumVars) then
5180         Status = WRF_WARN_VAR_NF
5181         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
5182         call wrf_debug ( WARN , msg)
5183         return
5184       endif
5185     enddo
5186     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
5187     call netcdf_err(stat,Status)
5188     if(Status /= WRF_NO_ERR) then
5189       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5190       call wrf_debug ( WARN , msg)
5191     endif
5192       if(XType /= PIO_REAL) then
5193         Status = WRF_WARN_TYPE_MISMATCH
5194         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5195         call wrf_debug ( WARN , msg)
5196         return
5197       endif
5198     allocate(Buffer(XLen), STAT=stat)
5199     if(stat/= 0) then
5200       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5201       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5202       call wrf_debug ( FATAL , msg)
5203       return
5204     endif
5205     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
5206     call netcdf_err(stat,Status)
5207     if(Status /= WRF_NO_ERR) then
5208       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5209       call wrf_debug ( WARN , msg)
5210     endif
5211     Data = Buffer(1)
5212     deallocate(Buffer, STAT=stat)
5213     if(stat/= 0) then
5214       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5215       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5216       call wrf_debug ( FATAL , msg)
5217       return
5218     endif
5219     if(XLen > Count) then
5220       OutCount = Count
5221       Status   = WRF_WARN_MORE_DATA_IN_FILE
5222     else
5223       OutCount = XLen
5224       Status   = WRF_NO_ERR
5225     endif
5226   else
5227     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5228     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5229     call wrf_debug ( FATAL , msg)
5230     return
5231   endif
5232   return
5233 end subroutine ext_pio_get_var_ti_real_sca
5234
5235 subroutine ext_pio_get_var_td_real_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
5236   use pio_kinds
5237   use pio
5238   use wrf_data_pio
5239   use pio_routines
5240   implicit none
5241   include 'wrf_status_codes.h'
5242   integer               ,intent(in)     :: DataHandle
5243   character*(*)         ,intent(in)     :: Element
5244   character (DateStrLen),intent(in)     :: DateStr
5245   character*(*)         ,intent(in)     :: Var
5246   real                  ,intent(out)    :: Data(:)
5247   integer               ,intent(in)     :: Count
5248   integer               ,intent(out)    :: OutCount
5249   integer               ,intent(out)    :: Status
5250   type(wrf_data_handle) ,pointer        :: DH
5251   character (VarNameLen)                :: VarName
5252   character (40+len(Element))           :: Name
5253   character (40+len(Element))           :: FName
5254   integer                               :: stat
5255   real                  ,allocatable    :: Buffer(:)
5256   integer                               :: i
5257   integer                               :: VDims (2)
5258   integer                               :: VStart(2)
5259   integer                               :: VCount(2)
5260   integer                               :: NVar
5261   integer                               :: TimeIndex
5262   integer                               :: DimIDs(2)
5263   integer                               :: VarID
5264   integer                               :: XType
5265   integer                               :: NDims
5266   integer                               :: NAtts
5267   integer                               :: Len1
5268
5269   if(Count <= 0) then
5270     Status = WRF_WARN_ZERO_LENGTH_GET
5271     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5272     call wrf_debug ( WARN , msg)
5273     return
5274   endif
5275   VarName = Var
5276   call DateCheck(DateStr,Status)
5277   if(Status /= WRF_NO_ERR) then
5278     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
5279     call wrf_debug ( WARN , msg)
5280     return
5281   endif
5282   call GetDH(DataHandle,DH,Status)
5283   if(Status /= WRF_NO_ERR) then
5284     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5285     call wrf_debug ( WARN , msg)
5286     return
5287   endif
5288   call GetName(Element, VarName, Name, Status)
5289   if(Status /= WRF_NO_ERR) then
5290     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5291     call wrf_debug ( WARN , msg)
5292     return
5293   endif
5294   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5295     Status = WRF_WARN_FILE_NOT_OPENED
5296     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5297     call wrf_debug ( WARN , msg)
5298   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5299     Status = WRF_WARN_DRYRUN_READ
5300     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5301     call wrf_debug ( WARN , msg)
5302   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5303     Status = WRF_WARN_READ_WONLY_FILE
5304     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5305     call wrf_debug ( WARN , msg)
5306   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5307     stat = pio_inq_varid(DH%file_handle,Name,VarID)
5308     call netcdf_err(stat,Status)
5309     if(Status /= WRF_NO_ERR) then
5310       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5311       call wrf_debug ( WARN , msg)
5312       return
5313     endif
5314    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5315     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5316     call netcdf_err(stat,Status)
5317     if(Status /= WRF_NO_ERR) then
5318       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5319       call wrf_debug ( WARN , msg)
5320       return
5321     endif
5322     if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5323       Status = WRF_WARN_TYPE_MISMATCH
5324       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5325       call wrf_debug ( WARN , msg)
5326       return
5327     endif
5328     if(NDims /= NMDVarDims) then
5329       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
5330       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
5331       call wrf_debug ( FATAL , msg)
5332       return
5333     endif
5334     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
5335     call netcdf_err(stat,Status)
5336     if(Status /= WRF_NO_ERR) then
5337       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
5338       call wrf_debug ( WARN , msg)
5339       return
5340     endif
5341     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
5342     if(Status /= WRF_NO_ERR) then
5343       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
5344       call wrf_debug ( WARN , msg)
5345       return
5346     endif
5347     VStart(1) = 1
5348     VStart(2) = TimeIndex
5349     VCount(1) = min(Count,Len1)
5350     VCount(2) = 1
5351     allocate(Buffer(VCount(1)), STAT=stat)
5352     if(stat/= 0) then
5353       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5354       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5355       call wrf_debug ( FATAL , msg)
5356       return
5357     endif
5358     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
5359     call netcdf_err(stat,Status)
5360     if(Status /= WRF_NO_ERR) then
5361       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
5362       call wrf_debug ( WARN , msg)
5363       return
5364     endif
5365     Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
5366     deallocate(Buffer, STAT=stat)
5367     if(stat/= 0) then
5368       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5369       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5370       call wrf_debug ( FATAL , msg)
5371       return
5372     endif
5373     if(Len1 > Count) then
5374       OutCount = Count
5375       Status = WRF_WARN_MORE_DATA_IN_FILE
5376     else
5377       OutCount = Len1
5378       Status = WRF_NO_ERR
5379     endif
5380   else
5381     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5382     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5383     call wrf_debug ( FATAL , msg)
5384   endif
5385   return
5386 end subroutine ext_pio_get_var_td_real_arr
5387
5388 subroutine ext_pio_get_var_td_real_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
5389   use pio_kinds
5390   use pio
5391   use wrf_data_pio
5392   use pio_routines
5393   implicit none
5394   include 'wrf_status_codes.h'
5395   integer               ,intent(in)     :: DataHandle
5396   character*(*)         ,intent(in)     :: Element
5397   character (DateStrLen),intent(in)     :: DateStr
5398   character*(*)         ,intent(in)     :: Var
5399   real                  ,intent(out)    :: Data
5400   integer               ,intent(in)     :: Count
5401   integer               ,intent(out)    :: OutCount
5402   integer               ,intent(out)    :: Status
5403   type(wrf_data_handle) ,pointer        :: DH
5404   character (VarNameLen)                :: VarName
5405   character (40+len(Element))           :: Name
5406   character (40+len(Element))           :: FName
5407   integer                               :: stat
5408   real                  ,allocatable    :: Buffer(:)
5409   integer                               :: i
5410   integer                               :: VDims (2)
5411   integer                               :: VStart(2)
5412   integer                               :: VCount(2)
5413   integer                               :: NVar
5414   integer                               :: TimeIndex
5415   integer                               :: DimIDs(2)
5416   integer                               :: VarID
5417   integer                               :: XType
5418   integer                               :: NDims
5419   integer                               :: NAtts
5420   integer                               :: Len1
5421
5422   if(Count <= 0) then
5423     Status = WRF_WARN_ZERO_LENGTH_GET
5424     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5425     call wrf_debug ( WARN , msg)
5426     return
5427   endif
5428   VarName = Var
5429   call DateCheck(DateStr,Status)
5430   if(Status /= WRF_NO_ERR) then
5431     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
5432     call wrf_debug ( WARN , msg)
5433     return
5434   endif
5435   call GetDH(DataHandle,DH,Status)
5436   if(Status /= WRF_NO_ERR) then
5437     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5438     call wrf_debug ( WARN , msg)
5439     return
5440   endif
5441   call GetName(Element, VarName, Name, Status)
5442   if(Status /= WRF_NO_ERR) then
5443     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5444     call wrf_debug ( WARN , msg)
5445     return
5446   endif
5447   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5448     Status = WRF_WARN_FILE_NOT_OPENED
5449     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5450     call wrf_debug ( WARN , msg)
5451   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5452     Status = WRF_WARN_DRYRUN_READ
5453     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5454     call wrf_debug ( WARN , msg)
5455   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5456     Status = WRF_WARN_READ_WONLY_FILE
5457     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5458     call wrf_debug ( WARN , msg)
5459   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5460     stat = pio_inq_varid(DH%file_handle,Name,VarID)
5461     call netcdf_err(stat,Status)
5462     if(Status /= WRF_NO_ERR) then
5463       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5464       call wrf_debug ( WARN , msg)
5465       return
5466     endif
5467    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5468     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5469     call netcdf_err(stat,Status)
5470     if(Status /= WRF_NO_ERR) then
5471       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5472       call wrf_debug ( WARN , msg)
5473       return
5474     endif
5475     if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5476       Status = WRF_WARN_TYPE_MISMATCH
5477       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5478       call wrf_debug ( WARN , msg)
5479       return
5480     endif
5481     if(NDims /= NMDVarDims) then
5482       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
5483       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
5484       call wrf_debug ( FATAL , msg)
5485       return
5486     endif
5487     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
5488     call netcdf_err(stat,Status)
5489     if(Status /= WRF_NO_ERR) then
5490       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
5491       call wrf_debug ( WARN , msg)
5492       return
5493     endif
5494     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
5495     if(Status /= WRF_NO_ERR) then
5496       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
5497       call wrf_debug ( WARN , msg)
5498       return
5499     endif
5500     VStart(1) = 1
5501     VStart(2) = TimeIndex
5502     VCount(1) = min(Count,Len1)
5503     VCount(2) = 1
5504     allocate(Buffer(VCount(1)), STAT=stat)
5505     if(stat/= 0) then
5506       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5507       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5508       call wrf_debug ( FATAL , msg)
5509       return
5510     endif
5511     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
5512     call netcdf_err(stat,Status)
5513     if(Status /= WRF_NO_ERR) then
5514       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
5515       call wrf_debug ( WARN , msg)
5516       return
5517     endif
5518     Data = Buffer(1)
5519     deallocate(Buffer, STAT=stat)
5520     if(stat/= 0) then
5521       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5522       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5523       call wrf_debug ( FATAL , msg)
5524       return
5525     endif
5526     if(Len1 > Count) then
5527       OutCount = Count
5528       Status = WRF_WARN_MORE_DATA_IN_FILE
5529     else
5530       OutCount = Len1
5531       Status = WRF_NO_ERR
5532     endif
5533   else
5534     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5535     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5536     call wrf_debug ( FATAL , msg)
5537   endif
5538   return
5539 end subroutine ext_pio_get_var_td_real_sca
5540
5541 subroutine ext_pio_get_var_ti_double_arr(DataHandle,Element,Var,Data,Count,OutCount,Status)
5542   use pio_kinds
5543   use pio
5544   use wrf_data_pio
5545   use pio_routines
5546   implicit none
5547   include 'wrf_status_codes.h'
5548   integer               ,intent(in)     :: DataHandle
5549   character*(*)         ,intent(in)     :: Element
5550   character*(*)         ,intent(in)     :: Var
5551   real*8,                intent(out)    :: Data(:)
5552   integer,               intent(in)     :: Count
5553   integer,               intent(out)    :: OutCount
5554   integer               ,intent(out)    :: Status
5555   type(wrf_data_handle) ,pointer        :: DH
5556   integer                               :: XLen
5557   real*8,                allocatable    :: Buffer(:)
5558   character (VarNameLen)                :: VarName
5559   integer                               :: stat
5560   integer                               :: NVar
5561   integer                               :: XType
5562
5563   if(Count <= 0) then
5564     Status = WRF_WARN_ZERO_LENGTH_GET
5565     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5566     call wrf_debug ( WARN , msg)
5567     return
5568   endif
5569   VarName = Var
5570   call GetDH(DataHandle,DH,Status)
5571   if(Status /= WRF_NO_ERR) then
5572     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5573     call wrf_debug ( WARN , msg)
5574     return
5575   endif
5576   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5577     Status = WRF_WARN_FILE_NOT_OPENED
5578     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5579     call wrf_debug ( WARN , msg)
5580   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5581     Status = WRF_WARN_DRYRUN_READ
5582     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5583     call wrf_debug ( WARN , msg)
5584   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5585     Status = WRF_WARN_READ_WONLY_FILE
5586     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5587     call wrf_debug ( WARN , msg)
5588   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5589     do NVar=1,DH%NumVars
5590       if(DH%VarNames(NVar) == VarName) then
5591         exit
5592       elseif(NVar == DH%NumVars) then
5593         Status = WRF_WARN_VAR_NF
5594         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
5595         call wrf_debug ( WARN , msg)
5596         return
5597       endif
5598     enddo
5599     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
5600     call netcdf_err(stat,Status)
5601     if(Status /= WRF_NO_ERR) then
5602       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5603       call wrf_debug ( WARN , msg)
5604     endif
5605       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5606         Status = WRF_WARN_TYPE_MISMATCH
5607         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5608         call wrf_debug ( WARN , msg)
5609         return
5610       endif
5611     allocate(Buffer(XLen), STAT=stat)
5612     if(stat/= 0) then
5613       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5614       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5615       call wrf_debug ( FATAL , msg)
5616       return
5617     endif
5618     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
5619     call netcdf_err(stat,Status)
5620     if(Status /= WRF_NO_ERR) then
5621       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5622       call wrf_debug ( WARN , msg)
5623     endif
5624     Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
5625     deallocate(Buffer, STAT=stat)
5626     if(stat/= 0) then
5627       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5628       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5629       call wrf_debug ( FATAL , msg)
5630       return
5631     endif
5632     if(XLen > Count) then
5633       OutCount = Count
5634       Status   = WRF_WARN_MORE_DATA_IN_FILE
5635     else
5636       OutCount = XLen
5637       Status   = WRF_NO_ERR
5638     endif
5639   else
5640     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5641     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5642     call wrf_debug ( FATAL , msg)
5643     return
5644   endif
5645   return
5646 end subroutine ext_pio_get_var_ti_double_arr
5647
5648 subroutine ext_pio_get_var_ti_double_sca(DataHandle,Element,Var,Data,Count,OutCount,Status)
5649   use pio_kinds
5650   use pio
5651   use wrf_data_pio
5652   use pio_routines
5653   implicit none
5654   include 'wrf_status_codes.h'
5655   integer               ,intent(in)     :: DataHandle
5656   character*(*)         ,intent(in)     :: Element
5657   character*(*)         ,intent(in)     :: Var
5658   real*8,                intent(out)    :: Data
5659   integer,               intent(in)     :: Count
5660   integer,               intent(out)    :: OutCount
5661   integer               ,intent(out)    :: Status
5662   type(wrf_data_handle) ,pointer        :: DH
5663   integer                               :: XLen
5664   real*8,                allocatable    :: Buffer(:)
5665   character (VarNameLen)                :: VarName
5666   integer                               :: stat
5667   integer                               :: NVar
5668   integer                               :: XType
5669
5670   if(Count <= 0) then
5671     Status = WRF_WARN_ZERO_LENGTH_GET
5672     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5673     call wrf_debug ( WARN , msg)
5674     return
5675   endif
5676   VarName = Var
5677   call GetDH(DataHandle,DH,Status)
5678   if(Status /= WRF_NO_ERR) then
5679     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5680     call wrf_debug ( WARN , msg)
5681     return
5682   endif
5683   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5684     Status = WRF_WARN_FILE_NOT_OPENED
5685     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5686     call wrf_debug ( WARN , msg)
5687   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5688     Status = WRF_WARN_DRYRUN_READ
5689     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5690     call wrf_debug ( WARN , msg)
5691   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5692     Status = WRF_WARN_READ_WONLY_FILE
5693     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5694     call wrf_debug ( WARN , msg)
5695   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5696     do NVar=1,DH%NumVars
5697       if(DH%VarNames(NVar) == VarName) then
5698         exit
5699       elseif(NVar == DH%NumVars) then
5700         Status = WRF_WARN_VAR_NF
5701         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
5702         call wrf_debug ( WARN , msg)
5703         return
5704       endif
5705     enddo
5706     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
5707     call netcdf_err(stat,Status)
5708     if(Status /= WRF_NO_ERR) then
5709       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5710       call wrf_debug ( WARN , msg)
5711     endif
5712       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5713         Status = WRF_WARN_TYPE_MISMATCH
5714         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5715         call wrf_debug ( WARN , msg)
5716         return
5717       endif
5718     allocate(Buffer(XLen), STAT=stat)
5719     if(stat/= 0) then
5720       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5721       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5722       call wrf_debug ( FATAL , msg)
5723       return
5724     endif
5725     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
5726     call netcdf_err(stat,Status)
5727     if(Status /= WRF_NO_ERR) then
5728       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5729       call wrf_debug ( WARN , msg)
5730     endif
5731     Data = Buffer(1)
5732     deallocate(Buffer, STAT=stat)
5733     if(stat/= 0) then
5734       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5735       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5736       call wrf_debug ( FATAL , msg)
5737       return
5738     endif
5739     if(XLen > Count) then
5740       OutCount = Count
5741       Status   = WRF_WARN_MORE_DATA_IN_FILE
5742     else
5743       OutCount = XLen
5744       Status   = WRF_NO_ERR
5745     endif
5746   else
5747     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5748     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5749     call wrf_debug ( FATAL , msg)
5750     return
5751   endif
5752   return
5753 end subroutine ext_pio_get_var_ti_double_sca
5754
5755 subroutine ext_pio_get_var_td_double_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
5756   use pio_kinds
5757   use pio
5758   use wrf_data_pio
5759   use pio_routines
5760   implicit none
5761   include 'wrf_status_codes.h'
5762   integer               ,intent(in)     :: DataHandle
5763   character*(*)         ,intent(in)     :: Element
5764   character (DateStrLen),intent(in)     :: DateStr
5765   character*(*)         ,intent(in)     :: Var
5766   real*8,                intent(out)    :: Data(:)
5767   integer,               intent(in)     :: Count
5768   integer,               intent(out)    :: OutCount
5769   integer               ,intent(out)    :: Status
5770   type(wrf_data_handle) ,pointer        :: DH
5771   character (VarNameLen)                :: VarName
5772   character (40+len(Element))           :: Name
5773   character (40+len(Element))           :: FName
5774   integer                               :: stat
5775   real*8,                allocatable    :: Buffer(:)
5776   integer                               :: i
5777   integer                               :: VDims (2)
5778   integer                               :: VStart(2)
5779   integer                               :: VCount(2)
5780   integer                               :: NVar
5781   integer                               :: TimeIndex
5782   integer                               :: DimIDs(2)
5783   integer                               :: VarID
5784   integer                               :: XType
5785   integer                               :: NDims
5786   integer                               :: NAtts
5787   integer                               :: Len1
5788
5789   if(Count <= 0) then
5790     Status = WRF_WARN_ZERO_LENGTH_GET
5791     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5792     call wrf_debug ( WARN , msg)
5793     return
5794   endif
5795   VarName = Var
5796   call DateCheck(DateStr,Status)
5797   if(Status /= WRF_NO_ERR) then
5798     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
5799     call wrf_debug ( WARN , msg)
5800     return
5801   endif
5802   call GetDH(DataHandle,DH,Status)
5803   if(Status /= WRF_NO_ERR) then
5804     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5805     call wrf_debug ( WARN , msg)
5806     return
5807   endif
5808   call GetName(Element, VarName, Name, Status)
5809   if(Status /= WRF_NO_ERR) then
5810     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5811     call wrf_debug ( WARN , msg)
5812     return
5813   endif
5814   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5815     Status = WRF_WARN_FILE_NOT_OPENED
5816     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5817     call wrf_debug ( WARN , msg)
5818   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5819     Status = WRF_WARN_DRYRUN_READ
5820     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5821     call wrf_debug ( WARN , msg)
5822   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5823     Status = WRF_WARN_READ_WONLY_FILE
5824     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5825     call wrf_debug ( WARN , msg)
5826   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5827     stat = pio_inq_varid(DH%file_handle,Name,VarID)
5828     call netcdf_err(stat,Status)
5829     if(Status /= WRF_NO_ERR) then
5830       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5831       call wrf_debug ( WARN , msg)
5832       return
5833     endif
5834    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5835     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5836     call netcdf_err(stat,Status)
5837     if(Status /= WRF_NO_ERR) then
5838       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5839       call wrf_debug ( WARN , msg)
5840       return
5841     endif
5842       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5843         Status = WRF_WARN_TYPE_MISMATCH
5844         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5845         call wrf_debug ( WARN , msg)
5846         return
5847       endif
5848     if(NDims /= NMDVarDims) then
5849       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
5850       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
5851       call wrf_debug ( FATAL , msg)
5852       return
5853     endif
5854     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
5855     call netcdf_err(stat,Status)
5856     if(Status /= WRF_NO_ERR) then
5857       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
5858       call wrf_debug ( WARN , msg)
5859       return
5860     endif
5861     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
5862     if(Status /= WRF_NO_ERR) then
5863       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
5864       call wrf_debug ( WARN , msg)
5865       return
5866     endif
5867     VStart(1) = 1
5868     VStart(2) = TimeIndex
5869     VCount(1) = min(Count,Len1)
5870     VCount(2) = 1
5871     allocate(Buffer(VCount(1)), STAT=stat)
5872     if(stat/= 0) then
5873       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
5874       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
5875       call wrf_debug ( FATAL , msg)
5876       return
5877     endif
5878     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
5879     call netcdf_err(stat,Status)
5880     if(Status /= WRF_NO_ERR) then
5881       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
5882       call wrf_debug ( WARN , msg)
5883       return
5884     endif
5885     Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
5886     deallocate(Buffer, STAT=stat)
5887     if(stat/= 0) then
5888       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
5889       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5890       call wrf_debug ( FATAL , msg)
5891       return
5892     endif
5893     if(Len1 > Count) then
5894       OutCount = Count
5895       Status = WRF_WARN_MORE_DATA_IN_FILE
5896     else
5897       OutCount = Len1
5898       Status = WRF_NO_ERR
5899     endif
5900   else
5901     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
5902     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
5903     call wrf_debug ( FATAL , msg)
5904   endif
5905   return
5906 end subroutine ext_pio_get_var_td_double_arr
5907
5908 subroutine ext_pio_get_var_td_double_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
5909   use pio_kinds
5910   use pio
5911   use wrf_data_pio
5912   use pio_routines
5913   implicit none
5914   include 'wrf_status_codes.h'
5915   integer               ,intent(in)     :: DataHandle
5916   character*(*)         ,intent(in)     :: Element
5917   character (DateStrLen),intent(in)     :: DateStr
5918   character*(*)         ,intent(in)     :: Var
5919   real*8,                intent(out)    :: Data
5920   integer,               intent(in)     :: Count
5921   integer,               intent(out)    :: OutCount
5922   integer               ,intent(out)    :: Status
5923   type(wrf_data_handle) ,pointer        :: DH
5924   character (VarNameLen)                :: VarName
5925   character (40+len(Element))           :: Name
5926   character (40+len(Element))           :: FName
5927   integer                               :: stat
5928   real*8,                allocatable    :: Buffer(:)
5929   integer                               :: i
5930   integer                               :: VDims (2)
5931   integer                               :: VStart(2)
5932   integer                               :: VCount(2)
5933   integer                               :: NVar
5934   integer                               :: TimeIndex
5935   integer                               :: DimIDs(2)
5936   integer                               :: VarID
5937   integer                               :: XType
5938   integer                               :: NDims
5939   integer                               :: NAtts
5940   integer                               :: Len1
5941
5942   if(Count <= 0) then
5943     Status = WRF_WARN_ZERO_LENGTH_GET
5944     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
5945     call wrf_debug ( WARN , msg)
5946     return
5947   endif
5948   VarName = Var
5949   call DateCheck(DateStr,Status)
5950   if(Status /= WRF_NO_ERR) then
5951     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
5952     call wrf_debug ( WARN , msg)
5953     return
5954   endif
5955   call GetDH(DataHandle,DH,Status)
5956   if(Status /= WRF_NO_ERR) then
5957     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5958     call wrf_debug ( WARN , msg)
5959     return
5960   endif
5961   call GetName(Element, VarName, Name, Status)
5962   if(Status /= WRF_NO_ERR) then
5963     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5964     call wrf_debug ( WARN , msg)
5965     return
5966   endif
5967   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
5968     Status = WRF_WARN_FILE_NOT_OPENED
5969     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
5970     call wrf_debug ( WARN , msg)
5971   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
5972     Status = WRF_WARN_DRYRUN_READ
5973     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
5974     call wrf_debug ( WARN , msg)
5975   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
5976     Status = WRF_WARN_READ_WONLY_FILE
5977     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
5978     call wrf_debug ( WARN , msg)
5979   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
5980     stat = pio_inq_varid(DH%file_handle,Name,VarID)
5981     call netcdf_err(stat,Status)
5982     if(Status /= WRF_NO_ERR) then
5983       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5984       call wrf_debug ( WARN , msg)
5985       return
5986     endif
5987    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5988     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
5989     call netcdf_err(stat,Status)
5990     if(Status /= WRF_NO_ERR) then
5991       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
5992       call wrf_debug ( WARN , msg)
5993       return
5994     endif
5995       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
5996         Status = WRF_WARN_TYPE_MISMATCH
5997         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
5998         call wrf_debug ( WARN , msg)
5999         return
6000       endif
6001     if(NDims /= NMDVarDims) then
6002       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
6003       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
6004       call wrf_debug ( FATAL , msg)
6005       return
6006     endif
6007     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
6008     call netcdf_err(stat,Status)
6009     if(Status /= WRF_NO_ERR) then
6010       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
6011       call wrf_debug ( WARN , msg)
6012       return
6013     endif
6014     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
6015     if(Status /= WRF_NO_ERR) then
6016       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
6017       call wrf_debug ( WARN , msg)
6018       return
6019     endif
6020     VStart(1) = 1
6021     VStart(2) = TimeIndex
6022     VCount(1) = min(Count,Len1)
6023     VCount(2) = 1
6024     allocate(Buffer(VCount(1)), STAT=stat)
6025     if(stat/= 0) then
6026       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6027       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
6028       call wrf_debug ( FATAL , msg)
6029       return
6030     endif
6031     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
6032     call netcdf_err(stat,Status)
6033     if(Status /= WRF_NO_ERR) then
6034       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
6035       call wrf_debug ( WARN , msg)
6036       return
6037     endif
6038     Data = Buffer(1)
6039     deallocate(Buffer, STAT=stat)
6040     if(stat/= 0) then
6041       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6042       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
6043       call wrf_debug ( FATAL , msg)
6044       return
6045     endif
6046     if(Len1 > Count) then
6047       OutCount = Count
6048       Status = WRF_WARN_MORE_DATA_IN_FILE
6049     else
6050       OutCount = Len1
6051       Status = WRF_NO_ERR
6052     endif
6053   else
6054     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6055     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
6056     call wrf_debug ( FATAL , msg)
6057   endif
6058   return
6059 end subroutine ext_pio_get_var_td_double_sca
6060
6061 subroutine ext_pio_get_var_ti_integer_arr(DataHandle,Element,Var,Data,Count,OutCount,Status)
6062   use pio_kinds
6063   use pio
6064   use wrf_data_pio
6065   use pio_routines
6066   implicit none
6067   include 'wrf_status_codes.h'
6068   integer               ,intent(in)     :: DataHandle
6069   character*(*)         ,intent(in)     :: Element
6070   character*(*)         ,intent(in)     :: Var
6071   integer,               intent(out)    :: Data(:)
6072   integer,               intent(in)     :: Count
6073   integer,               intent(out)    :: OutCount
6074   integer               ,intent(out)    :: Status
6075   type(wrf_data_handle) ,pointer        :: DH
6076   integer                               :: XLen
6077   integer,               allocatable    :: Buffer(:)
6078   character (VarNameLen)                :: VarName
6079   integer                               :: stat
6080   integer                               :: NVar
6081   integer                               :: XType
6082
6083   if(Count <= 0) then
6084     Status = WRF_WARN_ZERO_LENGTH_GET
6085     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
6086     call wrf_debug ( WARN , msg)
6087     return
6088   endif
6089   VarName = Var
6090   call GetDH(DataHandle,DH,Status)
6091   if(Status /= WRF_NO_ERR) then
6092     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6093     call wrf_debug ( WARN , msg)
6094     return
6095   endif
6096   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6097     Status = WRF_WARN_FILE_NOT_OPENED
6098     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
6099     call wrf_debug ( WARN , msg)
6100   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6101     Status = WRF_WARN_DRYRUN_READ
6102     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
6103     call wrf_debug ( WARN , msg)
6104   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6105     Status = WRF_WARN_READ_WONLY_FILE
6106     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
6107     call wrf_debug ( WARN , msg)
6108   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6109     do NVar=1,DH%NumVars
6110       if(DH%VarNames(NVar) == VarName) then
6111         exit
6112       elseif(NVar == DH%NumVars) then
6113         Status = WRF_WARN_VAR_NF
6114         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
6115         call wrf_debug ( WARN , msg)
6116         return
6117       endif
6118     enddo
6119     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
6120     call netcdf_err(stat,Status)
6121     if(Status /= WRF_NO_ERR) then
6122       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6123       call wrf_debug ( WARN , msg)
6124     endif
6125       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
6126         Status = WRF_WARN_TYPE_MISMATCH
6127         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
6128         call wrf_debug ( WARN , msg)
6129         return
6130       endif
6131     allocate(Buffer(XLen), STAT=stat)
6132     if(stat/= 0) then
6133       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6134       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
6135       call wrf_debug ( FATAL , msg)
6136       return
6137     endif
6138     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
6139     call netcdf_err(stat,Status)
6140     if(Status /= WRF_NO_ERR) then
6141       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6142       call wrf_debug ( WARN , msg)
6143     endif
6144     Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
6145     deallocate(Buffer, STAT=stat)
6146     if(stat/= 0) then
6147       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6148       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
6149       call wrf_debug ( FATAL , msg)
6150       return
6151     endif
6152     if(XLen > Count) then
6153       OutCount = Count
6154       Status   = WRF_WARN_MORE_DATA_IN_FILE
6155     else
6156       OutCount = XLen
6157       Status   = WRF_NO_ERR
6158     endif
6159   else
6160     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6161     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
6162     call wrf_debug ( FATAL , msg)
6163     return
6164   endif
6165   return
6166 end subroutine ext_pio_get_var_ti_integer_arr
6167
6168 subroutine ext_pio_get_var_ti_integer_sca(DataHandle,Element,Var,Data,Count,OutCount,Status)
6169   use pio_kinds
6170   use pio
6171   use wrf_data_pio
6172   use pio_routines
6173   implicit none
6174   include 'wrf_status_codes.h'
6175   integer               ,intent(in)     :: DataHandle
6176   character*(*)         ,intent(in)     :: Element
6177   character*(*)         ,intent(in)     :: Var
6178   integer,               intent(out)    :: Data
6179   integer,               intent(in)     :: Count
6180   integer,               intent(out)    :: OutCount
6181   integer               ,intent(out)    :: Status
6182   type(wrf_data_handle) ,pointer        :: DH
6183   integer                               :: XLen
6184   integer,               allocatable    :: Buffer(:)
6185   character (VarNameLen)                :: VarName
6186   integer                               :: stat
6187   integer                               :: NVar
6188   integer                               :: XType
6189
6190   if(Count <= 0) then
6191     Status = WRF_WARN_ZERO_LENGTH_GET
6192     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
6193     call wrf_debug ( WARN , msg)
6194     return
6195   endif
6196   VarName = Var
6197   call GetDH(DataHandle,DH,Status)
6198   if(Status /= WRF_NO_ERR) then
6199     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6200     call wrf_debug ( WARN , msg)
6201     return
6202   endif
6203   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6204     Status = WRF_WARN_FILE_NOT_OPENED
6205     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
6206     call wrf_debug ( WARN , msg)
6207   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6208     Status = WRF_WARN_DRYRUN_READ
6209     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
6210     call wrf_debug ( WARN , msg)
6211   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6212     Status = WRF_WARN_READ_WONLY_FILE
6213     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
6214     call wrf_debug ( WARN , msg)
6215   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6216     do NVar=1,DH%NumVars
6217       if(DH%VarNames(NVar) == VarName) then
6218         exit
6219       elseif(NVar == DH%NumVars) then
6220         Status = WRF_WARN_VAR_NF
6221         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
6222         call wrf_debug ( WARN , msg)
6223         return
6224       endif
6225     enddo
6226     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
6227     call netcdf_err(stat,Status)
6228     if(Status /= WRF_NO_ERR) then
6229       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6230       call wrf_debug ( WARN , msg)
6231     endif
6232       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
6233         Status = WRF_WARN_TYPE_MISMATCH
6234         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
6235         call wrf_debug ( WARN , msg)
6236         return
6237       endif
6238     allocate(Buffer(XLen), STAT=stat)
6239     if(stat/= 0) then
6240       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6241       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
6242       call wrf_debug ( FATAL , msg)
6243       return
6244     endif
6245     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
6246     call netcdf_err(stat,Status)
6247     if(Status /= WRF_NO_ERR) then
6248       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6249       call wrf_debug ( WARN , msg)
6250     endif
6251     Data = Buffer(1)
6252     deallocate(Buffer, STAT=stat)
6253     if(stat/= 0) then
6254       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6255       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
6256       call wrf_debug ( FATAL , msg)
6257       return
6258     endif
6259     if(XLen > Count) then
6260       OutCount = Count
6261       Status   = WRF_WARN_MORE_DATA_IN_FILE
6262     else
6263       OutCount = XLen
6264       Status   = WRF_NO_ERR
6265     endif
6266   else
6267     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6268     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
6269     call wrf_debug ( FATAL , msg)
6270     return
6271   endif
6272   return
6273 end subroutine ext_pio_get_var_ti_integer_sca
6274
6275 subroutine ext_pio_get_var_td_integer_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
6276   use pio_kinds
6277   use pio
6278   use wrf_data_pio
6279   use pio_routines
6280   implicit none
6281   include 'wrf_status_codes.h'
6282   integer               ,intent(in)     :: DataHandle
6283   character*(*)         ,intent(in)     :: Element
6284   character (DateStrLen),intent(in)     :: DateStr
6285   character*(*)         ,intent(in)     :: Var
6286   integer,               intent(out)    :: Data(:)
6287   integer,               intent(in)     :: Count
6288   integer,               intent(out)    :: OutCount
6289   integer               ,intent(out)    :: Status
6290   type(wrf_data_handle) ,pointer        :: DH
6291   character (VarNameLen)                :: VarName
6292   character (40+len(Element))           :: Name
6293   character (40+len(Element))           :: FName
6294   integer                               :: stat
6295   integer               ,allocatable    :: Buffer(:)
6296   integer                               :: i
6297   integer                               :: VDims (2)
6298   integer                               :: VStart(2)
6299   integer                               :: VCount(2)
6300   integer                               :: NVar
6301   integer                               :: TimeIndex
6302   integer                               :: DimIDs(2)
6303   integer                               :: VarID
6304   integer                               :: XType
6305   integer                               :: NDims
6306   integer                               :: NAtts
6307   integer                               :: Len1
6308
6309   if(Count <= 0) then
6310     Status = WRF_WARN_ZERO_LENGTH_GET
6311     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
6312     call wrf_debug ( WARN , msg)
6313     return
6314   endif
6315   VarName = Var
6316   call DateCheck(DateStr,Status)
6317   if(Status /= WRF_NO_ERR) then
6318     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
6319     call wrf_debug ( WARN , msg)
6320     return
6321   endif
6322   call GetDH(DataHandle,DH,Status)
6323   if(Status /= WRF_NO_ERR) then
6324     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6325     call wrf_debug ( WARN , msg)
6326     return
6327   endif
6328   call GetName(Element, VarName, Name, Status)
6329   if(Status /= WRF_NO_ERR) then
6330     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6331     call wrf_debug ( WARN , msg)
6332     return
6333   endif
6334   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6335     Status = WRF_WARN_FILE_NOT_OPENED
6336     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
6337     call wrf_debug ( WARN , msg)
6338   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6339     Status = WRF_WARN_DRYRUN_READ
6340     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
6341     call wrf_debug ( WARN , msg)
6342   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6343     Status = WRF_WARN_READ_WONLY_FILE
6344     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
6345     call wrf_debug ( WARN , msg)
6346   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6347     stat = pio_inq_varid(DH%file_handle,Name,VarID)
6348     call netcdf_err(stat,Status)
6349     if(Status /= WRF_NO_ERR) then
6350       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6351       call wrf_debug ( WARN , msg)
6352       return
6353     endif
6354    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
6355     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
6356     call netcdf_err(stat,Status)
6357     if(Status /= WRF_NO_ERR) then
6358       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6359       call wrf_debug ( WARN , msg)
6360       return
6361     endif
6362       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
6363         Status = WRF_WARN_TYPE_MISMATCH
6364         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
6365         call wrf_debug ( WARN , msg)
6366         return
6367       endif
6368     if(NDims /= NMDVarDims) then
6369       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
6370       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
6371       call wrf_debug ( FATAL , msg)
6372       return
6373     endif
6374     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
6375     call netcdf_err(stat,Status)
6376     if(Status /= WRF_NO_ERR) then
6377       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
6378       call wrf_debug ( WARN , msg)
6379       return
6380     endif
6381     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
6382     if(Status /= WRF_NO_ERR) then
6383       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
6384       call wrf_debug ( WARN , msg)
6385       return
6386     endif
6387     VStart(1) = 1
6388     VStart(2) = TimeIndex
6389     VCount(1) = min(Count,Len1)
6390     VCount(2) = 1
6391     allocate(Buffer(VCount(1)), STAT=stat)
6392     if(stat/= 0) then
6393       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6394       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
6395       call wrf_debug ( FATAL , msg)
6396       return
6397     endif
6398     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
6399     call netcdf_err(stat,Status)
6400     if(Status /= WRF_NO_ERR) then
6401       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
6402       call wrf_debug ( WARN , msg)
6403       return
6404     endif
6405     Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
6406     deallocate(Buffer, STAT=stat)
6407     if(stat/= 0) then
6408       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6409       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
6410       call wrf_debug ( FATAL , msg)
6411       return
6412     endif
6413     if(Len1 > Count) then
6414       OutCount = Count
6415       Status = WRF_WARN_MORE_DATA_IN_FILE
6416     else
6417       OutCount = Len1
6418       Status = WRF_NO_ERR
6419     endif
6420   else
6421     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6422     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
6423     call wrf_debug ( FATAL , msg)
6424   endif
6425   return
6426 end subroutine ext_pio_get_var_td_integer_arr
6427
6428 subroutine ext_pio_get_var_td_integer_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
6429   use pio_kinds
6430   use pio
6431   use wrf_data_pio
6432   use pio_routines
6433   implicit none
6434   include 'wrf_status_codes.h'
6435   integer               ,intent(in)     :: DataHandle
6436   character*(*)         ,intent(in)     :: Element
6437   character (DateStrLen),intent(in)     :: DateStr
6438   character*(*)         ,intent(in)     :: Var
6439   integer,               intent(out)    :: Data
6440   integer,               intent(in)     :: Count
6441   integer,               intent(out)    :: OutCount
6442   integer               ,intent(out)    :: Status
6443   type(wrf_data_handle) ,pointer        :: DH
6444   character (VarNameLen)                :: VarName
6445   character (40+len(Element))           :: Name
6446   character (40+len(Element))           :: FName
6447   integer                               :: stat
6448   integer               ,allocatable    :: Buffer(:)
6449   integer                               :: i
6450   integer                               :: VDims (2)
6451   integer                               :: VStart(2)
6452   integer                               :: VCount(2)
6453   integer                               :: NVar
6454   integer                               :: TimeIndex
6455   integer                               :: DimIDs(2)
6456   integer                               :: VarID
6457   integer                               :: XType
6458   integer                               :: NDims
6459   integer                               :: NAtts
6460   integer                               :: Len1
6461
6462   if(Count <= 0) then
6463     Status = WRF_WARN_ZERO_LENGTH_GET
6464     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__
6465     call wrf_debug ( WARN , msg)
6466     return
6467   endif
6468   VarName = Var
6469   call DateCheck(DateStr,Status)
6470   if(Status /= WRF_NO_ERR) then
6471     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
6472     call wrf_debug ( WARN , msg)
6473     return
6474   endif
6475   call GetDH(DataHandle,DH,Status)
6476   if(Status /= WRF_NO_ERR) then
6477     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6478     call wrf_debug ( WARN , msg)
6479     return
6480   endif
6481   call GetName(Element, VarName, Name, Status)
6482   if(Status /= WRF_NO_ERR) then
6483     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
6484     call wrf_debug ( WARN , msg)
6485     return
6486   endif
6487   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6488     Status = WRF_WARN_FILE_NOT_OPENED
6489     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
6490     call wrf_debug ( WARN , msg)
6491   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6492     Status = WRF_WARN_DRYRUN_READ
6493     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
6494     call wrf_debug ( WARN , msg)
6495   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6496     Status = WRF_WARN_READ_WONLY_FILE
6497     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__
6498     call wrf_debug ( WARN , msg)
6499   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6500     stat = pio_inq_varid(DH%file_handle,Name,VarID)
6501     call netcdf_err(stat,Status)
6502     if(Status /= WRF_NO_ERR) then
6503       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6504       call wrf_debug ( WARN , msg)
6505       return
6506     endif
6507    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
6508     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
6509     call netcdf_err(stat,Status)
6510     if(Status /= WRF_NO_ERR) then
6511       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element
6512       call wrf_debug ( WARN , msg)
6513       return
6514     endif
6515       if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then
6516         Status = WRF_WARN_TYPE_MISMATCH
6517         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
6518         call wrf_debug ( WARN , msg)
6519         return
6520       endif
6521     if(NDims /= NMDVarDims) then
6522       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
6523       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__
6524       call wrf_debug ( FATAL , msg)
6525       return
6526     endif
6527     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
6528     call netcdf_err(stat,Status)
6529     if(Status /= WRF_NO_ERR) then
6530       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1)
6531       call wrf_debug ( WARN , msg)
6532       return
6533     endif
6534     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
6535     if(Status /= WRF_NO_ERR) then
6536       write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
6537       call wrf_debug ( WARN , msg)
6538       return
6539     endif
6540     VStart(1) = 1
6541     VStart(2) = TimeIndex
6542     VCount(1) = min(Count,Len1)
6543     VCount(2) = 1
6544     allocate(Buffer(VCount(1)), STAT=stat)
6545     if(stat/= 0) then
6546       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6547       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
6548       call wrf_debug ( FATAL , msg)
6549       return
6550     endif
6551     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
6552     call netcdf_err(stat,Status)
6553     if(Status /= WRF_NO_ERR) then
6554       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
6555       call wrf_debug ( WARN , msg)
6556       return
6557     endif
6558     Data = Buffer(1)
6559     deallocate(Buffer, STAT=stat)
6560     if(stat/= 0) then
6561       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6562       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
6563       call wrf_debug ( FATAL , msg)
6564       return
6565     endif
6566     if(Len1 > Count) then
6567       OutCount = Count
6568       Status = WRF_WARN_MORE_DATA_IN_FILE
6569     else
6570       OutCount = Len1
6571       Status = WRF_NO_ERR
6572     endif
6573   else
6574     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6575     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
6576     call wrf_debug ( FATAL , msg)
6577   endif
6578   return
6579 end subroutine ext_pio_get_var_td_integer_sca
6580
6581 subroutine ext_pio_get_var_ti_logical_arr(DataHandle,Element,Var,Data,Count,OutCount,Status)
6582   use pio_kinds
6583   use pio
6584   use wrf_data_pio
6585   use pio_routines
6586   implicit none
6587   include 'wrf_status_codes.h'
6588   integer               ,intent(in)     :: DataHandle
6589   character*(*)         ,intent(in)     :: Element
6590   character*(*)         ,intent(in)     :: Var
6591   logical,               intent(out)    :: Data(:)
6592   integer,               intent(in)     :: Count
6593   integer,               intent(out)    :: OutCount
6594   integer               ,intent(out)    :: Status
6595   type(wrf_data_handle) ,pointer        :: DH
6596   integer                               :: XLen
6597   integer,               allocatable    :: Buffer(:)
6598   character (VarNameLen)                :: VarName
6599   integer                               :: stat
6600   integer                               :: NVar
6601   integer                               :: XType
6602
6603   if(Count <= 0) then
6604     Status = WRF_WARN_ZERO_LENGTH_GET
6605     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__
6606     call wrf_debug ( WARN , msg)
6607     return
6608   endif
6609   VarName = Var
6610   call GetDH(DataHandle,DH,Status)
6611   if(Status /= WRF_NO_ERR) then
6612     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
6613     call wrf_debug ( WARN , msg)
6614     return
6615   endif
6616   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6617     Status = WRF_WARN_FILE_NOT_OPENED
6618     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
6619     call wrf_debug ( WARN , msg)
6620   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6621     Status = WRF_WARN_DRYRUN_READ
6622     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
6623     call wrf_debug ( WARN , msg)
6624   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6625     Status = WRF_WARN_READ_WONLY_FILE
6626     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
6627     call wrf_debug ( WARN , msg)
6628   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6629     do NVar=1,DH%NumVars
6630       if(DH%VarNames(NVar) == VarName) then
6631         exit
6632       elseif(NVar == DH%NumVars) then
6633         Status = WRF_WARN_VAR_NF
6634         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__
6635         call wrf_debug ( WARN , msg)
6636         return
6637       endif
6638     enddo
6639     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
6640     call netcdf_err(stat,Status)
6641     if(Status /= WRF_NO_ERR) then
6642       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6643       call wrf_debug ( WARN , msg)
6644     endif
6645       if(XType /= PIO_INT) then
6646         Status = WRF_WARN_TYPE_MISMATCH
6647         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__
6648         call wrf_debug ( WARN , msg)
6649         return
6650       endif
6651     allocate(Buffer(XLen), STAT=stat)
6652     if(stat/= 0) then
6653       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6654       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6655       call wrf_debug ( FATAL , msg)
6656       return
6657     endif
6658     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
6659     call netcdf_err(stat,Status)
6660     if(Status /= WRF_NO_ERR) then
6661       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6662       call wrf_debug ( WARN , msg)
6663     endif
6664     Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1
6665     deallocate(Buffer, STAT=stat)
6666     if(stat/= 0) then
6667       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6668       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6669       call wrf_debug ( FATAL , msg)
6670       return
6671     endif
6672     if(XLen > Count) then
6673       OutCount = Count
6674       Status   = WRF_WARN_MORE_DATA_IN_FILE
6675     else
6676       OutCount = XLen
6677       Status   = WRF_NO_ERR
6678     endif
6679   else
6680     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6681     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
6682     call wrf_debug ( FATAL , msg)
6683     return
6684   endif
6685   return
6686 end subroutine ext_pio_get_var_ti_logical_arr
6687
6688 subroutine ext_pio_get_var_ti_logical_sca(DataHandle,Element,Var,Data,Count,OutCount,Status)
6689   use pio_kinds
6690   use pio
6691   use wrf_data_pio
6692   use pio_routines
6693   implicit none
6694   include 'wrf_status_codes.h'
6695   integer               ,intent(in)     :: DataHandle
6696   character*(*)         ,intent(in)     :: Element
6697   character*(*)         ,intent(in)     :: Var
6698   logical,               intent(out)    :: Data
6699   integer,               intent(in)     :: Count
6700   integer,               intent(out)    :: OutCount
6701   integer               ,intent(out)    :: Status
6702   type(wrf_data_handle) ,pointer        :: DH
6703   integer                               :: XLen
6704   integer,               allocatable    :: Buffer(:)
6705   character (VarNameLen)                :: VarName
6706   integer                               :: stat
6707   integer                               :: NVar
6708   integer                               :: XType
6709
6710   if(Count <= 0) then
6711     Status = WRF_WARN_ZERO_LENGTH_GET
6712     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__
6713     call wrf_debug ( WARN , msg)
6714     return
6715   endif
6716   VarName = Var
6717   call GetDH(DataHandle,DH,Status)
6718   if(Status /= WRF_NO_ERR) then
6719     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
6720     call wrf_debug ( WARN , msg)
6721     return
6722   endif
6723   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6724     Status = WRF_WARN_FILE_NOT_OPENED
6725     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
6726     call wrf_debug ( WARN , msg)
6727   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6728     Status = WRF_WARN_DRYRUN_READ
6729     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
6730     call wrf_debug ( WARN , msg)
6731   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6732     Status = WRF_WARN_READ_WONLY_FILE
6733     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
6734     call wrf_debug ( WARN , msg)
6735   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6736     do NVar=1,DH%NumVars
6737       if(DH%VarNames(NVar) == VarName) then
6738         exit
6739       elseif(NVar == DH%NumVars) then
6740         Status = WRF_WARN_VAR_NF
6741         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__
6742         call wrf_debug ( WARN , msg)
6743         return
6744       endif
6745     enddo
6746     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
6747     call netcdf_err(stat,Status)
6748     if(Status /= WRF_NO_ERR) then
6749       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6750       call wrf_debug ( WARN , msg)
6751     endif
6752       if(XType /= PIO_INT) then
6753         Status = WRF_WARN_TYPE_MISMATCH
6754         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__
6755         call wrf_debug ( WARN , msg)
6756         return
6757       endif
6758     allocate(Buffer(XLen), STAT=stat)
6759     if(stat/= 0) then
6760       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6761       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6762       call wrf_debug ( FATAL , msg)
6763       return
6764     endif
6765     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer )
6766     call netcdf_err(stat,Status)
6767     if(Status /= WRF_NO_ERR) then
6768       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6769       call wrf_debug ( WARN , msg)
6770     endif
6771     Data = Buffer(1)
6772     deallocate(Buffer, STAT=stat)
6773     if(stat/= 0) then
6774       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6775       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6776       call wrf_debug ( FATAL , msg)
6777       return
6778     endif
6779     if(XLen > Count) then
6780       OutCount = Count
6781       Status   = WRF_WARN_MORE_DATA_IN_FILE
6782     else
6783       OutCount = XLen
6784       Status   = WRF_NO_ERR
6785     endif
6786   else
6787     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6788     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
6789     call wrf_debug ( FATAL , msg)
6790     return
6791   endif
6792   return
6793 end subroutine ext_pio_get_var_ti_logical_sca
6794
6795 subroutine ext_pio_get_var_td_logical_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
6796   use pio_kinds
6797   use pio
6798   use wrf_data_pio
6799   use pio_routines
6800   implicit none
6801   include 'wrf_status_codes.h'
6802   integer               ,intent(in)     :: DataHandle
6803   character*(*)         ,intent(in)     :: Element
6804   character (DateStrLen),intent(in)     :: DateStr
6805   character*(*)         ,intent(in)     :: Var
6806   logical,               intent(out)    :: Data(:)
6807   integer,               intent(in)     :: Count
6808   integer,               intent(out)    :: OutCount
6809   integer               ,intent(out)    :: Status
6810   type(wrf_data_handle) ,pointer        :: DH
6811   character (VarNameLen)                :: VarName
6812   character (40+len(Element))           :: Name
6813   character (40+len(Element))           :: FName
6814   integer                               :: stat
6815   integer               ,allocatable    :: Buffer(:)
6816   integer                               :: i
6817   integer                               :: VDims (2)
6818   integer                               :: VStart(2)
6819   integer                               :: VCount(2)
6820   integer                               :: NVar
6821   integer                               :: TimeIndex
6822   integer                               :: DimIDs(2)
6823   integer                               :: VarID
6824   integer                               :: XType
6825   integer                               :: NDims
6826   integer                               :: NAtts
6827   integer                               :: Len1
6828
6829   if(Count <= 0) then
6830     Status = WRF_WARN_ZERO_LENGTH_GET
6831     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__
6832     call wrf_debug ( WARN , msg)
6833     return
6834   endif
6835   VarName = Var
6836   call DateCheck(DateStr,Status)
6837   if(Status /= WRF_NO_ERR) then
6838     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6839     call wrf_debug ( WARN , msg)
6840     return
6841   endif
6842   call GetDH(DataHandle,DH,Status)
6843   if(Status /= WRF_NO_ERR) then
6844     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
6845     call wrf_debug ( WARN , msg)
6846     return
6847   endif
6848   call GetName(Element, VarName, Name, Status)
6849   if(Status /= WRF_NO_ERR) then
6850     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
6851     call wrf_debug ( WARN , msg)
6852     return
6853   endif
6854   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
6855     Status = WRF_WARN_FILE_NOT_OPENED
6856     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
6857     call wrf_debug ( WARN , msg)
6858   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
6859     Status = WRF_WARN_DRYRUN_READ
6860     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
6861     call wrf_debug ( WARN , msg)
6862   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
6863     Status = WRF_WARN_READ_WONLY_FILE
6864     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
6865     call wrf_debug ( WARN , msg)
6866   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
6867     stat = pio_inq_varid(DH%file_handle,Name,VarID)
6868     call netcdf_err(stat,Status)
6869     if(Status /= WRF_NO_ERR) then
6870       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6871       call wrf_debug ( WARN , msg)
6872       return
6873     endif
6874     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
6875     call netcdf_err(stat,Status)
6876     if(Status /= WRF_NO_ERR) then
6877       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
6878       call wrf_debug ( WARN , msg)
6879       return
6880     endif
6881       if(XType /= PIO_INT) then
6882         Status = WRF_WARN_TYPE_MISMATCH
6883         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__
6884         call wrf_debug ( WARN , msg)
6885         return
6886       endif
6887     if(NDims /= NMDVarDims) then
6888       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
6889       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','LOGICAL',', line', __LINE__
6890       call wrf_debug ( FATAL , msg)
6891       return
6892     endif
6893     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
6894     call netcdf_err(stat,Status)
6895     if(Status /= WRF_NO_ERR) then
6896       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' DimIDs(1) ',DimIDs(1)
6897       call wrf_debug ( WARN , msg)
6898       return
6899     endif
6900     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
6901     if(Status /= WRF_NO_ERR) then
6902       write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__
6903       call wrf_debug ( WARN , msg)
6904       return
6905     endif
6906     VStart(1) = 1
6907     VStart(2) = TimeIndex
6908     VCount(1) = min(Count,Len1)
6909     VCount(2) = 1
6910     allocate(Buffer(VCount(1)), STAT=stat)
6911     if(stat/= 0) then
6912       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
6913       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6914       call wrf_debug ( FATAL , msg)
6915       return
6916     endif
6917     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
6918     call netcdf_err(stat,Status)
6919     if(Status /= WRF_NO_ERR) then
6920       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__
6921       call wrf_debug ( WARN , msg)
6922       return
6923     endif
6924     Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1
6925     deallocate(Buffer, STAT=stat)
6926     if(stat/= 0) then
6927       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
6928       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6929       call wrf_debug ( FATAL , msg)
6930       return
6931     endif
6932     if(Len1 > Count) then
6933       OutCount = Count
6934       Status = WRF_WARN_MORE_DATA_IN_FILE
6935     else
6936       OutCount = Len1
6937       Status = WRF_NO_ERR
6938     endif
6939   else
6940     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
6941     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
6942     call wrf_debug ( FATAL , msg)
6943   endif
6944   return
6945 end subroutine ext_pio_get_var_td_logical_arr
6946
6947 subroutine ext_pio_get_var_td_logical_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
6948   use pio_kinds
6949   use pio
6950   use wrf_data_pio
6951   use pio_routines
6952   implicit none
6953   include 'wrf_status_codes.h'
6954   integer               ,intent(in)     :: DataHandle
6955   character*(*)         ,intent(in)     :: Element
6956   character (DateStrLen),intent(in)     :: DateStr
6957   character*(*)         ,intent(in)     :: Var
6958   logical,               intent(out)    :: Data
6959   integer,               intent(in)     :: Count
6960   integer,               intent(out)    :: OutCount
6961   integer               ,intent(out)    :: Status
6962   type(wrf_data_handle) ,pointer        :: DH
6963   character (VarNameLen)                :: VarName
6964   character (40+len(Element))           :: Name
6965   character (40+len(Element))           :: FName
6966   integer                               :: stat
6967   integer               ,allocatable    :: Buffer(:)
6968   integer                               :: i
6969   integer                               :: VDims (2)
6970   integer                               :: VStart(2)
6971   integer                               :: VCount(2)
6972   integer                               :: NVar
6973   integer                               :: TimeIndex
6974   integer                               :: DimIDs(2)
6975   integer                               :: VarID
6976   integer                               :: XType
6977   integer                               :: NDims
6978   integer                               :: NAtts
6979   integer                               :: Len1
6980
6981   if(Count <= 0) then
6982     Status = WRF_WARN_ZERO_LENGTH_GET
6983     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__
6984     call wrf_debug ( WARN , msg)
6985     return
6986   endif
6987   VarName = Var
6988   call DateCheck(DateStr,Status)
6989   if(Status /= WRF_NO_ERR) then
6990     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
6991     call wrf_debug ( WARN , msg)
6992     return
6993   endif
6994   call GetDH(DataHandle,DH,Status)
6995   if(Status /= WRF_NO_ERR) then
6996     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
6997     call wrf_debug ( WARN , msg)
6998     return
6999   endif
7000   call GetName(Element, VarName, Name, Status)
7001   if(Status /= WRF_NO_ERR) then
7002     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__
7003     call wrf_debug ( WARN , msg)
7004     return
7005   endif
7006   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7007     Status = WRF_WARN_FILE_NOT_OPENED
7008     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__
7009     call wrf_debug ( WARN , msg)
7010   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7011     Status = WRF_WARN_DRYRUN_READ
7012     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__
7013     call wrf_debug ( WARN , msg)
7014   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
7015     Status = WRF_WARN_READ_WONLY_FILE
7016     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__
7017     call wrf_debug ( WARN , msg)
7018   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7019     stat = pio_inq_varid(DH%file_handle,Name,VarID)
7020     call netcdf_err(stat,Status)
7021     if(Status /= WRF_NO_ERR) then
7022       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
7023       call wrf_debug ( WARN , msg)
7024       return
7025     endif
7026     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
7027     call netcdf_err(stat,Status)
7028     if(Status /= WRF_NO_ERR) then
7029       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element
7030       call wrf_debug ( WARN , msg)
7031       return
7032     endif
7033       if(XType /= PIO_INT) then
7034         Status = WRF_WARN_TYPE_MISMATCH
7035         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__
7036         call wrf_debug ( WARN , msg)
7037         return
7038       endif
7039     if(NDims /= NMDVarDims) then
7040       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
7041       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','LOGICAL',', line', __LINE__
7042       call wrf_debug ( FATAL , msg)
7043       return
7044     endif
7045     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
7046     call netcdf_err(stat,Status)
7047     if(Status /= WRF_NO_ERR) then
7048       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' DimIDs(1) ',DimIDs(1)
7049       call wrf_debug ( WARN , msg)
7050       return
7051     endif
7052     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
7053     if(Status /= WRF_NO_ERR) then
7054       write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__
7055       call wrf_debug ( WARN , msg)
7056       return
7057     endif
7058     VStart(1) = 1
7059     VStart(2) = TimeIndex
7060     VCount(1) = min(Count,Len1)
7061     VCount(2) = 1
7062     allocate(Buffer(VCount(1)), STAT=stat)
7063     if(stat/= 0) then
7064       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
7065       write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
7066       call wrf_debug ( FATAL , msg)
7067       return
7068     endif
7069     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
7070     call netcdf_err(stat,Status)
7071     if(Status /= WRF_NO_ERR) then
7072       write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__
7073       call wrf_debug ( WARN , msg)
7074       return
7075     endif
7076     Data = Buffer(1)
7077     deallocate(Buffer, STAT=stat)
7078     if(stat/= 0) then
7079       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
7080       write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__
7081       call wrf_debug ( FATAL , msg)
7082       return
7083     endif
7084     if(Len1 > Count) then
7085       OutCount = Count
7086       Status = WRF_WARN_MORE_DATA_IN_FILE
7087     else
7088       OutCount = Len1
7089       Status = WRF_NO_ERR
7090     endif
7091   else
7092     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
7093     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__
7094     call wrf_debug ( FATAL , msg)
7095   endif
7096   return
7097 end subroutine ext_pio_get_var_td_logical_sca
7098
7099 subroutine ext_pio_get_var_ti_char_arr(DataHandle,Element,Var,Data,Status)
7100   use pio_kinds
7101   use pio
7102   use wrf_data_pio
7103   use pio_routines
7104   implicit none
7105   include 'wrf_status_codes.h'
7106   integer               ,intent(in)     :: DataHandle
7107   character*(*)         ,intent(in)     :: Element
7108   character*(*)         ,intent(in)     :: Var
7109   character*(*)         ,intent(out)    :: Data
7110   integer                               :: Count = 1
7111
7112   integer               ,intent(out)    :: Status
7113   type(wrf_data_handle) ,pointer        :: DH
7114   integer                               :: XLen
7115
7116   character (VarNameLen)                :: VarName
7117   integer                               :: stat
7118   integer                               :: NVar
7119   integer                               :: XType
7120
7121   if(Count <= 0) then
7122     Status = WRF_WARN_ZERO_LENGTH_GET
7123     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__
7124     call wrf_debug ( WARN , msg)
7125     return
7126   endif
7127   VarName = Var
7128   call GetDH(DataHandle,DH,Status)
7129   if(Status /= WRF_NO_ERR) then
7130     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7131     call wrf_debug ( WARN , msg)
7132     return
7133   endif
7134   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7135     Status = WRF_WARN_FILE_NOT_OPENED
7136     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
7137     call wrf_debug ( WARN , msg)
7138   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7139     Status = WRF_WARN_DRYRUN_READ
7140     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
7141     call wrf_debug ( WARN , msg)
7142   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
7143     Status = WRF_WARN_READ_WONLY_FILE
7144     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
7145     call wrf_debug ( WARN , msg)
7146   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7147     do NVar=1,DH%NumVars
7148       if(DH%VarNames(NVar) == VarName) then
7149         exit
7150       elseif(NVar == DH%NumVars) then
7151         Status = WRF_WARN_VAR_NF
7152         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__
7153         call wrf_debug ( WARN , msg)
7154         return
7155       endif
7156     enddo
7157     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
7158     call netcdf_err(stat,Status)
7159     if(Status /= WRF_NO_ERR) then
7160       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7161       call wrf_debug ( WARN , msg)
7162     endif
7163       if(XType /= PIO_CHAR) then
7164         Status = WRF_WARN_TYPE_MISMATCH
7165         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__
7166         return
7167       endif
7168     if(XLen > len(Data)) then
7169       Status = WRF_WARN_CHARSTR_GT_LENDATA
7170       write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__
7171       call wrf_debug ( WARN , msg)
7172       return
7173     endif
7174     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Data )
7175     call netcdf_err(stat,Status)
7176     if(Status /= WRF_NO_ERR) then
7177       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7178       call wrf_debug ( WARN , msg)
7179     endif
7180
7181   else
7182     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
7183     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
7184     call wrf_debug ( FATAL , msg)
7185     return
7186   endif
7187   return
7188 end subroutine ext_pio_get_var_ti_char_arr
7189
7190 subroutine ext_pio_get_var_ti_char_sca(DataHandle,Element,Var,Data,Status)
7191   use pio_kinds
7192   use pio
7193   use wrf_data_pio
7194   use pio_routines
7195   implicit none
7196   include 'wrf_status_codes.h'
7197   integer               ,intent(in)     :: DataHandle
7198   character*(*)         ,intent(in)     :: Element
7199   character*(*)         ,intent(in)     :: Var
7200   character*(*)         ,intent(out)    :: Data
7201   integer                               :: Count = 1
7202
7203   integer               ,intent(out)    :: Status
7204   type(wrf_data_handle) ,pointer        :: DH
7205   integer                               :: XLen
7206
7207   character (VarNameLen)                :: VarName
7208   integer                               :: stat
7209   integer                               :: NVar
7210   integer                               :: XType
7211
7212   if(Count <= 0) then
7213     Status = WRF_WARN_ZERO_LENGTH_GET
7214     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__
7215     call wrf_debug ( WARN , msg)
7216     return
7217   endif
7218   VarName = Var
7219   call GetDH(DataHandle,DH,Status)
7220   if(Status /= WRF_NO_ERR) then
7221     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7222     call wrf_debug ( WARN , msg)
7223     return
7224   endif
7225   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7226     Status = WRF_WARN_FILE_NOT_OPENED
7227     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
7228     call wrf_debug ( WARN , msg)
7229   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7230     Status = WRF_WARN_DRYRUN_READ
7231     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
7232     call wrf_debug ( WARN , msg)
7233   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
7234     Status = WRF_WARN_READ_WONLY_FILE
7235     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
7236     call wrf_debug ( WARN , msg)
7237   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7238     do NVar=1,DH%NumVars
7239       if(DH%VarNames(NVar) == VarName) then
7240         exit
7241       elseif(NVar == DH%NumVars) then
7242         Status = WRF_WARN_VAR_NF
7243         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__
7244         call wrf_debug ( WARN , msg)
7245         return
7246       endif
7247     enddo
7248     stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen)
7249     call netcdf_err(stat,Status)
7250     if(Status /= WRF_NO_ERR) then
7251       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7252       call wrf_debug ( WARN , msg)
7253     endif
7254       if(XType /= PIO_CHAR) then
7255         Status = WRF_WARN_TYPE_MISMATCH
7256         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__
7257         return
7258       endif
7259     if(XLen > len(Data)) then
7260       Status = WRF_WARN_CHARSTR_GT_LENDATA
7261       write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__
7262       call wrf_debug ( WARN , msg)
7263       return
7264     endif
7265     stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Data )
7266     call netcdf_err(stat,Status)
7267     if(Status /= WRF_NO_ERR) then
7268       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7269       call wrf_debug ( WARN , msg)
7270     endif
7271
7272   else
7273     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
7274     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
7275     call wrf_debug ( FATAL , msg)
7276     return
7277   endif
7278   return
7279 end subroutine ext_pio_get_var_ti_char_sca
7280
7281 subroutine ext_pio_get_var_td_char_arr(DataHandle,Element,DateStr,Var,Data,Status)
7282   use pio_kinds
7283   use pio
7284   use wrf_data_pio
7285   use pio_routines
7286   implicit none
7287   include 'wrf_status_codes.h'
7288   integer               ,intent(in)     :: DataHandle
7289   character*(*)         ,intent(in)     :: Element
7290   character (DateStrLen),intent(in)     :: DateStr
7291   character*(*)         ,intent(in)     :: Var
7292   character*(*)         ,intent(out)    :: Data
7293
7294   integer               ,intent(out)    :: Status
7295   type(wrf_data_handle) ,pointer        :: DH
7296   character (VarNameLen)                :: VarName
7297   character (40+len(Element))           :: Name
7298   character (40+len(Element))           :: FName
7299   integer                               :: stat
7300   integer                               :: i
7301   integer                               :: VDims (2)
7302   integer                               :: VStart(2)
7303   integer                               :: VCount(2)
7304   integer                               :: NVar
7305   integer                               :: TimeIndex
7306   integer                               :: DimIDs(2)
7307   integer                               :: VarID
7308   integer                               :: XType
7309   integer                               :: NDims
7310   integer                               :: NAtts
7311   integer                               :: Len1
7312   integer,               parameter      :: Count = 1
7313   character(DateStrLen)                 :: Buffer(1)
7314
7315   if(Count <= 0) then
7316     Status = WRF_WARN_ZERO_LENGTH_GET
7317     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__
7318     call wrf_debug ( WARN , msg)
7319     return
7320   endif
7321   VarName = Var
7322   call DateCheck(DateStr,Status)
7323   if(Status /= WRF_NO_ERR) then
7324     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__
7325     call wrf_debug ( WARN , msg)
7326     return
7327   endif
7328   call GetDH(DataHandle,DH,Status)
7329   if(Status /= WRF_NO_ERR) then
7330     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7331     call wrf_debug ( WARN , msg)
7332     return
7333   endif
7334   call GetName(Element, VarName, Name, Status)
7335   if(Status /= WRF_NO_ERR) then
7336     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7337     call wrf_debug ( WARN , msg)
7338     return
7339   endif
7340   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7341     Status = WRF_WARN_FILE_NOT_OPENED
7342     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
7343     call wrf_debug ( WARN , msg)
7344   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7345     Status = WRF_WARN_DRYRUN_READ
7346     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
7347     call wrf_debug ( WARN , msg)
7348   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
7349     Status = WRF_WARN_READ_WONLY_FILE
7350     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
7351     call wrf_debug ( WARN , msg)
7352   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7353     stat = pio_inq_varid(DH%file_handle,Name,VarID)
7354     call netcdf_err(stat,Status)
7355     if(Status /= WRF_NO_ERR) then
7356       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7357       call wrf_debug ( WARN , msg)
7358       return
7359     endif
7360     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
7361     call netcdf_err(stat,Status)
7362     if(Status /= WRF_NO_ERR) then
7363       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7364       call wrf_debug ( WARN , msg)
7365       return
7366     endif
7367     if(XType /= PIO_CHAR) then
7368       Status = WRF_WARN_TYPE_MISMATCH
7369       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__
7370       call wrf_debug ( WARN , msg)
7371       return
7372     endif
7373     if(NDims /= NMDVarDims) then
7374       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
7375       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','CHAR',', line', __LINE__
7376       call wrf_debug ( FATAL , msg)
7377       return
7378     endif
7379     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
7380     call netcdf_err(stat,Status)
7381     if(Status /= WRF_NO_ERR) then
7382       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' DimIDs(1) ',DimIDs(1)
7383       call wrf_debug ( WARN , msg)
7384       return
7385     endif
7386     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
7387     if(Status /= WRF_NO_ERR) then
7388       write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__
7389       call wrf_debug ( WARN , msg)
7390       return
7391     endif
7392     VStart(1) = 1
7393     VStart(2) = TimeIndex
7394     VCount(1) = Len1
7395     VCount(2) = 1
7396     if(Len1 > len(Data)) then
7397       Status = WRF_WARN_CHARSTR_GT_LENDATA
7398       write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__
7399       call wrf_debug ( WARN , msg)
7400       return
7401     endif
7402     Data = ''
7403     stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer)
7404    !stat = pio_get_var(DH%file_handle,VarID,Buffer)
7405     call netcdf_err(stat,Status)
7406     if(Status /= WRF_NO_ERR) then
7407       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__
7408       call wrf_debug ( WARN , msg)
7409       return
7410     endif
7411     Data = Buffer(1)
7412   else
7413     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
7414     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
7415   endif
7416   return
7417 end subroutine ext_pio_get_var_td_char_arr
7418
7419 subroutine ext_pio_get_var_td_char_sca(DataHandle,Element,DateStr,Var,Data,Status)
7420   use pio_kinds
7421   use pio
7422   use wrf_data_pio
7423   use pio_routines
7424   implicit none
7425   include 'wrf_status_codes.h'
7426   integer               ,intent(in)     :: DataHandle
7427   character*(*)         ,intent(in)     :: Element
7428   character (DateStrLen),intent(in)     :: DateStr
7429   character*(*)         ,intent(in)     :: Var
7430   character*(*)         ,intent(out)    :: Data
7431
7432   integer               ,intent(out)    :: Status
7433   type(wrf_data_handle) ,pointer        :: DH
7434   character (VarNameLen)                :: VarName
7435   character (40+len(Element))           :: Name
7436   character (40+len(Element))           :: FName
7437   integer                               :: stat
7438   character (80)        ,allocatable    :: Buffer(:)
7439   integer                               :: i
7440   integer                               :: VDims (2)
7441   integer                               :: VStart(2)
7442   integer                               :: VCount(2)
7443   integer                               :: NVar
7444   integer                               :: TimeIndex
7445   integer                               :: DimIDs(2)
7446   integer                               :: VarID
7447   integer                               :: XType
7448   integer                               :: NDims
7449   integer                               :: NAtts
7450   integer                               :: Len1
7451   integer,               parameter      :: Count = 1
7452
7453   if(Count <= 0) then
7454     Status = WRF_WARN_ZERO_LENGTH_GET
7455     write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__
7456     call wrf_debug ( WARN , msg)
7457     return
7458   endif
7459   VarName = Var
7460   call DateCheck(DateStr,Status)
7461   if(Status /= WRF_NO_ERR) then
7462     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__
7463     call wrf_debug ( WARN , msg)
7464     return
7465   endif
7466   call GetDH(DataHandle,DH,Status)
7467   if(Status /= WRF_NO_ERR) then
7468     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7469     call wrf_debug ( WARN , msg)
7470     return
7471   endif
7472   call GetName(Element, VarName, Name, Status)
7473   if(Status /= WRF_NO_ERR) then
7474     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__
7475     call wrf_debug ( WARN , msg)
7476     return
7477   endif
7478   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7479     Status = WRF_WARN_FILE_NOT_OPENED
7480     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__
7481     call wrf_debug ( WARN , msg)
7482   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7483     Status = WRF_WARN_DRYRUN_READ
7484     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__
7485     call wrf_debug ( WARN , msg)
7486   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
7487     Status = WRF_WARN_READ_WONLY_FILE
7488     write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__
7489     call wrf_debug ( WARN , msg)
7490   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7491     stat = pio_inq_varid(DH%file_handle,Name,VarID)
7492     call netcdf_err(stat,Status)
7493     if(Status /= WRF_NO_ERR) then
7494       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7495       call wrf_debug ( WARN , msg)
7496       return
7497     endif
7498    !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
7499     stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts)
7500     call netcdf_err(stat,Status)
7501     if(Status /= WRF_NO_ERR) then
7502       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element
7503       call wrf_debug ( WARN , msg)
7504       return
7505     endif
7506       if(XType /= PIO_CHAR) then
7507         Status = WRF_WARN_TYPE_MISMATCH
7508         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__
7509         call wrf_debug ( WARN , msg)
7510         return
7511       endif
7512     if(NDims /= NMDVarDims) then
7513       Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D
7514       write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','CHAR',', line', __LINE__
7515       call wrf_debug ( FATAL , msg)
7516       return
7517     endif
7518     stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1)
7519     call netcdf_err(stat,Status)
7520     if(Status /= WRF_NO_ERR) then
7521       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' DimIDs(1) ',DimIDs(1)
7522       call wrf_debug ( WARN , msg)
7523       return
7524     endif
7525     call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
7526     if(Status /= WRF_NO_ERR) then
7527       write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__
7528       call wrf_debug ( WARN , msg)
7529       return
7530     endif
7531     VStart(1) = 1
7532     VStart(2) = TimeIndex
7533     VCount(1) = Len1
7534     VCount(2) = 1
7535     if(Len1 > len(Data)) then
7536       Status = WRF_WARN_CHARSTR_GT_LENDATA
7537       write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__
7538       call wrf_debug ( WARN , msg)
7539       return
7540     endif
7541     Data = ''
7542    !stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Data)
7543     stat = pio_get_var(DH%file_handle,VarID,Data)
7544     call netcdf_err(stat,Status)
7545     if(Status /= WRF_NO_ERR) then
7546       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__
7547       call wrf_debug ( WARN , msg)
7548       return
7549     endif
7550   else
7551     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
7552     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__
7553   endif
7554   return
7555 end subroutine ext_pio_get_var_td_char_sca
7556
7557 subroutine ext_pio_put_dom_td_real_arr(DataHandle,Element,DateStr,Data,Count,Status)
7558   integer               ,intent(in)     :: DataHandle
7559   character*(*)         ,intent(in)     :: Element
7560   character*(*)         ,intent(in)     :: DateStr
7561   real                  ,intent(in)     :: Data(:)
7562   integer               ,intent(in)     :: Count
7563   integer               ,intent(out)    :: Status
7564
7565   call ext_pio_put_var_td_real_arr(DataHandle,Element,DateStr, &
7566        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
7567   return
7568 end subroutine ext_pio_put_dom_td_real_arr
7569
7570 subroutine ext_pio_put_dom_td_real_sca(DataHandle,Element,DateStr,Data,Count,Status)
7571   integer               ,intent(in)     :: DataHandle
7572   character*(*)         ,intent(in)     :: Element
7573   character*(*)         ,intent(in)     :: DateStr
7574   real                  ,intent(in)     :: Data
7575   integer               ,intent(in)     :: Count
7576   integer               ,intent(out)    :: Status
7577
7578   call ext_pio_put_var_td_real_sca(DataHandle,Element,DateStr, &
7579        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
7580   return
7581 end subroutine ext_pio_put_dom_td_real_sca
7582
7583 subroutine ext_pio_put_dom_td_integer_arr(DataHandle,Element,DateStr,Data,Count,Status)
7584   integer               ,intent(in)     :: DataHandle
7585   character*(*)         ,intent(in)     :: Element
7586   character*(*)         ,intent(in)     :: DateStr
7587   integer               ,intent(in)     :: Data(:)
7588   integer               ,intent(in)     :: Count
7589   integer               ,intent(out)    :: Status
7590
7591   call ext_pio_put_var_td_integer_arr(DataHandle,Element,DateStr, &
7592        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
7593   return
7594 end subroutine ext_pio_put_dom_td_integer_arr
7595
7596 subroutine ext_pio_put_dom_td_integer_sca(DataHandle,Element,DateStr,Data,Count,Status)
7597   integer               ,intent(in)     :: DataHandle
7598   character*(*)         ,intent(in)     :: Element
7599   character*(*)         ,intent(in)     :: DateStr
7600   integer               ,intent(in)     :: Data
7601   integer               ,intent(in)     :: Count
7602   integer               ,intent(out)    :: Status
7603
7604   call ext_pio_put_var_td_integer_sca(DataHandle,Element,DateStr, &
7605        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
7606   return
7607 end subroutine ext_pio_put_dom_td_integer_sca
7608
7609 subroutine ext_pio_put_dom_td_double_arr(DataHandle,Element,DateStr,Data,Count,Status)
7610   integer               ,intent(in)     :: DataHandle
7611   character*(*)         ,intent(in)     :: Element
7612   character*(*)         ,intent(in)     :: DateStr
7613   real*8                ,intent(in)     :: Data(:)
7614   integer               ,intent(in)     :: Count
7615   integer               ,intent(out)    :: Status
7616
7617   call ext_pio_put_var_td_double_arr(DataHandle,Element,DateStr, &
7618        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,Status)
7619   return
7620 end subroutine ext_pio_put_dom_td_double_arr
7621
7622 subroutine ext_pio_put_dom_td_double_sca(DataHandle,Element,DateStr,Data,Count,Status)
7623   integer               ,intent(in)     :: DataHandle
7624   character*(*)         ,intent(in)     :: Element
7625   character*(*)         ,intent(in)     :: DateStr
7626   real*8                ,intent(in)     :: Data
7627   integer               ,intent(in)     :: Count
7628   integer               ,intent(out)    :: Status
7629
7630   call ext_pio_put_var_td_double_sca(DataHandle,Element,DateStr, &
7631        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,Status)
7632   return
7633 end subroutine ext_pio_put_dom_td_double_sca
7634
7635 subroutine ext_pio_put_dom_td_logical_arr(DataHandle,Element,DateStr,Data,Count,Status)
7636   integer               ,intent(in)     :: DataHandle
7637   character*(*)         ,intent(in)     :: Element
7638   character*(*)         ,intent(in)     :: DateStr
7639   logical               ,intent(in)     :: Data(:)
7640   integer               ,intent(in)     :: Count
7641   integer               ,intent(out)    :: Status
7642
7643   call ext_pio_put_var_td_logical_arr(DataHandle,Element,DateStr, &
7644        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
7645   return
7646 end subroutine ext_pio_put_dom_td_logical_arr
7647
7648 subroutine ext_pio_put_dom_td_logical_sca(DataHandle,Element,DateStr,Data,Count,Status)
7649   integer               ,intent(in)     :: DataHandle
7650   character*(*)         ,intent(in)     :: Element
7651   character*(*)         ,intent(in)     :: DateStr
7652   logical               ,intent(in)     :: Data
7653   integer               ,intent(in)     :: Count
7654   integer               ,intent(out)    :: Status
7655
7656   call ext_pio_put_var_td_logical_sca(DataHandle,Element,DateStr, &
7657        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,Status)
7658   return
7659 end subroutine ext_pio_put_dom_td_logical_sca
7660
7661 subroutine ext_pio_put_dom_td_char_arr(DataHandle,Element,DateStr,Data,Status)
7662   integer               ,intent(in)     :: DataHandle
7663   character*(*)         ,intent(in)     :: Element
7664   character*(*)         ,intent(in)     :: DateStr
7665   character*(*)         ,intent(in)     :: Data
7666   integer               ,intent(out)    :: Status
7667
7668   call ext_pio_put_var_td_char_arr(DataHandle,Element,DateStr, &
7669        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
7670   return
7671 end subroutine ext_pio_put_dom_td_char_arr
7672
7673 subroutine ext_pio_put_dom_td_char_sca(DataHandle,Element,DateStr,Data,Status)
7674   integer               ,intent(in)     :: DataHandle
7675   character*(*)         ,intent(in)     :: Element
7676   character*(*)         ,intent(in)     :: DateStr
7677   character*(*)         ,intent(in)     :: Data
7678   integer               ,intent(out)    :: Status
7679
7680   call ext_pio_put_var_td_char_sca(DataHandle,Element,DateStr, &
7681        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
7682   return
7683 end subroutine ext_pio_put_dom_td_char_sca
7684
7685 subroutine ext_pio_get_dom_td_real_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7686   integer               ,intent(in)     :: DataHandle
7687   character*(*)         ,intent(in)     :: Element
7688   character*(*)         ,intent(in)     :: DateStr
7689   real                  ,intent(out)    :: Data(:)
7690   integer               ,intent(in)     :: Count
7691   integer               ,intent(out)    :: OutCount
7692   integer               ,intent(out)    :: Status
7693   call ext_pio_get_var_td_real_arr(DataHandle,Element,DateStr,          &
7694        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
7695   return
7696 end subroutine ext_pio_get_dom_td_real_arr
7697
7698 subroutine ext_pio_get_dom_td_real_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7699   integer               ,intent(in)     :: DataHandle
7700   character*(*)         ,intent(in)     :: Element
7701   character*(*)         ,intent(in)     :: DateStr
7702   real                  ,intent(out)    :: Data
7703   integer               ,intent(in)     :: Count
7704   integer               ,intent(out)    :: OutCount
7705   integer               ,intent(out)    :: Status
7706   call ext_pio_get_var_td_real_sca(DataHandle,Element,DateStr,          &
7707        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
7708   return
7709 end subroutine ext_pio_get_dom_td_real_sca
7710
7711 subroutine ext_pio_get_dom_td_integer_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7712   integer               ,intent(in)     :: DataHandle
7713   character*(*)         ,intent(in)     :: Element
7714   character*(*)         ,intent(in)     :: DateStr
7715   integer               ,intent(out)    :: Data(:)
7716   integer               ,intent(in)     :: Count
7717   integer               ,intent(out)    :: OutCount
7718   integer               ,intent(out)    :: Status
7719   call ext_pio_get_var_td_integer_arr(DataHandle,Element,DateStr,          &
7720        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
7721   return
7722 end subroutine ext_pio_get_dom_td_integer_arr
7723
7724 subroutine ext_pio_get_dom_td_integer_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7725   integer               ,intent(in)     :: DataHandle
7726   character*(*)         ,intent(in)     :: Element
7727   character*(*)         ,intent(in)     :: DateStr
7728   integer               ,intent(out)    :: Data
7729   integer               ,intent(in)     :: Count
7730   integer               ,intent(out)    :: OutCount
7731   integer               ,intent(out)    :: Status
7732   call ext_pio_get_var_td_integer_sca(DataHandle,Element,DateStr,          &
7733        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
7734   return
7735 end subroutine ext_pio_get_dom_td_integer_sca
7736
7737 subroutine ext_pio_get_dom_td_double_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7738   integer               ,intent(in)     :: DataHandle
7739   character*(*)         ,intent(in)     :: Element
7740   character*(*)         ,intent(in)     :: DateStr
7741   real*8                ,intent(out)    :: Data(:)
7742   integer               ,intent(in)     :: Count
7743   integer               ,intent(out)    :: OutCount
7744   integer               ,intent(out)    :: Status
7745   call ext_pio_get_var_td_double_arr(DataHandle,Element,DateStr,          &
7746        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,OutCount,Status)
7747   return
7748 end subroutine ext_pio_get_dom_td_double_arr
7749
7750 subroutine ext_pio_get_dom_td_double_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7751   integer               ,intent(in)     :: DataHandle
7752   character*(*)         ,intent(in)     :: Element
7753   character*(*)         ,intent(in)     :: DateStr
7754   real*8                ,intent(out)    :: Data
7755   integer               ,intent(in)     :: Count
7756   integer               ,intent(out)    :: OutCount
7757   integer               ,intent(out)    :: Status
7758   call ext_pio_get_var_td_double_sca(DataHandle,Element,DateStr,          &
7759        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'   ,Data,Count,OutCount,Status)
7760   return
7761 end subroutine ext_pio_get_dom_td_double_sca
7762
7763 subroutine ext_pio_get_dom_td_logical_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7764   integer               ,intent(in)     :: DataHandle
7765   character*(*)         ,intent(in)     :: Element
7766   character*(*)         ,intent(in)     :: DateStr
7767   logical               ,intent(out)    :: Data(:)
7768   integer               ,intent(in)     :: Count
7769   integer               ,intent(out)    :: OutCount
7770   integer               ,intent(out)    :: Status
7771   call ext_pio_get_var_td_logical_arr(DataHandle,Element,DateStr,          &
7772        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
7773   return
7774 end subroutine ext_pio_get_dom_td_logical_arr
7775
7776 subroutine ext_pio_get_dom_td_logical_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
7777   integer               ,intent(in)     :: DataHandle
7778   character*(*)         ,intent(in)     :: Element
7779   character*(*)         ,intent(in)     :: DateStr
7780   logical               ,intent(out)    :: Data(:)
7781   integer               ,intent(in)     :: Count
7782   integer               ,intent(out)    :: OutCount
7783   integer               ,intent(out)    :: Status
7784   call ext_pio_get_var_td_logical_sca(DataHandle,Element,DateStr,          &
7785        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_'    ,Data,Count,OutCount,Status)
7786   return
7787 end subroutine ext_pio_get_dom_td_logical_sca
7788
7789 subroutine ext_pio_get_dom_td_char_arr(DataHandle,Element,DateStr,Data,Status)
7790   integer               ,intent(in)     :: DataHandle
7791   character*(*)         ,intent(in)     :: Element
7792   character*(*)         ,intent(in)     :: DateStr
7793   character*(*)         ,intent(out)    :: Data
7794   integer               ,intent(out)    :: Status
7795   call ext_pio_get_var_td_char_arr(DataHandle,Element,DateStr,          &
7796        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
7797   return
7798 end subroutine ext_pio_get_dom_td_char_arr
7799
7800 subroutine ext_pio_get_dom_td_char_sca(DataHandle,Element,DateStr,Data,Status)
7801   integer               ,intent(in)     :: DataHandle
7802   character*(*)         ,intent(in)     :: Element
7803   character*(*)         ,intent(in)     :: DateStr
7804   character*(*)         ,intent(out)    :: Data
7805   integer               ,intent(out)    :: Status
7806   call ext_pio_get_var_td_char_sca(DataHandle,Element,DateStr,          &
7807        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
7808   return
7809 end subroutine ext_pio_get_dom_td_char_sca
7810
7811 subroutine ext_pio_write_field(DataHandle,DateStr,Var,Field,FieldType,grid, &
7812                                DomainDesc, MemoryOrdIn, Stagger, DimNames,  &
7813                                DomainStart, DomainEnd, MemoryStart, MemoryEnd, &
7814                                PatchStart, PatchEnd, Status)
7815   use wrf_data_pio
7816   use pio_routines
7817   use module_domain
7818   implicit none
7819   include 'wrf_status_codes.h'
7820   integer                       ,intent(in)    :: DataHandle
7821   character*(*)                 ,intent(in)    :: DateStr
7822   character*(*)                 ,intent(in)    :: Var
7823   integer                       ,intent(inout) :: Field(*)
7824   integer                       ,intent(in)    :: FieldType
7825   type(domain)                                 :: grid
7826   integer                       ,intent(in)    :: DomainDesc
7827   character*(*)                 ,intent(in)    :: MemoryOrdIn
7828   character*(*)                 ,intent(in)    :: Stagger
7829   character*(*) ,dimension(*)   ,intent(in)    :: DimNames
7830   integer       ,dimension(*)   ,intent(in)    :: DomainStart, DomainEnd
7831   integer       ,dimension(*)   ,intent(in)    :: MemoryStart, MemoryEnd
7832   integer       ,dimension(*)   ,intent(in)    :: PatchStart,  PatchEnd
7833   integer                       ,intent(out)   :: Status
7834   character (3)                                :: MemoryOrder
7835   type(wrf_data_handle)         ,pointer       :: DH
7836   integer                                      :: NDim
7837   character (VarNameLen)                       :: VarName
7838   character (3)                                :: MemO
7839   character (3)                                :: UCMemO
7840   integer      ,dimension(NVarDims)            :: Length_global
7841   integer      ,dimension(NVarDims)            :: Length
7842   integer      ,dimension(NVarDims)            :: VDimIDs
7843   character(80),dimension(NVarDims)            :: RODimNames
7844   integer      ,dimension(NVarDims)            :: VStart
7845   integer      ,dimension(NVarDims)            :: VCount
7846   integer                                      :: stat
7847   integer                                      :: NVar
7848   integer                                      :: i,j,n,fldsize
7849   integer                                      :: XType
7850   character (80)                               :: NullName
7851   logical                                      :: NotFound
7852   integer, dimension(1,1)                      :: tmp0dint
7853   integer, dimension(:,:,:), allocatable       :: tmp2dint
7854
7855  !Local, possibly adjusted, copies of MemoryStart and MemoryEnd
7856   MemoryOrder = trim(adjustl(MemoryOrdIn))
7857   NullName=char(0)
7858   call GetDim(MemoryOrder,NDim,Status)
7859   if(Status /= WRF_NO_ERR) then
7860     write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__
7861     call wrf_debug ( WARN , TRIM(msg))
7862     return
7863   endif
7864
7865  !call pio_setdebuglevel(1)
7866
7867   call DateCheck(DateStr,Status)
7868   if(Status /= WRF_NO_ERR) then
7869     write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__
7870     call wrf_debug ( WARN , TRIM(msg))
7871     return
7872   endif
7873   VarName = Var
7874   call GetDH(DataHandle,DH,Status)
7875   if(Status /= WRF_NO_ERR) then
7876     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
7877     call wrf_debug ( WARN , TRIM(msg))
7878     return
7879   endif
7880
7881   write(msg,*)'ext_pio_write_field: called for ',TRIM(Var)
7882   CALL wrf_debug( 100, msg )
7883
7884   VCount(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
7885   Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1
7886
7887   call ExtOrder(MemoryOrder,VCount,Status)
7888   call ExtOrder(MemoryOrder,Length_global,Status)
7889
7890   call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
7891
7892   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
7893     Status = WRF_WARN_FILE_NOT_OPENED
7894     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
7895     call wrf_debug ( WARN , TRIM(msg))
7896   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
7897     Status = WRF_WARN_WRITE_RONLY_FILE
7898     write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
7899     call wrf_debug ( WARN , TRIM(msg))
7900   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
7901
7902     do NVar=1,MaxVars
7903       if(DH%VarNames(NVar) == VarName ) then
7904         Status = WRF_WARN_2DRYRUNS_1VARIABLE
7905         write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE (',TRIM(VarName),') in ',__FILE__,', line', __LINE__
7906         call wrf_debug ( WARN , TRIM(msg))
7907         return
7908       elseif(DH%VarNames(NVar) == NO_NAME) then
7909         DH%VarNames(NVar) = VarName
7910         DH%NumVars        = NVar
7911         DH%CurrentVariable= NVar
7912         exit
7913       elseif(NVar == MaxVars) then
7914         Status = WRF_WARN_TOO_MANY_VARIABLES
7915         write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
7916         call wrf_debug ( WARN , TRIM(msg))
7917         return
7918       endif
7919     enddo
7920
7921     if(DH%Write)then
7922       DH%Write = .false.
7923       stat = pio_redef(DH%file_handle)
7924       call netcdf_err(stat,Status)
7925       if(Status /= WRF_NO_ERR) then
7926         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
7927         call wrf_debug ( WARN , TRIM(msg))
7928         return
7929       endif
7930     endif
7931
7932     do j = 1,NDim
7933       VDimIDs(j) = 0
7934       if(RODimNames(j) == NullName .or. RODimNames(j) == '') then
7935         do i=1,MaxDims
7936           if(DH%DimLengths(i) == Length_global(j)) then
7937             VDimIDs(j) = DH%DimIDs(i)
7938             exit
7939           elseif(DH%DimLengths(i) == NO_DIM) then
7940             DH%DimLengths(i) = Length_global(j)
7941             stat = pio_def_dim(DH%file_handle, DH%DimNames(i), DH%DimLengths(i), DH%DimIDs(i))
7942             call netcdf_err(stat,Status)
7943             if(Status /= WRF_NO_ERR) then
7944               write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
7945               call wrf_debug ( WARN , TRIM(msg))
7946               return
7947             endif
7948             VDimIDs(j) = DH%DimIDs(i)
7949             exit
7950           elseif(i == MaxDims) then
7951             Status = WRF_WARN_TOO_MANY_DIMS
7952             write(msg,*) 'Warning TOO MANY DIMENSIONS (',i,') in (',TRIM(VarName),') ',__FILE__,', line', __LINE__
7953             call wrf_debug ( WARN , TRIM(msg))
7954             return
7955           endif
7956         enddo
7957       else !look for input name and check if already defined
7958         NotFound = .true.
7959         do i=1,MaxDims
7960           if (DH%DimNames(i) == RODimNames(j)) then
7961             if (DH%DimLengths(i) == Length_global(j)) then
7962               VDimIDs(j) = DH%DimIDs(i)
7963               NotFound = .false.
7964               exit
7965             else
7966               Status = WRF_WARN_DIMNAME_REDEFINED
7967               write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDEFINED  by var ', &
7968                            TRIM(Var),' ',DH%DimLengths(i),Length_global(j) ,' in ', __FILE__ ,' line', __LINE__
7969               call wrf_debug ( WARN , TRIM(msg))
7970               return
7971             endif
7972           endif
7973         enddo
7974         if (NotFound) then
7975           do i=1,MaxDims
7976             if (DH%DimLengths(i) == NO_DIM) then
7977               DH%DimNames(i) = RODimNames(j)
7978               DH%DimLengths(i) = Length_global(j)
7979               stat = pio_def_dim(DH%file_handle, DH%DimNames(i), DH%DimLengths(i), DH%DimIDs(i))
7980               call netcdf_err(stat,Status)
7981               if(Status /= WRF_NO_ERR) then
7982                 write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
7983                 call wrf_debug ( WARN , TRIM(msg))
7984                 return
7985               endif
7986               VDimIDs(j) = DH%DimIDs(i)
7987               exit
7988             elseif(i == MaxDims) then
7989               Status = WRF_WARN_TOO_MANY_DIMS
7990               write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
7991               call wrf_debug ( WARN , TRIM(msg))
7992               return
7993             endif
7994           enddo
7995         endif
7996       endif
7997       DH%VarDimLens(j,DH%NumVars) = Length_global(j)
7998     enddo
7999
8000     select case (FieldType)
8001       case (WRF_REAL)
8002         XType = PIO_REAL
8003       case (WRF_DOUBLE)
8004         Xtype = PIO_DOUBLE
8005       case (WRF_INTEGER)
8006         XType = PIO_INT
8007       case (WRF_LOGICAL)
8008         XType = PIO_INT
8009       case default
8010         Status = WRF_WARN_DATA_TYPE_NOT_FOUND
8011         write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
8012         call wrf_debug ( WARN , TRIM(msg))
8013         return
8014     end select
8015
8016     VDimIDs(NDim+1) = DH%DimUnlimID
8017    !write(unit=0, fmt='(/3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
8018    !write(unit=0, fmt='(3a,i6)') '1 Define Var <', trim(Var), '> as NVar:', DH%NumVars
8019     stat = pio_def_var(DH%file_handle,VarName,XType,VDimIDs(1:NDim+1),DH%descVar(DH%NumVars))
8020     call netcdf_err(stat,Status)
8021     if(Status /= WRF_NO_ERR) then
8022       write(msg,*) 'ext_pio_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__
8023       call wrf_debug ( WARN , TRIM(msg))
8024       return
8025     endif
8026    !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__
8027    !write(unit=0, fmt='(a,i6)') 'DH%descVar(DH%NumVars)%VarID = ', DH%descVar(DH%NumVars)%VarID
8028
8029     stat = pio_put_att(DH%file_handle,DH%descVar(DH%NumVars),'FieldType',FieldType)
8030     call netcdf_err(stat,Status)
8031     if(Status /= WRF_NO_ERR) then
8032       write(msg,*) 'ext_pio_write_field: NetCDF error in ',__FILE__,', line', __LINE__
8033       call wrf_debug ( WARN , TRIM(msg))
8034       return
8035     endif
8036     call reorder(MemoryOrder,MemO)
8037     call uppercase(MemO,UCMemO)
8038     stat = pio_put_att(DH%file_handle,DH%descVar(DH%NumVars),'MemoryOrder',UCMemO)
8039     call netcdf_err(stat,Status)
8040     if(Status /= WRF_NO_ERR) then
8041       write(msg,*) 'ext_pio_write_field: NetCDF error in ',__FILE__,', line', __LINE__
8042       call wrf_debug ( WARN , TRIM(msg))
8043       return
8044     endif
8045   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
8046     if(.not. DH%Write) then
8047       DH%Write = .true.
8048       stat = pio_enddef(DH%file_handle)
8049       call netcdf_err(stat,Status)
8050       if(Status /= WRF_NO_ERR) then
8051         write(msg,*) 'NetCDF error (',stat,') in file ',__FILE__,', line', __LINE__
8052         call wrf_debug ( WARN , TRIM(msg))
8053         return
8054       endif
8055     endif
8056
8057     do NVar=1,DH%NumVars
8058       if(DH%VarNames(NVar) == VarName) then
8059         DH%CurrentVariable = NVar
8060         exit
8061       elseif(NVar == DH%NumVars) then
8062         Status = WRF_WARN_VAR_NF
8063         write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
8064         call wrf_debug ( WARN , TRIM(msg))
8065         return
8066       endif
8067     enddo
8068
8069     DH%vartype(DH%CurrentVariable) = NOT_LAND_SOIL_VAR
8070     fldsize = 1
8071
8072     do j=1,NDim
8073       if(Length_global(j) /= DH%VarDimLens(j,DH%CurrentVariable) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then
8074         Status = WRF_WARN_WRTLEN_NE_DRRUNLEN
8075         write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |',   &
8076                      VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__
8077         call wrf_debug ( WARN , TRIM(msg))
8078         write(msg,*) '   LENGTH ',Length_global(j),' DRY RUN LENGTH ',DH%VarDimLens(j,DH%CurrentVariable)
8079         call wrf_debug ( WARN , TRIM(msg))
8080         return
8081       elseif(PatchStart(j) < MemoryStart(j)) then
8082         Status = WRF_WARN_DIMENSION_ERROR
8083         write(msg,*) 'Warning DIMENSION ERROR for |',VarName,    &
8084                      '| in ',__FILE__,', line', __LINE__
8085         call wrf_debug ( WARN , TRIM(msg))
8086         return
8087       endif
8088     enddo
8089
8090     VStart = 1
8091     VStart(1:NDim) = PatchStart(1:NDim)
8092     call ExtOrder(MemoryOrder,VStart,Status)
8093
8094     do n = 1, NDim
8095       VDimIDs(n) = 0
8096       do i=1,MaxDims
8097          if(DH%DimLengths(i) == Length_global(n)) then
8098             VDimIDs(n) = DH%DimIDs(i)
8099             exit
8100           end if
8101        end do
8102
8103        Length(n) = MemoryEnd(n) - MemoryStart(n) + 1
8104        fldsize = fldsize * Length(n)
8105
8106        if("land_cat_stag" == DimNames(n)) then
8107           DH%vartype(DH%CurrentVariable) = LAND_CAT_VAR
8108        else if("soil_cat_stag" == DimNames(n)) then
8109           DH%vartype(DH%CurrentVariable) = SOIL_CAT_VAR
8110        else if("soil_layers_stag" == DimNames(n)) then
8111           DH%vartype(DH%CurrentVariable) = SOIL_LAYERS_VAR
8112        else if("num_ext_model_couple_dom_stag" == DimNames(n)) then
8113           DH%vartype(DH%CurrentVariable) = MDL_CPL_VAR
8114        else if("ensemble_stag" == DimNames(n)) then
8115           DH%vartype(DH%CurrentVariable) = ENSEMBLE_VAR
8116        endif
8117     end do
8118
8119 #ifndef INTSPECIAL
8120     call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, &
8121                   Stagger,FieldType,Field,Status)
8122 #else
8123     if(WRF_INTEGER == FieldType) then
8124       if(1 == fldsize) then
8125          tmp0dint(1,1) = Field(1)
8126          stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable),tmp0dint)
8127          call netcdf_err(stat,Status)
8128       else if(2 == Ndim) then
8129          allocate(tmp2dint(Length(1),Length(2),1), stat=Status)
8130          n = 0
8131          do j=1,Length(2)
8132          do i=1,Length(1)
8133             n=n+1
8134             tmp2dint(i,j,1) = Field(n)
8135          enddo
8136          enddo
8137          call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
8138                                DH%iodesc2d_m_int, tmp2dint, Status)
8139          deallocate(tmp2dint)
8140       else
8141         call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, &
8142                       Stagger,FieldType,Field,Status)
8143       endif
8144     else
8145        call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, &
8146                      Stagger,FieldType,Field,Status)
8147     end if
8148 #endif
8149     if(Status /= WRF_NO_ERR) then
8150       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8151       call wrf_debug ( WARN , TRIM(msg))
8152       return
8153     endif
8154   else
8155     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8156     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8157     call wrf_debug ( FATAL , TRIM(msg))
8158   endif
8159   return
8160 end subroutine ext_pio_write_field
8161
8162 subroutine ext_pio_read_field(DataHandle,DateStr,Var,Field,FieldType,grid, &
8163                               DomainDesc, MemoryOrdIn, Stagger, DimNames,  &
8164                               DomainStart,DomainEnd,MemoryStart,MemoryEnd, &
8165                               PatchStart,PatchEnd,Status)
8166   use wrf_data_pio
8167   use pio_routines
8168   use module_utility
8169   use module_domain
8170   implicit none
8171   include 'wrf_status_codes.h'
8172   integer                       ,intent(in)    :: DataHandle
8173   character*(*)                 ,intent(in)    :: DateStr
8174   character*(*)                 ,intent(in)    :: Var
8175   integer                       ,intent(out)   :: Field(*)
8176   integer                       ,intent(in)    :: FieldType
8177   type(domain)                                 :: grid
8178   integer                       ,intent(in)    :: DomainDesc
8179   character*(*)                 ,intent(in)    :: MemoryOrdIn
8180   character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
8181   character*(*) , dimension (*) ,intent(in)    :: DimNames
8182   integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
8183   integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
8184   integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
8185   integer                       ,intent(out)   :: Status
8186   character (3)                                :: MemoryOrder
8187   character(PIO_MAX_NAME)                      :: dimname
8188   type(wrf_data_handle)         ,pointer       :: DH
8189   integer                                      :: NDim
8190   character (VarNameLen)                       :: VarName
8191   integer ,dimension(NVarDims)                 :: VCount
8192   integer ,dimension(NVarDims)                 :: VStart
8193   integer ,dimension(NVarDims)                 :: VDimen
8194   integer ,dimension(NVarDims)                 :: Length
8195 #if 0
8196   integer ,dimension(NVarDims)                 :: StoredLen
8197 #endif
8198   integer ,dimension(NVarDims)                 :: VDimIDs
8199   integer ,dimension(NVarDims)                 :: MemS
8200   integer ,dimension(NVarDims)                 :: MemE
8201   integer                                      :: NVar
8202   character (VarNameLen)                       :: Name
8203   integer                                      :: XType
8204   integer                                      :: StoredDim
8205   integer                                      :: VarID
8206   integer                                      :: NDims
8207   integer                                      :: NAtts
8208   integer(KIND=PIO_OFFSET)                     :: Len
8209   integer                                      :: stat
8210   integer                                      :: i, j, n, fldsize
8211   integer                                      :: FType
8212   logical                                      :: isbdy
8213   integer, dimension(:,:,:), allocatable       :: tmp2dint
8214   character (len=2)                            :: readinStagger
8215
8216   MemoryOrder = trim(adjustl(MemoryOrdIn))
8217
8218   call GetDim(MemoryOrder,NDim,Status)
8219   if(Status /= WRF_NO_ERR) then
8220     write(msg,*) 'Warning BAD MEMORY ORDER |',TRIM(MemoryOrder),'| for |', &
8221                  TRIM(Var),'| in ext_pio_read_field ',__FILE__,', line', __LINE__
8222     call wrf_debug ( WARN , TRIM(msg))
8223     return
8224   endif
8225   call DateCheck(DateStr,Status)
8226   if(Status /= WRF_NO_ERR) then
8227     write(msg,*) 'Warning DATE STRING ERROR |',TRIM(DateStr),'| for |',TRIM(Var), &
8228                  '| in ext_pio_read_field ',__FILE__,', line', __LINE__
8229     call wrf_debug ( WARN , TRIM(msg))
8230     return
8231   endif
8232   call GetDH(DataHandle,DH,Status)
8233   if(Status /= WRF_NO_ERR) then
8234     write(msg,*) 'Warning Status = ',Status,' in ext_pio_read_field ',__FILE__,', line', __LINE__
8235     call wrf_debug ( WARN , TRIM(msg))
8236     return
8237   endif
8238
8239   VarName = Var
8240   DH%CurrentVariable = DH%CurrentVariable + 1
8241   DH%VarNames(DH%CurrentVariable) = VarName
8242
8243   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8244     Status = WRF_WARN_FILE_NOT_OPENED
8245     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8246     call wrf_debug ( WARN , TRIM(msg))
8247   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8248     RETURN
8249   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8250     Status = WRF_WARN_READ_WONLY_FILE
8251     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8252     call wrf_debug ( WARN , TRIM(msg))
8253   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
8254    !call pio_seterrorhandling(DH%file_handle, PIO_BCAST_ERROR)
8255     stat = pio_inq_varid(DH%file_handle,VarName,DH%descVar(DH%CurrentVariable))
8256    !call pio_seterrorhandling(DH%file_handle, PIO_INTERNAL_ERROR)
8257    !if(stat /= PIO_NOERR) then
8258    !   DH%descVar(DH%CurrentVariable)%varID = 0
8259    !   write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname, ',Varname, ' not found in file.'
8260    !   call wrf_debug ( WARN , TRIM(msg))
8261    !   return
8262    !endif
8263
8264     call netcdf_err(stat,Status)
8265     if(Status /= WRF_NO_ERR) then
8266       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname
8267       call wrf_debug ( WARN , TRIM(msg))
8268       return
8269     endif
8270
8271     stat = pio_inquire_variable(DH%file_handle,DH%descVar(DH%CurrentVariable), &
8272                                 Name,XType,StoredDim,VDimIDs,NAtts)
8273
8274     call netcdf_err(stat,Status)
8275     if(Status /= WRF_NO_ERR) then
8276       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8277       call wrf_debug ( WARN , TRIM(msg))
8278       return
8279     endif
8280     stat = pio_get_att(DH%file_handle,DH%descVar(DH%CurrentVariable),'FieldType',FType)
8281     call netcdf_err(stat,Status)
8282     if(Status /= WRF_NO_ERR) then
8283       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8284       call wrf_debug ( WARN , TRIM(msg))
8285       return
8286     endif
8287
8288     readinStagger = ''
8289     stat = pio_get_att(DH%file_handle,DH%descVar(DH%CurrentVariable),'stagger',readinStagger)
8290     call netcdf_err(stat,Status)
8291     if(Status /= WRF_NO_ERR) then
8292       write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__
8293       call wrf_debug ( WARN , msg)
8294       return
8295     endif
8296
8297 !---allow coercion between double and single prec real
8298     if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
8299       if ( .NOT. (Ftype     == WRF_REAL .OR. Ftype     == WRF_DOUBLE ))  then
8300         Status = WRF_WARN_TYPE_MISMATCH
8301         write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
8302         call wrf_debug ( WARN , TRIM(msg))
8303         return
8304       endif
8305     else if(FieldType /= Ftype) then
8306       Status = WRF_WARN_TYPE_MISMATCH
8307       write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
8308       call wrf_debug ( WARN , TRIM(msg))
8309       return
8310     endif
8311     select case (FieldType)
8312       case (WRF_REAL)
8313        !allow coercion between double and single prec real
8314         if(.NOT. (XType == PIO_REAL .OR. XType == PIO_DOUBLE) )  then
8315           Status = WRF_WARN_TYPE_MISMATCH
8316           write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
8317         endif
8318       case (WRF_DOUBLE)
8319        !allow coercion between double and single prec real
8320         if(.NOT. (XType == PIO_REAL .OR. XType == PIO_DOUBLE) )  then
8321           Status = WRF_WARN_TYPE_MISMATCH
8322           write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__
8323         endif
8324       case (WRF_INTEGER)
8325         if(XType /= PIO_INT)  then
8326           Status = WRF_WARN_TYPE_MISMATCH
8327           write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__
8328         endif
8329       case (WRF_LOGICAL)
8330         if(XType /= PIO_INT)  then
8331           Status = WRF_WARN_TYPE_MISMATCH
8332           write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
8333         endif
8334       case default
8335         Status = WRF_WARN_DATA_TYPE_NOT_FOUND
8336         write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
8337     end select
8338     if(Status /= WRF_NO_ERR) then
8339       call wrf_debug ( WARN , TRIM(msg))
8340       return
8341     endif
8342     ! NDim=0 for scalars.  Handle read of old NDim=1 files.  TBH:  20060502
8343     IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN
8344       stat = pio_inq_dimname(DH%file_handle,VDimIDs(1),dimname)
8345       call netcdf_err(stat,Status)
8346       if(Status /= WRF_NO_ERR) then
8347         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8348         call wrf_debug ( WARN , TRIM(msg))
8349         return
8350       endif
8351       IF ( dimname(1:10) == 'ext_scalar' ) THEN
8352         NDim = 1
8353         VCount(1) = 1
8354       ENDIF
8355     ENDIF
8356     if(StoredDim /= NDim+1) then
8357       Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM
8358       write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_pio_read_field ',TRIM(Var),TRIM(DateStr)
8359       call wrf_debug ( FATAL , msg)
8360       write(msg,*) '  StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1
8361       call wrf_debug ( FATAL , msg)
8362       return
8363     endif
8364 #if 0
8365     do n=1,NDim
8366       stat = pio_inq_dimlen(DH%file_handle,VDimIDs(n),StoredLen(n))
8367       call netcdf_err(stat,Status)
8368       if(Status /= WRF_NO_ERR) then
8369         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8370         call wrf_debug ( WARN , TRIM(msg))
8371         return
8372       endif
8373       if(VCount(n) > StoredLen(n)) then
8374         Status = WRF_WARN_READ_PAST_EOF
8375         write(msg,*) 'Warning READ PAST EOF in ext_pio_read_field of ',TRIM(Var),VCount(n),'>',StoredLen(n)
8376         call wrf_debug ( WARN , TRIM(msg))
8377         return
8378       elseif(VCount(n) <= 0) then
8379         Status = WRF_WARN_ZERO_LENGTH_READ
8380         write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
8381         call wrf_debug ( WARN , TRIM(msg))
8382         return
8383       endif
8384     enddo
8385 #endif
8386    !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__
8387    !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ', DH%CurrentVariable, ', name: ', trim(VarName)
8388
8389     VStart(1:NDim) = PatchStart(1:NDim)
8390     VCount(1:NDim) = PatchEnd(1:NDim) - PatchStart(1:NDim) + 1
8391     VDimen(1:NDim) = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
8392
8393    !do n = 1, NDim
8394    !   write(unit=0, fmt='(4x,8(a,i2,a,i6))') &
8395    !        'DomainStart(', n, ')=', DomainStart(n), ', DomainEnd(', n, ')=', DomainEnd(n), &
8396    !        ', MemoryStart(', n, ')=', MemoryStart(n), ', MemoryEnd(', n, ')=', MemoryEnd(n), &
8397    !        ', PatchStart(', n, ')=', PatchStart(n), ', PatchEnd(', n, ')=', PatchEnd(n), &
8398    !        ', VStart(', n, ')=', VStart(n), ', VCount(', n, ')=', VCount(n)
8399    !end do
8400
8401     call ExtOrder(MemoryOrder,VStart,Status)
8402     call ExtOrder(MemoryOrder,VCount,Status)
8403     call ExtOrder(MemoryOrder,VDimen,Status)
8404
8405     DH%vartype(DH%CurrentVariable) = NOT_LAND_SOIL_VAR
8406     fldsize = 1
8407     do n = 1, NDim
8408        Length(n) = MemoryEnd(n) - MemoryStart(n) + 1
8409        fldsize = fldsize * Length(n)
8410
8411       !write(unit=0, fmt='(4x,2(a,i2,a,i6))') &
8412       !     'VStart(', n, ')=', VStart(n), ', VCount(', n, ')=', VCount(n)
8413
8414        if("land_cat_stag" == DH%DimNames(VDimIDs(n))) then
8415           DH%vartype(DH%CurrentVariable) = LAND_CAT_VAR
8416        else if("soil_cat_stag" == DH%DimNames(VDimIDs(n))) then
8417           DH%vartype(DH%CurrentVariable) = SOIL_CAT_VAR
8418        else if("soil_layers_stag" == DH%DimNames(VDimIDs(n))) then
8419           DH%vartype(DH%CurrentVariable) = SOIL_LAYERS_VAR
8420        else if("num_ext_model_couple_dom_stag" == DH%DimNames(VDimIDs(n))) then
8421           DH%vartype(DH%CurrentVariable) = MDL_CPL_VAR
8422        else if("ensemble_stag" == DH%DimNames(VDimIDs(n))) then
8423           DH%vartype(DH%CurrentVariable) = ENSEMBLE_VAR
8424        endif
8425     end do
8426
8427 #ifndef INTSPECIAL
8428     isbdy = is_boundary(MemoryOrder)
8429     if(isbdy) then
8430      !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__
8431      !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ',
8432      !DH%CurrentVariable, ', name: ', trim(VarName)
8433
8434       call FieldBDY('read',DataHandle,DateStr,NDim,VDimen, &
8435                     MemoryStart,MemoryEnd,PatchStart,PatchEnd, &
8436                     FieldType,Field,Status)
8437     else
8438      !if((WRF_INTEGER == FieldType) .and. (1 == fldsize)) then
8439      !  Status = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),VCount(1:1))
8440      !  Field(1) = VCount(1)
8441      !else
8442         call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, &
8443                       readinStagger,FieldType,Field,Status)
8444      !endif
8445     endif
8446 #else
8447     if(WRF_INTEGER == FieldType) then
8448       if(1 == fldsize) then
8449          Status = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),VCount(1:1))
8450          Field(1) = VCount(1)
8451       else if(2 == Ndim) then
8452          allocate(tmp2dint(Length(1),Length(2),1), stat=Status)
8453          call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
8454                               DH%iodesc2d_m_int, tmp2dint, Status)
8455 !                             DH%ioVar(DH%CurrentVariable), tmp2dint, Status)
8456          n = 0
8457          do j=1,Length(2)
8458          do i=1,Length(1)
8459             n=n+1
8460             Field(n) = tmp2dint(i,j,1)
8461          enddo
8462          enddo
8463          deallocate(tmp2dint)
8464       else
8465         call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, &
8466                       readinStagger,FieldType,Field,Status)
8467       endif
8468     else
8469       isbdy = is_boundary(MemoryOrder)
8470       if(isbdy) then
8471        !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__
8472        !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ', DH%CurrentVariable, ', name: ', trim(VarName)
8473
8474         call FieldBDY('read',DataHandle,DateStr,NDim,VDimen, &
8475                       MemoryStart,MemoryEnd,PatchStart,PatchEnd, &
8476                       FieldType,Field,Status)
8477       else
8478         call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, &
8479                       readinStagger,FieldType,Field,Status)
8480       endif
8481     endif
8482 #endif
8483   else
8484     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8485     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8486     call wrf_debug ( FATAL , msg)
8487   endif
8488   return
8489 end subroutine ext_pio_read_field
8490
8491 subroutine ext_pio_inquire_opened( DataHandle, FileName , FileStatus, Status )
8492   use wrf_data_pio
8493   use pio_routines
8494   implicit none
8495   include 'wrf_status_codes.h'
8496   integer               ,intent(in)     :: DataHandle
8497   character*(*)         ,intent(inout)  :: FileName
8498   integer               ,intent(out)    :: FileStatus
8499   integer               ,intent(out)    :: Status
8500   type(wrf_data_handle) ,pointer        :: DH
8501
8502   call upgrade_filename(FileName)
8503  !call upgrade_filename(DH%FileName)
8504
8505   call GetDH(DataHandle,DH,Status)
8506   if(Status /= WRF_NO_ERR) then
8507     FileStatus = WRF_FILE_NOT_OPENED
8508     return
8509   endif
8510   if(trim(FileName) /= trim(DH%FileName)) then
8511     FileStatus = WRF_FILE_NOT_OPENED
8512   else
8513     FileStatus = DH%FileStatus
8514   endif
8515   Status = WRF_NO_ERR
8516   return
8517 end subroutine ext_pio_inquire_opened
8518
8519 subroutine ext_pio_inquire_filename( Datahandle, FileName,  FileStatus, Status )
8520   use wrf_data_pio
8521   use pio_routines
8522   implicit none
8523   include 'wrf_status_codes.h'
8524   integer               ,intent(in)     :: DataHandle
8525   character*(*)         ,intent(out)    :: FileName
8526   integer               ,intent(out)    :: FileStatus
8527   integer               ,intent(out)    :: Status
8528   type(wrf_data_handle) ,pointer        :: DH
8529   FileStatus = WRF_FILE_NOT_OPENED
8530   call GetDH(DataHandle,DH,Status)
8531   if(Status /= WRF_NO_ERR) then
8532     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8533     call wrf_debug ( WARN , TRIM(msg))
8534     return
8535   endif
8536   FileName = trim(DH%FileName)
8537  !call upgrade_filename(FileName)
8538   FileStatus = DH%FileStatus
8539   Status = WRF_NO_ERR
8540   return
8541 end subroutine ext_pio_inquire_filename
8542
8543 subroutine ext_pio_set_time(DataHandle, DateStr, Status)
8544   use wrf_data_pio
8545   use pio_routines
8546   implicit none
8547   include 'wrf_status_codes.h'
8548   integer               ,intent(in)     :: DataHandle
8549   character*(*)         ,intent(in)     :: DateStr
8550   integer               ,intent(out)    :: Status
8551   type(wrf_data_handle) ,pointer        :: DH
8552   integer                               :: i
8553
8554   call DateCheck(DateStr,Status)
8555   if(Status /= WRF_NO_ERR) then
8556     write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
8557     call wrf_debug ( WARN , TRIM(msg))
8558     return
8559   endif
8560   call GetDH(DataHandle,DH,Status)
8561   if(Status /= WRF_NO_ERR) then
8562     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8563     call wrf_debug ( WARN , TRIM(msg))
8564     return
8565   endif
8566   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8567     Status = WRF_WARN_FILE_NOT_OPENED
8568     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8569     call wrf_debug ( WARN , TRIM(msg))
8570   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8571     Status = WRF_WARN_FILE_NOT_COMMITTED
8572     write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
8573     call wrf_debug ( WARN , TRIM(msg))
8574   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8575     Status = WRF_WARN_READ_WONLY_FILE
8576     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8577     call wrf_debug ( WARN , TRIM(msg))
8578   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
8579     do i=1,MaxTimes
8580       if(DH%Times(i)==DateStr) then
8581         DH%CurrentTime = i
8582         exit
8583       endif
8584       if(i==MaxTimes) then
8585         Status = WRF_WARN_TIME_NF
8586         return
8587       endif
8588     enddo
8589     DH%CurrentVariable = 0
8590     Status = WRF_NO_ERR
8591   else
8592     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8593     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8594     call wrf_debug ( FATAL , msg)
8595   endif
8596   return
8597 end subroutine ext_pio_set_time
8598
8599 subroutine ext_pio_get_next_time(DataHandle, DateStr, Status)
8600   use wrf_data_pio
8601   use pio_routines
8602   implicit none
8603   include 'wrf_status_codes.h'
8604   integer               ,intent(in)     :: DataHandle
8605   character*(*)         ,intent(out)    :: DateStr
8606   integer               ,intent(out)    :: Status
8607   type(wrf_data_handle) ,pointer        :: DH
8608
8609   call GetDH(DataHandle,DH,Status)
8610   if(Status /= WRF_NO_ERR) then
8611     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8612     call wrf_debug ( WARN , TRIM(msg))
8613     return
8614   endif
8615   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8616     Status = WRF_WARN_FILE_NOT_OPENED
8617     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8618     call wrf_debug ( WARN , TRIM(msg))
8619   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8620     Status = WRF_WARN_DRYRUN_READ
8621     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
8622     call wrf_debug ( WARN , TRIM(msg))
8623   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8624     Status = WRF_WARN_READ_WONLY_FILE
8625     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8626     call wrf_debug ( WARN , TRIM(msg))
8627   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
8628     if(DH%CurrentTime >= DH%NumberTimes) then
8629       write(msg,*) 'Warning ext_pio_get_next_time: DH%CurrentTime >= DH%NumberTimes ',DH%CurrentTime,DH%NumberTimes
8630       call wrf_debug ( WARN , TRIM(msg))
8631       Status = WRF_WARN_TIME_EOF
8632       return
8633     endif
8634     DH%CurrentTime     = DH%CurrentTime +1
8635     DateStr            = DH%Times(DH%CurrentTime)
8636     DH%CurrentVariable = 0
8637     Status = WRF_NO_ERR
8638   else
8639     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8640     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8641     call wrf_debug ( FATAL , msg)
8642   endif
8643   return
8644 end subroutine ext_pio_get_next_time
8645
8646 subroutine ext_pio_get_previous_time(DataHandle, DateStr, Status)
8647   use wrf_data_pio
8648   use pio_routines
8649   implicit none
8650   include 'wrf_status_codes.h'
8651   integer               ,intent(in)     :: DataHandle
8652   character*(*)         ,intent(out)    :: DateStr
8653   integer               ,intent(out)    :: Status
8654   type(wrf_data_handle) ,pointer        :: DH
8655
8656   call GetDH(DataHandle,DH,Status)
8657   if(Status /= WRF_NO_ERR) then
8658     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8659     call wrf_debug ( WARN , TRIM(msg))
8660     return
8661   endif
8662   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8663     Status = WRF_WARN_FILE_NOT_OPENED
8664     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8665     call wrf_debug ( WARN , TRIM(msg))
8666   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8667     Status = WRF_WARN_DRYRUN_READ
8668     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
8669     call wrf_debug ( WARN , TRIM(msg))
8670   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8671     Status = WRF_WARN_READ_WONLY_FILE
8672     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8673     call wrf_debug ( WARN , TRIM(msg))
8674   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
8675     if(DH%CurrentTime.GT.0) then
8676       DH%CurrentTime     = DH%CurrentTime -1
8677     endif
8678     DateStr            = DH%Times(DH%CurrentTime)
8679     DH%CurrentVariable = 0
8680     Status = WRF_NO_ERR
8681   else
8682     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8683     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8684     call wrf_debug ( FATAL , msg)
8685   endif
8686   return
8687 end subroutine ext_pio_get_previous_time
8688
8689 subroutine ext_pio_get_next_var(DataHandle, VarName, Status)
8690   use wrf_data_pio
8691   use pio_routines
8692   implicit none
8693   include 'wrf_status_codes.h'
8694   integer               ,intent(in)     :: DataHandle
8695   character*(*)         ,intent(out)    :: VarName
8696   integer               ,intent(out)    :: Status
8697   type(wrf_data_handle) ,pointer        :: DH
8698   integer                               :: stat
8699   character (80)                        :: Name
8700
8701   call GetDH(DataHandle,DH,Status)
8702   if(Status /= WRF_NO_ERR) then
8703     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8704     call wrf_debug ( WARN , TRIM(msg))
8705     return
8706   endif
8707   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8708     Status = WRF_WARN_FILE_NOT_OPENED
8709     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8710     call wrf_debug ( WARN , TRIM(msg))
8711   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8712     Status = WRF_WARN_DRYRUN_READ
8713     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
8714     call wrf_debug ( WARN , TRIM(msg))
8715   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8716     Status = WRF_WARN_READ_WONLY_FILE
8717     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8718     call wrf_debug ( WARN , TRIM(msg))
8719   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
8720
8721     DH%CurrentVariable = DH%CurrentVariable +1
8722     if(DH%CurrentVariable > DH%NumVars) then
8723       Status = WRF_WARN_VAR_EOF
8724       return
8725     endif
8726     VarName = DH%VarNames(DH%CurrentVariable)
8727     Status  = WRF_NO_ERR
8728   else
8729     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8730     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8731     call wrf_debug ( FATAL , msg)
8732   endif
8733   return
8734 end subroutine ext_pio_get_next_var
8735
8736 subroutine ext_pio_end_of_frame(DataHandle, Status)
8737   use pio_kinds
8738   use wrf_data_pio
8739   use pio_routines
8740   implicit none
8741   include 'wrf_status_codes.h'
8742   integer               ,intent(in)     :: DataHandle
8743   integer               ,intent(out)    :: Status
8744   type(wrf_data_handle) ,pointer        :: DH
8745
8746   call GetDH(DataHandle,DH,Status)
8747   return
8748 end subroutine ext_pio_end_of_frame
8749
8750 ! NOTE:  For scalar variables NDim is set to zero and DomainStart and
8751 ! NOTE:  DomainEnd are left unmodified.
8752 subroutine ext_pio_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
8753   use wrf_data_pio
8754   use pio_routines
8755   implicit none
8756   include 'wrf_status_codes.h'
8757   integer               ,intent(in)     :: DataHandle
8758   character*(*)         ,intent(in)     :: Name
8759   integer               ,intent(out)    :: NDim
8760   character*(*)         ,intent(out)    :: MemoryOrder
8761   character*(*)                         :: Stagger ! Dummy for now
8762   integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
8763   integer               ,intent(out)    :: WrfType
8764   integer               ,intent(out)    :: Status
8765   type(wrf_data_handle) ,pointer        :: DH
8766   integer                               :: VarID
8767   integer ,dimension(NVarDims)          :: VDimIDs
8768   integer                               :: j
8769   integer                               :: stat
8770   integer                               :: XType
8771
8772   call GetDH(DataHandle,DH,Status)
8773   if(Status /= WRF_NO_ERR) then
8774     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
8775     call wrf_debug ( WARN , TRIM(msg))
8776     return
8777   endif
8778   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
8779     Status = WRF_WARN_FILE_NOT_OPENED
8780     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
8781     call wrf_debug ( WARN , TRIM(msg))
8782     return
8783   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
8784     Status = WRF_WARN_DRYRUN_READ
8785     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
8786     call wrf_debug ( WARN , TRIM(msg))
8787     return
8788   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
8789     Status = WRF_WARN_READ_WONLY_FILE
8790     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
8791     call wrf_debug ( WARN , TRIM(msg))
8792     return
8793   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
8794     stat = pio_inq_varid(DH%file_handle,Name,VarID)
8795     call netcdf_err(stat,Status)
8796     if(Status /= WRF_NO_ERR) then
8797       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8798       call wrf_debug ( WARN , TRIM(msg))
8799       return
8800     endif
8801     stat = pio_inq_vartype(DH%file_handle,VarID,XType)
8802     call netcdf_err(stat,Status)
8803     if(Status /= WRF_NO_ERR) then
8804       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8805       call wrf_debug ( WARN , TRIM(msg))
8806       return
8807     endif
8808     stat = pio_get_att(DH%file_handle,VarID,'FieldType',WrfType)
8809     call netcdf_err(stat,Status)
8810     if(Status /= WRF_NO_ERR) then
8811       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8812       call wrf_debug ( WARN , TRIM(msg))
8813       return
8814     endif
8815     select case (XType)
8816      !case (PIO_BYTE)
8817      !  Status = WRF_WARN_BAD_DATA_TYPE
8818      !  write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
8819      !  call wrf_debug ( WARN , TRIM(msg))
8820      !  return
8821       case (PIO_CHAR)
8822         Status = WRF_WARN_BAD_DATA_TYPE
8823         write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
8824         call wrf_debug ( WARN , TRIM(msg))
8825         return
8826      !case (PIO_SHORT)
8827      !  Status = WRF_WARN_BAD_DATA_TYPE
8828      !  write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
8829      !  call wrf_debug ( WARN , TRIM(msg))
8830      !  return
8831       case (PIO_INT)
8832         if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then
8833           Status = WRF_WARN_BAD_DATA_TYPE
8834           write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
8835           call wrf_debug ( WARN , TRIM(msg))
8836           return
8837         endif
8838       case (PIO_REAL)
8839         if(WrfType /= WRF_REAL) then
8840           Status = WRF_WARN_BAD_DATA_TYPE
8841           write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
8842           call wrf_debug ( WARN , TRIM(msg))
8843           return
8844         endif
8845       case (PIO_DOUBLE)
8846         if(WrfType /= WRF_DOUBLE) then
8847           Status = WRF_WARN_BAD_DATA_TYPE
8848           write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
8849           call wrf_debug ( WARN , TRIM(msg))
8850           return
8851         endif
8852       case default
8853         Status = WRF_WARN_DATA_TYPE_NOT_FOUND
8854         write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
8855         call wrf_debug ( WARN , TRIM(msg))
8856         return
8857     end select
8858
8859     stat = pio_get_att(DH%file_handle,VarID,'MemoryOrder',MemoryOrder)
8860     call netcdf_err(stat,Status)
8861     if(Status /= WRF_NO_ERR) then
8862       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8863       call wrf_debug ( WARN , TRIM(msg))
8864       return
8865     endif
8866     call GetDim(MemoryOrder,NDim,Status)
8867     if(Status /= WRF_NO_ERR) then
8868       write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__
8869       call wrf_debug ( WARN , TRIM(msg))
8870       return
8871     endif
8872     stat = pio_inq_vardimid(DH%file_handle,VarID,VDimIDs)
8873     call netcdf_err(stat,Status)
8874     if(Status /= WRF_NO_ERR) then
8875       write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8876       call wrf_debug ( WARN , TRIM(msg))
8877       return
8878     endif
8879     do j = 1, NDim
8880       DomainStart(j) = 1
8881       stat = pio_inq_dimlen(DH%file_handle,VDimIDs(j),DomainEnd(j))
8882       call netcdf_err(stat,Status)
8883       if(Status /= WRF_NO_ERR) then
8884         write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
8885         call wrf_debug ( WARN , TRIM(msg))
8886         return
8887       endif
8888     enddo
8889   else
8890     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
8891     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
8892     call wrf_debug ( FATAL , msg)
8893   endif
8894   return
8895 end subroutine ext_pio_get_var_info
8896
8897 subroutine ext_pio_warning_str( Code, ReturnString, Status)
8898   use wrf_data_pio
8899   use pio_routines
8900   implicit none
8901   include 'wrf_status_codes.h'
8902
8903   integer  , intent(in)  ::Code
8904   character *(*), intent(out) :: ReturnString
8905   integer, intent(out) ::Status
8906
8907   SELECT CASE (Code)
8908   CASE (0)
8909       ReturnString='No error'
8910       Status=WRF_NO_ERR
8911       return
8912   CASE (-1)
8913       ReturnString= 'File not found (or file is incomplete)'
8914       Status=WRF_NO_ERR
8915       return
8916   CASE (-2)
8917       ReturnString='Metadata not found'
8918       Status=WRF_NO_ERR
8919       return
8920   CASE (-3)
8921       ReturnString= 'Timestamp not found'
8922       Status=WRF_NO_ERR
8923       return
8924   CASE (-4)
8925       ReturnString= 'No more timestamps'
8926       Status=WRF_NO_ERR
8927       return
8928   CASE (-5)
8929       ReturnString= 'Variable not found'
8930       Status=WRF_NO_ERR
8931       return
8932   CASE (-6)
8933       ReturnString= 'No more variables for the current time'
8934       Status=WRF_NO_ERR
8935       return
8936   CASE (-7)
8937       ReturnString= 'Too many open files'
8938       Status=WRF_NO_ERR
8939       return
8940   CASE (-8)
8941       ReturnString= 'Data type mismatch'
8942       Status=WRF_NO_ERR
8943       return
8944   CASE (-9)
8945       ReturnString= 'Attempt to write read-only file'
8946       Status=WRF_NO_ERR
8947       return
8948   CASE (-10)
8949       ReturnString= 'Attempt to read write-only file'
8950       Status=WRF_NO_ERR
8951       return
8952   CASE (-11)
8953       ReturnString= 'Attempt to access unopened file'
8954       Status=WRF_NO_ERR
8955       return
8956   CASE (-12)
8957       ReturnString= 'Attempt to do 2 trainings for 1 variable'
8958       Status=WRF_NO_ERR
8959       return
8960   CASE (-13)
8961       ReturnString= 'Attempt to read past EOF'
8962       Status=WRF_NO_ERR
8963       return
8964   CASE (-14)
8965       ReturnString= 'Bad data handle'
8966       Status=WRF_NO_ERR
8967       return
8968   CASE (-15)
8969       ReturnString= 'Write length not equal to training length'
8970       Status=WRF_NO_ERR
8971       return
8972   CASE (-16)
8973       ReturnString= 'More dimensions requested than training'
8974       Status=WRF_NO_ERR
8975       return
8976   CASE (-17)
8977       ReturnString= 'Attempt to read more data than exists'
8978       Status=WRF_NO_ERR
8979       return
8980   CASE (-18)
8981       ReturnString= 'Input dimensions inconsistent'
8982       Status=WRF_NO_ERR
8983       return
8984   CASE (-19)
8985       ReturnString= 'Input MemoryOrder not recognized'
8986       Status=WRF_NO_ERR
8987       return
8988   CASE (-20)
8989       ReturnString= 'A dimension name with 2 different lengths'
8990       Status=WRF_NO_ERR
8991       return
8992   CASE (-21)
8993       ReturnString= 'String longer than provided storage'
8994       Status=WRF_NO_ERR
8995       return
8996   CASE (-22)
8997       ReturnString= 'Function not supportable'
8998       Status=WRF_NO_ERR
8999       return
9000   CASE (-23)
9001       ReturnString= 'Package implements this routine as NOOP'
9002       Status=WRF_NO_ERR
9003       return
9004
9005 !netcdf-specific warning messages
9006   CASE (-1007)
9007       ReturnString= 'Bad data type'
9008       Status=WRF_NO_ERR
9009       return
9010   CASE (-1008)
9011       ReturnString= 'File not committed'
9012       Status=WRF_NO_ERR
9013       return
9014   CASE (-1009)
9015       ReturnString= 'File is opened for reading'
9016       Status=WRF_NO_ERR
9017       return
9018   CASE (-1011)
9019       ReturnString= 'Attempt to write metadata after open commit'
9020       Status=WRF_NO_ERR
9021       return
9022   CASE (-1010)
9023       ReturnString= 'I/O not initialized'
9024       Status=WRF_NO_ERR
9025       return
9026   CASE (-1012)
9027      ReturnString=  'Too many variables requested'
9028       Status=WRF_NO_ERR
9029       return
9030   CASE (-1013)
9031      ReturnString=  'Attempt to close file during a dry run'
9032       Status=WRF_NO_ERR
9033       return
9034   CASE (-1014)
9035       ReturnString= 'Date string not 19 characters in length'
9036       Status=WRF_NO_ERR
9037       return
9038   CASE (-1015)
9039       ReturnString= 'Attempt to read zero length words'
9040       Status=WRF_NO_ERR
9041       return
9042   CASE (-1016)
9043       ReturnString= 'Data type not found'
9044       Status=WRF_NO_ERR
9045       return
9046   CASE (-1017)
9047       ReturnString= 'Badly formatted date string'
9048       Status=WRF_NO_ERR
9049       return
9050   CASE (-1018)
9051       ReturnString= 'Attempt at read during a dry run'
9052       Status=WRF_NO_ERR
9053       return
9054   CASE (-1019)
9055       ReturnString= 'Attempt to get zero words'
9056       Status=WRF_NO_ERR
9057       return
9058   CASE (-1020)
9059       ReturnString= 'Attempt to put zero length words'
9060       Status=WRF_NO_ERR
9061       return
9062   CASE (-1021)
9063       ReturnString= 'NetCDF error'
9064       Status=WRF_NO_ERR
9065       return
9066   CASE (-1022)
9067       ReturnString= 'Requested length <= 1'
9068       Status=WRF_NO_ERR
9069       return
9070   CASE (-1023)
9071       ReturnString= 'More data available than requested'
9072       Status=WRF_NO_ERR
9073       return
9074   CASE (-1024)
9075       ReturnString= 'New date less than previous date'
9076       Status=WRF_NO_ERR
9077       return
9078
9079   CASE DEFAULT
9080       ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. &
9081       & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
9082       & to be calling a package-specific routine to return a message for this warning code.'
9083       Status=WRF_NO_ERR
9084   END SELECT
9085
9086   return
9087 end subroutine ext_pio_warning_str
9088
9089
9090 !returns message string for all WRF and netCDF warning/error status codes
9091 !Other i/o packages must  provide their own routines to return their own status messages
9092 subroutine ext_pio_error_str( Code, ReturnString, Status)
9093   use wrf_data_pio
9094   use pio_routines
9095   implicit none
9096   include 'wrf_status_codes.h'
9097
9098   integer  , intent(in)  ::Code
9099   character *(*), intent(out) :: ReturnString
9100   integer, intent(out) ::Status
9101
9102   SELECT CASE (Code)
9103   CASE (-100)
9104       ReturnString= 'Allocation Error'
9105       Status=WRF_NO_ERR
9106       return
9107   CASE (-101)
9108       ReturnString= 'Deallocation Error'
9109       Status=WRF_NO_ERR
9110       return
9111   CASE (-102)
9112       ReturnString= 'Bad File Status'
9113       Status=WRF_NO_ERR
9114       return
9115   CASE (-1004)
9116       ReturnString= 'Variable on disk is not 3D'
9117       Status=WRF_NO_ERR
9118       return
9119   CASE (-1005)
9120       ReturnString= 'Metadata on disk is not 1D'
9121       Status=WRF_NO_ERR
9122       return
9123   CASE (-1006)
9124       ReturnString= 'Time dimension too small'
9125       Status=WRF_NO_ERR
9126       return
9127   CASE DEFAULT
9128       ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. &
9129       & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
9130       & to be calling a package-specific routine to return a message for this error code.'
9131       Status=WRF_NO_ERR
9132   END SELECT
9133
9134   return
9135 end subroutine ext_pio_error_str
9136
9137
9138 subroutine ext_pio_end_independent_mode(DataHandle, Status)
9139   use wrf_data_pio
9140   use pio_routines
9141   include 'wrf_status_codes.h'
9142   integer               ,intent(in)     :: DataHandle
9143   integer               ,intent(out)    :: Status
9144   type(wrf_data_handle) ,pointer        :: DH
9145   integer                               :: stat
9146
9147   DH => WrfDataHandles(DataHandle)
9148   return
9149 end subroutine ext_pio_end_independent_mode
9150
9151 subroutine ext_pio_start_independent_mode(DataHandle, Status)
9152   use wrf_data_pio
9153   use pio_routines
9154   include 'wrf_status_codes.h'
9155   integer               ,intent(in)     :: DataHandle
9156   integer               ,intent(out)    :: Status
9157   type(wrf_data_handle) ,pointer        :: DH
9158   integer                               :: stat
9159
9160   DH => WrfDataHandles(DataHandle)
9161   return
9162 end subroutine ext_pio_start_independent_mode
9163