!------------------------------------------------------------------ !$Id$ !------------------------------------------------------------------ subroutine ext_pio_open_for_read(DatasetName, grid, SysDepInfo, DataHandle, Status) use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' character *(*), INTENT(IN) :: DatasetName TYPE(domain) :: grid character *(*), INTENT(IN) :: SysDepInfo integer , INTENT(OUT) :: DataHandle integer , INTENT(OUT) :: Status DataHandle = 0 ! dummy setting to quiet warning message CALL ext_pio_open_for_read_begin( DatasetName, grid, SysDepInfo, DataHandle, Status ) IF ( Status .EQ. WRF_NO_ERR ) THEN CALL ext_pio_open_for_read_commit( DataHandle, Status ) ENDIF return end subroutine ext_pio_open_for_read !ends training phase; switches internal flag to enable input !must be paired with call to ext_pio_open_for_read_begin subroutine ext_pio_open_for_read_commit(DataHandle, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer, intent(in) :: DataHandle integer, intent(out) :: Status type(wrf_data_handle) ,pointer :: DH if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif DH%FileStatus = WRF_FILE_OPENED_FOR_READ Status = WRF_NO_ERR return end subroutine ext_pio_open_for_read_commit subroutine upgrade_filename(FileName) implicit none character*(*), intent(inout) :: FileName integer :: i do i = 1, len(trim(FileName)) if(FileName(i:i) == '-') then FileName(i:i) = '_' else if(FileName(i:i) == ':') then FileName(i:i) = '_' endif enddo end subroutine upgrade_filename subroutine ext_pio_open_for_read_begin( FileName, grid, SysDepInfo, DataHandle, Status) use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' character*(*) ,intent(INOUT) :: FileName TYPE(domain) :: grid character*(*) ,intent(in) :: SysDepInfo integer ,intent(out) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: stat integer :: StoredDim integer :: NAtts integer :: DimIDs(2) integer :: VStart(2) integer :: VLen(2) integer :: TotalNumVars integer :: NumVars integer :: i integer :: ndims, unlimitedDimID character(PIO_MAX_NAME) :: Name call upgrade_filename(FileName) if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call allocHandle(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%first_operation) then call initialize_pio(grid, DH) call define_pio_iodesc(grid, DH) DH%first_operation = .false. end if stat = pio_openfile(DH%iosystem, DH%file_handle, pio_iotype_pnetcdf, FileName) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_varid(DH%file_handle, DH%TimesName, DH%vtime) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inquire_variable(DH%file_handle, DH%vtime, DH%TimesName, XType, StoredDim, DimIDs, NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(XType/=PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_dimlen(DH%file_handle, DimIDs(1), VLen(1)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(VLen(1) /= DateStrLen) then Status = WRF_WARN_DATESTR_BAD_LENGTH write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_dimlen(DH%file_handle, DimIDs(2), VLen(2)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(VLen(2) > MaxTimes) then Status = WRF_ERR_FATAL_TOO_MANY_TIMES write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) return endif VStart(1) = 1 VStart(2) = 1 stat = pio_get_var(DH%file_handle, DH%vtime, DH%Times(1:VLen(2))) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inquire(DH%file_handle, ndims, TotalNumVars, NAtts, unlimitedDimID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif NumVars = 0 do i=1,TotalNumVars stat = pio_inq_varname(DH%file_handle,i,Name) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then NumVars = NumVars+1 DH%VarNames(NumVars) = Name DH%VarIDs(NumVars) = i endif enddo DH%NumVars = NumVars DH%NumberTimes = VLen(2) DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED DH%FileName = trim(FileName) DH%CurrentVariable = 0 DH%CurrentTime = 0 DH%TimeIndex = 0 do i = 1, ndims DH%DimIDs(i) = i stat = pio_inq_dimname(DH%file_handle,i,DH%DimNames(i)) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(unlimitedDimID == i) then DH%DimUnlimID = unlimitedDimID DH%DimUnlimName = DH%DimNames(i) endif enddo DH%NumDims = ndims return end subroutine ext_pio_open_for_read_begin subroutine ext_pio_open_for_update( FileName, grid, SysDepInfo, DataHandle, Status) use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' character*(*) ,intent(INOUT) :: FileName TYPE(domain) :: grid character*(*) ,intent(in) :: SysDepInfo integer ,intent(out) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: stat integer :: StoredDim integer :: NAtts integer :: DimIDs(2) integer :: VStart(2) integer :: VLen(2) integer :: TotalNumVars integer :: NumVars integer :: i integer :: ndims, unlimitedDimID character(PIO_MAX_NAME) :: Name call upgrade_filename(FileName) if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call allocHandle(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%first_operation) then call initialize_pio(grid, DH) call define_pio_iodesc(grid, DH) DH%first_operation = .false. end if stat = pio_openfile(DH%iosystem, DH%file_handle, pio_iotype_pnetcdf, FileName) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_varid(DH%file_handle, DH%TimesName, DH%vtime) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inquire_variable(DH%file_handle, DH%vtime, DH%TimesName, & XType, StoredDim, DimIDs, NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(XType/=PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_dimlen(DH%file_handle, DimIDs(1), VLen(1)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(VLen(1) /= DateStrLen) then Status = WRF_WARN_DATESTR_BAD_LENGTH write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_dimlen(DH%file_handle, DimIDs(2), VLen(2)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(VLen(2) > MaxTimes) then Status = WRF_ERR_FATAL_TOO_MANY_TIMES write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) return endif VStart(1) = 1 VStart(2) = 1 !stat = pio_get_var(DH%file_handle, DH%vtime, VStart, VLen, DH%Times) stat = pio_get_var(DH%file_handle, DH%vtime, DH%Times) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inquire(DH%file_handle, ndims, TotalNumVars, NAtts, unlimitedDimID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif NumVars = 0 do i=1,TotalNumVars stat = pio_inq_varname(DH%file_handle, i, Name) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then NumVars = NumVars+1 DH%VarNames(NumVars) = Name DH%VarIDs(NumVars) = i endif enddo DH%NumVars = NumVars DH%NumberTimes = VLen(2) DH%FileStatus = WRF_FILE_OPENED_FOR_UPDATE DH%FileName = trim(FileName) DH%CurrentVariable = 0 DH%CurrentTime = 0 DH%TimeIndex = 0 return end subroutine ext_pio_open_for_update SUBROUTINE ext_pio_open_for_write_begin(FileName,grid,SysDepInfo,DataHandle,Status) use pio_types use pio use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' character*(*) ,intent(inout) :: FileName TYPE(domain) :: grid character*(*) ,intent(in) :: SysDepInfo integer ,intent(out) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle),pointer :: DH integer :: i integer :: stat character (7) :: Buffer integer :: VDimIDs(2) integer :: info, ierr ! added for Blue Gene (see PIO_CREAT below) character*128 :: idstr,ntasks_x_str,loccomm_str integer :: gridid integer local_communicator_x, ntasks_x call upgrade_filename(FileName) if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_open_for_write_begin: ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call allocHandle(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Fatal ALLOCATION ERROR in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) return endif DH%TimeIndex = 0 DH%Times = ZeroDate if(DH%first_operation) then call initialize_pio(grid, DH) call define_pio_iodesc(grid, DH) DH%first_operation = .false. end if !call mpi_info_create( info, ierr ) stat = pio_CreateFile(DH%iosystem, DH%file_handle, & pio_iotype_pnetcdf, FileName, PIO_64BIT_OFFSET) !call mpi_info_free( info, ierr) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif !JPE added for performance !stat = nf90_set_fill(DH%file_handle, NF90_NOFILL, i) DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED DH%FileName = trim(FileName) stat = pio_def_dim(DH%file_handle, DH%DimUnlimName, PIO_UNLIMITED, DH%DimUnlimID) !stat = pio_def_dim(DH%file_handle, DH%DimUnlimName, 1, DH%DimUnlimID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif DH%VarNames (1:MaxVars) = NO_NAME do i=1,MaxDims write(Buffer,FMT="('DIM',i4.4)") i DH%DimNames (i) = Buffer DH%DimLengths(i) = NO_DIM enddo DH%DimNames(1) = 'DateStrLen' stat = pio_def_dim(DH%file_handle, DH%DimNames(1), DateStrLen, DH%DimIDs(1)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif VDimIDs(1) = DH%DimIDs(1) VDimIDs(2) = DH%DimUnlimID stat = pio_def_var(DH%file_handle,DH%TimesName,PIO_CHAR,VDimIDs,DH%vtime) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ext_pio_open_for_write_begin ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif DH%DimLengths(1) = DateStrLen return end subroutine ext_pio_open_for_write_begin !opens a file for writing or coupler datastream for sending messages. !no training phase for this version of the open stmt. subroutine ext_pio_open_for_write (DatasetName, grid, & SysDepInfo, DataHandle, Status) use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' character *(*), intent(in) :: DatasetName type(domain) :: grid character *(*), intent(in) :: SysDepInfo integer , intent(out) :: DataHandle integer , intent(out) :: Status Status=WRF_WARN_NOOP DataHandle = 0 ! dummy setting to quiet warning message return end subroutine ext_pio_open_for_write SUBROUTINE ext_pio_open_for_write_commit(DataHandle, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle),pointer :: DH integer :: i integer :: stat if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_open_for_write_commit: ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ext_pio_open_for_write_commit ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif DH%Write = .true. stat = pio_enddef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error (',stat,') from pio_enddef in ext_pio_open_for_write_commit ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE return end subroutine ext_pio_open_for_write_commit subroutine ext_pio_ioclose(DataHandle, Status) use wrf_data_pio use pio_routines use pio use pio_kinds implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle),pointer :: DH integer :: stat call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ext_pio_ioclose ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ext_pio_ioclose ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_CLOSE write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_pio_ioclose ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then continue elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then continue elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then continue else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ext_pio_ioclose ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) return endif call pio_closefile(DH%file_handle) CALL deallocHandle( DataHandle, Status ) DH%Free=.true. return end subroutine ext_pio_ioclose subroutine ext_pio_iosync( DataHandle, Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle),pointer :: DH integer :: stat call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ext_pio_iosync ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ext_pio_iosync ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_FILE_NOT_COMMITTED write(msg,*) 'Warning FILE NOT COMMITTED in ext_pio_iosync ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then continue elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then continue else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ext_pio_iosync ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) return endif call pio_syncfile(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ext_pio_iosync ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif return end subroutine ext_pio_iosync subroutine ext_pio_ioinit(SysDepInfo, Status) use wrf_data_pio implicit none include 'wrf_status_codes.h' CHARACTER*(*), INTENT(IN) :: SysDepInfo INTEGER ,INTENT(INOUT) :: Status WrfIOnotInitialized = .false. WrfDataHandles(1:WrfDataHandleMax)%Free = .true. WrfDataHandles(1:WrfDataHandleMax)%TimesName = 'Times' WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time' WrfDataHandles(1:WrfDataHandleMax)%FileStatus = WRF_FILE_NOT_OPENED Status = WRF_NO_ERR return end subroutine ext_pio_ioinit subroutine ext_pio_inquiry (Inquiry, Result, Status) use wrf_data_pio implicit none include 'wrf_status_codes.h' character *(*), INTENT(IN) :: Inquiry character *(*), INTENT(OUT) :: Result integer ,INTENT(INOUT) :: Status SELECT CASE (Inquiry) CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ") Result='ALLOW' CASE ("OPEN_READ","OPEN_COMMIT_WRITE") Result='REQUIRE' CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO") Result='NO' CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS") Result='YES' CASE ("MEDIUM") Result ='FILE' CASE DEFAULT Result = 'No Result for that inquiry!' END SELECT Status=WRF_NO_ERR return end subroutine ext_pio_inquiry subroutine ext_pio_ioexit(Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer , INTENT(INOUT) ::Status integer :: error type(wrf_data_handle),pointer :: DH integer :: i integer :: stat if(WrfIOnotInitialized) then Status = WRF_IO_NOT_INITIALIZED write(msg,*) 'ext_pio_ioinit was not called ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif do i=1,WrfDataHandleMax CALL deallocHandle( i , stat ) enddo return end subroutine ext_pio_ioexit subroutine ext_pio_get_dom_ti_real_arr(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat real, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( XType/=PIO_REAL) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_real_arr subroutine ext_pio_get_dom_ti_real_sca(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat real, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( XType/=PIO_REAL) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_real_sca subroutine ext_pio_get_dom_ti_integer_arr(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element integer, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat integer, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( XType/=PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_integer_arr subroutine ext_pio_get_dom_ti_integer_sca(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element integer, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat integer, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( XType/=PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_integer_sca subroutine ext_pio_get_dom_ti_double_arr(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real*8, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat real*8, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data(1:min(Len,Count)) = Buffer(1:min(Len,Count)) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_double_arr subroutine ext_pio_get_dom_ti_double_sca(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real*8, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat real*8, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_double_sca subroutine ext_pio_get_dom_ti_logical_arr(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element logical, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat integer, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if ( PIO_INT == PIO_DOUBLE .OR. PIO_INT == PIO_REAL ) then if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif else if( XType/=PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1 deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_logical_arr subroutine ext_pio_get_dom_ti_logical_sca(DataHandle,Element,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element logical, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCOunt integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat integer, allocatable :: Buffer(:) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if ( PIO_INT == PIO_DOUBLE .OR. PIO_INT == PIO_REAL ) then if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif else if( XType/=PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif allocate(Buffer(Len), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att (DH%file_handle,PIO_GLOBAL,Element,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= WRF_NO_ERR) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_logical_sca subroutine ext_pio_get_dom_ti_char_arr(DataHandle,Element,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*), intent(out) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif Data = '' stat = pio_get_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_char_arr subroutine ext_pio_get_dom_ti_char_sca(DataHandle,Element,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*), intent(out) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XType integer :: Len integer :: stat call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to read time-independent domain metadata. IF(.not. ncd_ok_to_get_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_att(DH%file_handle, PIO_GLOBAL, Element, XType, Len) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',trim(Element) call wrf_debug ( WARN , msg) return endif if(Len<=0) then Status = WRF_WARN_LENGTH_LESS_THAN_1 write(msg,*) 'Warning LENGTH < 1 in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ', trim(Element) call wrf_debug ( WARN , msg) return endif Data = '' stat = pio_get_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_dom_ti_char_sca subroutine ext_pio_put_dom_ti_real_arr(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real, intent(in) :: Data(*) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i real, dimension(1:Count) :: tmparr tmparr(1:Count) = Data(1:Count) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then !stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr) if(1 == Count) then stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1)) else stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count)) endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if(1 == Count) then stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1)) else stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count)) endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_put_dom_ti_real_arr subroutine ext_pio_put_dom_ti_real_sca(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_put_dom_ti_real_sca subroutine ext_pio_put_dom_ti_integer_arr(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element integer, intent(in) :: Data(*) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i integer, dimension(Count) :: tmparr call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif tmparr(1:Count) = Data(1:Count) !-Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif tmparr(1:Count) = Data(1:Count) if(1 == Count) then stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1)) else stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count)) endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_put_dom_ti_integer_arr subroutine ext_pio_put_dom_ti_integer_sca(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element integer, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_put_dom_ti_integer_sca subroutine ext_pio_put_dom_ti_double_arr(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real*8, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i real*8, dimension(1:Count) :: tmparr write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 tmparr(1:Count) = Data(1:Count) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,tmparr(1:Count)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif #endif return end subroutine ext_pio_put_dom_ti_double_arr subroutine ext_pio_put_dom_ti_double_sca(DataHandle,Element,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element real*8, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att (DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif #endif return end subroutine ext_pio_put_dom_ti_double_sca subroutine ext_pio_put_dom_ti_logical_arr(DataHandle,Element,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element logical, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer ,allocatable :: Buffer(:) integer :: i write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif do i=1,Count if(data(i)) then Buffer(i)=1 else Buffer(i)=0 endif enddo stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer) deallocate(Buffer, STAT=stat) if(stat /= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif do i=1,Count if(data(i)) then Buffer(i)=1 else Buffer(i)=0 endif enddo stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer) deallocate(Buffer, STAT=stat) if(stat /= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif #endif return end subroutine ext_pio_put_dom_ti_logical_arr subroutine ext_pio_put_dom_ti_logical_sca(DataHandle,Element,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element logical, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer ,allocatable :: Buffer(:) integer :: i write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(data) then Buffer(1)=1 else Buffer(1)=0 endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer) deallocate(Buffer, STAT=stat) if(stat /= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(data) then Buffer(1)=1 else Buffer(1)=0 endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Buffer) deallocate(Buffer, STAT=stat) if(stat /= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif #endif return end subroutine ext_pio_put_dom_ti_logical_sca subroutine ext_pio_put_dom_ti_char_arr(DataHandle,Element,Data,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*), intent(in) :: Data integer, parameter :: Count=1 integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_put_dom_ti_char_arr subroutine ext_pio_put_dom_ti_char_sca(DataHandle,Element,Data,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*), intent(in) :: Data integer, parameter :: Count=1 integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat integer :: i write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif ! Do nothing unless it is time to write time-independent domain metadata. IF(.not. ncd_ok_to_put_dom_ti( DataHandle ) ) THEN return ENDIF if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then STATUS = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif (DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif stat = pio_put_att(DH%file_handle,PIO_GLOBAL,Element,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) endif #endif return end subroutine ext_pio_put_dom_ti_char_sca subroutine ext_pio_put_var_ti_real_arr(DataHandle,Element,Var,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_real_arr subroutine ext_pio_put_var_ti_real_sca(DataHandle,Element,Var,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_real_sca subroutine ext_pio_put_var_td_real_arr(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var real ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do i=1,MaxVars if(DH%VarNames(i) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE NVar=i return elseif(DH%VarNames(i) == NO_NAME) then DH%VarNames(i) = Name exit elseif(i == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1, NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '2 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_REAL,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do i=1,MaxVars if(DH%VarNames(i) == Name) then NVar=i exit elseif(DH%VarNames(i) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(i == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_real_arr subroutine ext_pio_put_var_td_real_sca(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var real ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: Buffer(1) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do i=1,MaxVars if(DH%VarNames(i) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE NVar=i return elseif(DH%VarNames(i) == NO_NAME) then DH%VarNames(i) = Name exit elseif(i == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '3 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_REAL,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 Buffer(1) = Data !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Buffer) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_real_sca subroutine ext_pio_put_var_ti_double_arr(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real*8 ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character*1 :: null null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_put_var_ti_double_arr subroutine ext_pio_put_var_ti_double_sca(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real*8 ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat real*8 :: Buffer(1) integer :: i integer :: NVar character*1 :: null null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo Buffer(1) = Data stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_put_var_ti_double_sca subroutine ext_pio_put_var_td_double_arr(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var real*8 ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '4 Define Var <', trim(Var), '> as NVvar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_DOUBLE,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Data) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_double_arr subroutine ext_pio_put_var_td_double_sca(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var real*8 ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex real*8 :: Buffer(1) write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '5 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_DOUBLE,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 Buffer(1) = Data !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Buffer) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_double_sca subroutine ext_pio_put_var_ti_integer_arr(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var integer, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_integer_arr subroutine ext_pio_put_var_ti_integer_sca(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var integer, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: Buffer(1) integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo Buffer(1) = Data stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_integer_sca subroutine ext_pio_put_var_td_integer_arr(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var integer, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '6 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Data) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_integer_arr subroutine ext_pio_put_var_td_integer_sca(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var integer, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: Buffer(1) write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '7 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 Buffer(1) = Data !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_integer_sca subroutine ext_pio_put_var_ti_logical_arr(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var logical, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif do i=1,Count if(data(i)) then Buffer(i)=1 else Buffer(i)=0 endif enddo stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) endif deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_logical_arr subroutine ext_pio_put_var_ti_logical_sca(DataHandle,Element,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var logical, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: Buffer(1) integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo if(Data) then Buffer(1)=1 else Buffer(1)=0 endif stat = pio_put_var(DH%file_handle,DH%descVar(NVar),Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) endif if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_logical_sca subroutine ext_pio_put_var_td_logical_arr(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var logical, intent(in) :: Data(:) integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '8 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 allocate(Buffer(Count), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif do i=1,Count if(data(i)) then Buffer(i)=1 else Buffer(i)=0 endif enddo !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer) deallocate(Buffer, STAT=stat) if(stat /= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_logical_arr subroutine ext_pio_put_var_td_logical_sca(DataHandle,Element,DateStr,Var,Data,Count,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var logical, intent(in) :: Data integer, intent(in) :: Count integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: Buffer(1) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == Count) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),Count,DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = Count exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = Count VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '9 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_INT,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(Count > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(Count < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Count VCount(2) = 1 if(Data) then Buffer(1)=1 else Buffer(1)=0 endif !stat = pio_put_var(DH%file_handle,DH%MDVarIDs(NVar),VStart,VCount,Buffer) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_logical_sca subroutine ext_pio_put_var_ti_char_arr(DataHandle,Element,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var character*(*) ,intent(in) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character(len=1) :: null character(len=4096) :: tmpdata integer :: length length = len(Data) if(1 > length) then length = 0 null = char(0) else if(4096 < length) then length = 4096 tmpdata = Data(1:4096) else tmpdata = trim(Data) end if VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do i=1,MaxVars if(TRIM(DH%VarNames(i)) == TRIM(VarName)) then NVar = i exit elseif(i == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Data: ', trim(Data), ', tmpdata: ', trim(tmpdata) !write(unit=0, fmt='(3a,i6)') 'Element = ', trim(Element), ', NVar = ', NVar !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, & ! ', length = ', length if(DH%Write) then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif endif if(1 > length) then !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Element: ', trim(Element), ', tmpdata: ', trim(tmpdata) !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, & ! ', length = ', length stat = pio_put_att(DH%file_handle,DH%descVar(NVar),trim(Element),null) else !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ !write(unit=0, fmt='(6a)') 'Var: ', trim(Var), ', Element: ', trim(Element), ', tmpdata: ', trim(tmpdata) !write(unit=0, fmt='(2(a,i6))') 'DH%descVar(NVar)%VarID = ', DH%descVar(NVar)%VarID, & ! ', length = ', length stat = pio_put_att(DH%file_handle,DH%descVar(NVar),trim(Element),tmpdata) endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_put_var_ti_char_arr subroutine ext_pio_put_var_ti_char_sca(DataHandle,Element,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var character*(*) ,intent(in) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName integer :: stat integer :: i integer :: NVar character*1 :: null write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 null=char(0) VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_MD_AFTER_OPEN write(msg,*) 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then exit elseif(NVar == MaxVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ & ,NVar,VarName call wrf_debug ( WARN , msg) return endif enddo if(len_trim(Data).le.0) then stat = pio_put_var(DH%file_handle,DH%descVar(NVar),null) else stat = pio_put_var(DH%file_handle,DH%descVar(NVar),trim(Data)) endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error for Var ',TRIM(Var),& ' Element ',trim(Element),' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_ti_char_sca subroutine ext_pio_put_var_td_char_arr(DataHandle,Element,DateStr,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var character*(*) ,intent(in) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex character(len=4096) :: tmpdata(1) integer :: length length = len(Data) if(1 > length) then length = 1 tmpdata(1) = "" else if(4096 < length) then length = 4096 tmpdata(1) = Data(1:4096) else tmpdata(1) = trim(Data) end if write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1) write(unit=0, fmt='(4a)') 'Name: ', trim(Name), ', Element = ', trim(Element) VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(len(Data) < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == len(Data)) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),len(Data),DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = len(Data) exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = len(Data) VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '10 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_CHAR,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(len(Data) > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(len(Data) < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = length VCount(2) = 1 tmpdata = Data stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,tmpdata) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line: ', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_put_var_td_char_arr subroutine ext_pio_put_var_td_char_sca(DataHandle,Element,DateStr,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var character*(*) ,intent(in) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex character(len=DateStrLen) :: tmpdata(1) integer :: length write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ #if 0 length = len(Data) if(1 > length) then length = 1 tmpdata(1) = "" else if(4096 < length) then length = 4096 tmpdata(1) = Data(1:4096) else tmpdata(1) = trim(Data) end if write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1) write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(4a)') 'Var: ', trim(Var), ', Data: ', tmpdata(1) write(unit=0, fmt='(4a)') 'Name: ', trim(Name), ', Element = ', trim(Element) VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then if(len(Data) < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT return endif do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then Status = WRF_WARN_2DRYRUNS_1VARIABLE return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = Name exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo do i=1,MaxDims if(DH%DimLengths(i) == len(Data)) then exit elseif(DH%DimLengths(i) == NO_DIM) then stat = pio_def_dim(DH%file_handle,DH%DimNames(i),len(Data),DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif DH%DimLengths(i) = len(Data) exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo DH%VarDimLens(1,NVar) = len(Data) VDims(1) = DH%DimIDs(i) VDims(2) = DH%DimUnlimID write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ write(unit=0, fmt='(3a,i6)') '11 Define Var <', trim(Var), '> as NVar:', NVar stat = pio_def_var(DH%file_handle,Name,PIO_CHAR,DH%descVar(NVar)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then do NVar=1,MaxVars if(DH%VarNames(NVar) == Name) then exit elseif(DH%VarNames(NVar) == NO_NAME) then Status = WRF_WARN_MD_NF write(msg,*) 'Warning METADATA NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo if(len(Data) > DH%VarDimLens(1,NVar)) then Status = WRF_WARN_COUNT_TOO_LONG write(msg,*) 'Warning COUNT TOO LONG in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return elseif(len(Data) < 1) then Status = WRF_WARN_ZERO_LENGTH_PUT write(msg,*) 'Warning ZERO LENGTH PUT in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = len(Data) VCount(2) = 1 tmpdata = Data !stat = pio_put_var(DH%file_handle,DH%descMDVar(NVar),VStart,VCount,Data) stat = pio_put_var(DH%file_handle,DH%descVar(NVar),VStart,VCount,tmpdata) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line: ', __LINE__ call wrf_debug ( FATAL , msg) return endif #endif return end subroutine ext_pio_put_var_td_char_sca subroutine ext_pio_get_var_ti_real_arr(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen real, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_REAL) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_real_arr subroutine ext_pio_get_var_ti_real_sca(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen real, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line: ', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_REAL) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_real_sca subroutine ext_pio_get_var_td_real_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var real ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat real ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_real_arr subroutine ext_pio_get_var_td_real_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var real ,intent(out) :: Data integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat real ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_real_sca subroutine ext_pio_get_var_ti_double_arr(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real*8, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen real*8, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_double_arr subroutine ext_pio_get_var_ti_double_sca(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var real*8, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen real*8, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_double_sca subroutine ext_pio_get_var_td_double_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var real*8, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat real*8, allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_double_arr subroutine ext_pio_get_var_td_double_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var real*8, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat real*8, allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_double_sca subroutine ext_pio_get_var_ti_integer_arr(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var integer, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen integer, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_integer_arr subroutine ext_pio_get_var_ti_integer_sca(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var integer, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen integer, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_integer_sca subroutine ext_pio_get_var_td_integer_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var integer, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count)) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_integer_arr subroutine ext_pio_get_var_td_integer_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var integer, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if( .NOT. ( XType==PIO_REAL .OR. XType==PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_integer_sca subroutine ext_pio_get_var_ti_logical_arr(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var logical, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen integer, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1 deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_logical_arr subroutine ext_pio_get_var_ti_logical_sca(DataHandle,Element,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var logical, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen integer, allocatable :: Buffer(:) character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif allocate(Buffer(XLen), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Buffer ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(XLen > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = XLen Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_logical_sca subroutine ext_pio_get_var_td_logical_arr(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var logical, intent(out) :: Data(:) integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1 deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_logical_arr subroutine ext_pio_get_var_td_logical_sca(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var logical, intent(out) :: Data integer, intent(in) :: Count integer, intent(out) :: OutCount integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat integer ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = min(Count,Len1) VCount(2) = 1 allocate(Buffer(VCount(1)), STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_ALLOCATION_ERROR write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = Buffer(1) deallocate(Buffer, STAT=stat) if(stat/= 0) then Status = WRF_ERR_FATAL_DEALLOCATION_ERR write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif if(Len1 > Count) then OutCount = Count Status = WRF_WARN_MORE_DATA_IN_FILE else OutCount = Len1 Status = WRF_NO_ERR endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','LOGICAL',', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_td_logical_sca subroutine ext_pio_get_var_ti_char_arr(DataHandle,Element,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var character*(*) ,intent(out) :: Data integer :: Count = 1 integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__ return endif if(XLen > len(Data)) then Status = WRF_WARN_CHARSTR_GT_LENDATA write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Data ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_char_arr subroutine ext_pio_get_var_ti_char_sca(DataHandle,Element,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: Var character*(*) ,intent(out) :: Data integer :: Count = 1 integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: XLen character (VarNameLen) :: VarName integer :: stat integer :: NVar integer :: XType if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif enddo stat = pio_inq_att(DH%file_handle,DH%descVar(NVar),trim(Element),XType,XLen) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif if(XType /= PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__ return endif if(XLen > len(Data)) then Status = WRF_WARN_CHARSTR_GT_LENDATA write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif stat = pio_get_att(DH%file_handle,DH%descVar(NVar),trim(Element), Data ) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif return end subroutine ext_pio_get_var_ti_char_sca subroutine ext_pio_get_var_td_char_arr(DataHandle,Element,DateStr,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var character*(*) ,intent(out) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 integer, parameter :: Count = 1 character(DateStrLen) :: Buffer(1) if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if(XType /= PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Len1 VCount(2) = 1 if(Len1 > len(Data)) then Status = WRF_WARN_CHARSTR_GT_LENDATA write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = '' stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Buffer) !stat = pio_get_var(DH%file_handle,VarID,Buffer) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = Buffer(1) else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ endif return end subroutine ext_pio_get_var_td_char_arr subroutine ext_pio_get_var_td_char_sca(DataHandle,Element,DateStr,Var,Data,Status) use pio_kinds use pio use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character (DateStrLen),intent(in) :: DateStr character*(*) ,intent(in) :: Var character*(*) ,intent(out) :: Data integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH character (VarNameLen) :: VarName character (40+len(Element)) :: Name character (40+len(Element)) :: FName integer :: stat character (80) ,allocatable :: Buffer(:) integer :: i integer :: VDims (2) integer :: VStart(2) integer :: VCount(2) integer :: NVar integer :: TimeIndex integer :: DimIDs(2) integer :: VarID integer :: XType integer :: NDims integer :: NAtts integer :: Len1 integer, parameter :: Count = 1 if(Count <= 0) then Status = WRF_WARN_ZERO_LENGTH_GET write(msg,*) 'Warning ZERO LENGTH GET in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VarName = Var call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif call GetName(Element, VarName, Name, Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WONLY FILE in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif !stat = NFMPI_INQ_VAR(file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) stat = pio_inquire_variable(DH%file_handle,VarID,FName,XType,NDims,DimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' Element ',Element call wrf_debug ( WARN , msg) return endif if(XType /= PIO_CHAR) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif if(NDims /= NMDVarDims) then Status = WRF_ERR_FATAL_MDVAR_DIM_NOT_1D write(msg,*) 'Fatal MDVAR DIM NOT 1D in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( FATAL , msg) return endif stat = pio_inq_dimlen(DH%file_handle,DimIDs(1),Len1) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__,' DimIDs(1) ',DimIDs(1) call wrf_debug ( WARN , msg) return endif call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif VStart(1) = 1 VStart(2) = TimeIndex VCount(1) = Len1 VCount(2) = 1 if(Len1 > len(Data)) then Status = WRF_WARN_CHARSTR_GT_LENDATA write(msg,*) 'Warning LEN CHAR STRING > LEN DATA in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif Data = '' !stat = pio_get_var(DH%file_handle,VarID,VStart,VCount,Data) stat = pio_get_var(DH%file_handle,VarID,Data) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,' ','CHAR',', line', __LINE__ endif return end subroutine ext_pio_get_var_td_char_sca subroutine ext_pio_put_dom_td_real_arr(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_real_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_real_arr subroutine ext_pio_put_dom_td_real_sca(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_real_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_real_sca subroutine ext_pio_put_dom_td_integer_arr(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr integer ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_integer_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_integer_arr subroutine ext_pio_put_dom_td_integer_sca(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr integer ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_integer_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_integer_sca subroutine ext_pio_put_dom_td_double_arr(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real*8 ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_double_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_double_arr subroutine ext_pio_put_dom_td_double_sca(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real*8 ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_double_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_double_sca subroutine ext_pio_put_dom_td_logical_arr(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr logical ,intent(in) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_logical_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_logical_arr subroutine ext_pio_put_dom_td_logical_sca(DataHandle,Element,DateStr,Data,Count,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr logical ,intent(in) :: Data integer ,intent(in) :: Count integer ,intent(out) :: Status call ext_pio_put_var_td_logical_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status) return end subroutine ext_pio_put_dom_td_logical_sca subroutine ext_pio_put_dom_td_char_arr(DataHandle,Element,DateStr,Data,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Data integer ,intent(out) :: Status call ext_pio_put_var_td_char_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) return end subroutine ext_pio_put_dom_td_char_arr subroutine ext_pio_put_dom_td_char_sca(DataHandle,Element,DateStr,Data,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Data integer ,intent(out) :: Status call ext_pio_put_var_td_char_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) return end subroutine ext_pio_put_dom_td_char_sca subroutine ext_pio_get_dom_td_real_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_real_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_real_arr subroutine ext_pio_get_dom_td_real_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real ,intent(out) :: Data integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_real_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_real_sca subroutine ext_pio_get_dom_td_integer_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr integer ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_integer_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_integer_arr subroutine ext_pio_get_dom_td_integer_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr integer ,intent(out) :: Data integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_integer_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_integer_sca subroutine ext_pio_get_dom_td_double_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real*8 ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_double_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_double_arr subroutine ext_pio_get_dom_td_double_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr real*8 ,intent(out) :: Data integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_double_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_double_sca subroutine ext_pio_get_dom_td_logical_arr(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr logical ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_logical_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_logical_arr subroutine ext_pio_get_dom_td_logical_sca(DataHandle,Element,DateStr,Data,Count,OutCount,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr logical ,intent(out) :: Data(:) integer ,intent(in) :: Count integer ,intent(out) :: OutCount integer ,intent(out) :: Status call ext_pio_get_var_td_logical_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status) return end subroutine ext_pio_get_dom_td_logical_sca subroutine ext_pio_get_dom_td_char_arr(DataHandle,Element,DateStr,Data,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(out) :: Data integer ,intent(out) :: Status call ext_pio_get_var_td_char_arr(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) return end subroutine ext_pio_get_dom_td_char_arr subroutine ext_pio_get_dom_td_char_sca(DataHandle,Element,DateStr,Data,Status) integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Element character*(*) ,intent(in) :: DateStr character*(*) ,intent(out) :: Data integer ,intent(out) :: Status call ext_pio_get_var_td_char_sca(DataHandle,Element,DateStr, & 'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status) return end subroutine ext_pio_get_dom_td_char_sca subroutine ext_pio_write_field(DataHandle,DateStr,Var,Field,FieldType,grid, & DomainDesc, MemoryOrdIn, Stagger, DimNames, & DomainStart, DomainEnd, MemoryStart, MemoryEnd, & PatchStart, PatchEnd, Status) use wrf_data_pio use pio_routines use module_domain implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var integer ,intent(inout) :: Field(*) integer ,intent(in) :: FieldType type(domain) :: grid integer ,intent(in) :: DomainDesc character*(*) ,intent(in) :: MemoryOrdIn character*(*) ,intent(in) :: Stagger character*(*) ,dimension(*) ,intent(in) :: DimNames integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd integer ,intent(out) :: Status character (3) :: MemoryOrder type(wrf_data_handle) ,pointer :: DH integer :: NDim character (VarNameLen) :: VarName character (3) :: MemO character (3) :: UCMemO integer ,dimension(NVarDims) :: Length_global integer ,dimension(NVarDims) :: Length integer ,dimension(NVarDims) :: VDimIDs character(80),dimension(NVarDims) :: RODimNames integer ,dimension(NVarDims) :: VStart integer ,dimension(NVarDims) :: VCount integer :: stat integer :: NVar integer :: i,j,n,fldsize integer :: XType character (80) :: NullName logical :: NotFound integer, dimension(1,1) :: tmp0dint integer, dimension(:,:,:), allocatable :: tmp2dint !Local, possibly adjusted, copies of MemoryStart and MemoryEnd MemoryOrder = trim(adjustl(MemoryOrdIn)) NullName=char(0) call GetDim(MemoryOrder,NDim,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning BAD MEMORY ORDER |',MemoryOrder,'| in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif !call pio_setdebuglevel(1) call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR |',DateStr,'| in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif VarName = Var call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif write(msg,*)'ext_pio_write_field: called for ',TRIM(Var) CALL wrf_debug( 100, msg ) VCount(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1 Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1 call ExtOrder(MemoryOrder,VCount,Status) call ExtOrder(MemoryOrder,Length_global,Status) call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status) if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then Status = WRF_WARN_WRITE_RONLY_FILE write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then do NVar=1,MaxVars if(DH%VarNames(NVar) == VarName ) then Status = WRF_WARN_2DRYRUNS_1VARIABLE write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE (',TRIM(VarName),') in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(DH%VarNames(NVar) == NO_NAME) then DH%VarNames(NVar) = VarName DH%NumVars = NVar DH%CurrentVariable= NVar exit elseif(NVar == MaxVars) then Status = WRF_WARN_TOO_MANY_VARIABLES write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo if(DH%Write)then DH%Write = .false. stat = pio_redef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif endif do j = 1,NDim VDimIDs(j) = 0 if(RODimNames(j) == NullName .or. RODimNames(j) == '') then do i=1,MaxDims if(DH%DimLengths(i) == Length_global(j)) then VDimIDs(j) = DH%DimIDs(i) exit elseif(DH%DimLengths(i) == NO_DIM) then DH%DimLengths(i) = Length_global(j) stat = pio_def_dim(DH%file_handle, DH%DimNames(i), DH%DimLengths(i), DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif VDimIDs(j) = DH%DimIDs(i) exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS (',i,') in (',TRIM(VarName),') ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo else !look for input name and check if already defined NotFound = .true. do i=1,MaxDims if (DH%DimNames(i) == RODimNames(j)) then if (DH%DimLengths(i) == Length_global(j)) then VDimIDs(j) = DH%DimIDs(i) NotFound = .false. exit else Status = WRF_WARN_DIMNAME_REDEFINED write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDEFINED by var ', & TRIM(Var),' ',DH%DimLengths(i),Length_global(j) ,' in ', __FILE__ ,' line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif endif enddo if (NotFound) then do i=1,MaxDims if (DH%DimLengths(i) == NO_DIM) then DH%DimNames(i) = RODimNames(j) DH%DimLengths(i) = Length_global(j) stat = pio_def_dim(DH%file_handle, DH%DimNames(i), DH%DimLengths(i), DH%DimIDs(i)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif VDimIDs(j) = DH%DimIDs(i) exit elseif(i == MaxDims) then Status = WRF_WARN_TOO_MANY_DIMS write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo endif endif DH%VarDimLens(j,DH%NumVars) = Length_global(j) enddo select case (FieldType) case (WRF_REAL) XType = PIO_REAL case (WRF_DOUBLE) Xtype = PIO_DOUBLE case (WRF_INTEGER) XType = PIO_INT case (WRF_LOGICAL) XType = PIO_INT case default Status = WRF_WARN_DATA_TYPE_NOT_FOUND write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return end select VDimIDs(NDim+1) = DH%DimUnlimID !write(unit=0, fmt='(/3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ !write(unit=0, fmt='(3a,i6)') '1 Define Var <', trim(Var), '> as NVar:', DH%NumVars stat = pio_def_var(DH%file_handle,VarName,XType,VDimIDs(1:NDim+1),DH%descVar(DH%NumVars)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'ext_pio_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif !write(unit=0, fmt='(3a,i6)') 'file: ', __FILE__, ', line: ', __LINE__ !write(unit=0, fmt='(a,i6)') 'DH%descVar(DH%NumVars)%VarID = ', DH%descVar(DH%NumVars)%VarID stat = pio_put_att(DH%file_handle,DH%descVar(DH%NumVars),'FieldType',FieldType) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'ext_pio_write_field: NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif call reorder(MemoryOrder,MemO) call uppercase(MemO,UCMemO) stat = pio_put_att(DH%file_handle,DH%descVar(DH%NumVars),'MemoryOrder',UCMemO) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'ext_pio_write_field: NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then if(.not. DH%Write) then DH%Write = .true. stat = pio_enddef(DH%file_handle) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error (',stat,') in file ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif endif do NVar=1,DH%NumVars if(DH%VarNames(NVar) == VarName) then DH%CurrentVariable = NVar exit elseif(NVar == DH%NumVars) then Status = WRF_WARN_VAR_NF write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo DH%vartype(DH%CurrentVariable) = NOT_LAND_SOIL_VAR fldsize = 1 do j=1,NDim if(Length_global(j) /= DH%VarDimLens(j,DH%CurrentVariable) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then Status = WRF_WARN_WRTLEN_NE_DRRUNLEN write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for |', & VarName,'| dim ',j,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) write(msg,*) ' LENGTH ',Length_global(j),' DRY RUN LENGTH ',DH%VarDimLens(j,DH%CurrentVariable) call wrf_debug ( WARN , TRIM(msg)) return elseif(PatchStart(j) < MemoryStart(j)) then Status = WRF_WARN_DIMENSION_ERROR write(msg,*) 'Warning DIMENSION ERROR for |',VarName, & '| in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo VStart = 1 VStart(1:NDim) = PatchStart(1:NDim) call ExtOrder(MemoryOrder,VStart,Status) do n = 1, NDim VDimIDs(n) = 0 do i=1,MaxDims if(DH%DimLengths(i) == Length_global(n)) then VDimIDs(n) = DH%DimIDs(i) exit end if end do Length(n) = MemoryEnd(n) - MemoryStart(n) + 1 fldsize = fldsize * Length(n) if("land_cat_stag" == DimNames(n)) then DH%vartype(DH%CurrentVariable) = LAND_CAT_VAR else if("soil_cat_stag" == DimNames(n)) then DH%vartype(DH%CurrentVariable) = SOIL_CAT_VAR else if("soil_layers_stag" == DimNames(n)) then DH%vartype(DH%CurrentVariable) = SOIL_LAYERS_VAR else if("num_ext_model_couple_dom_stag" == DimNames(n)) then DH%vartype(DH%CurrentVariable) = MDL_CPL_VAR else if("ensemble_stag" == DimNames(n)) then DH%vartype(DH%CurrentVariable) = ENSEMBLE_VAR endif end do #ifndef INTSPECIAL call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, & Stagger,FieldType,Field,Status) #else if(WRF_INTEGER == FieldType) then if(1 == fldsize) then tmp0dint(1,1) = Field(1) stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable),tmp0dint) call netcdf_err(stat,Status) else if(2 == Ndim) then allocate(tmp2dint(Length(1),Length(2),1), stat=Status) n = 0 do j=1,Length(2) do i=1,Length(1) n=n+1 tmp2dint(i,j,1) = Field(n) enddo enddo call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), & DH%iodesc2d_m_int, tmp2dint, Status) deallocate(tmp2dint) else call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, & Stagger,FieldType,Field,Status) endif else call FieldIO('write',DataHandle,DateStr,Length_global,VStart,VCount,Length,MemoryOrder, & Stagger,FieldType,Field,Status) end if #endif if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , TRIM(msg)) endif return end subroutine ext_pio_write_field subroutine ext_pio_read_field(DataHandle,DateStr,Var,Field,FieldType,grid, & DomainDesc, MemoryOrdIn, Stagger, DimNames, & DomainStart,DomainEnd,MemoryStart,MemoryEnd, & PatchStart,PatchEnd,Status) use wrf_data_pio use pio_routines use module_utility use module_domain implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: DateStr character*(*) ,intent(in) :: Var integer ,intent(out) :: Field(*) integer ,intent(in) :: FieldType type(domain) :: grid integer ,intent(in) :: DomainDesc character*(*) ,intent(in) :: MemoryOrdIn character*(*) ,intent(in) :: Stagger ! Dummy for now character*(*) , dimension (*) ,intent(in) :: DimNames integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd integer ,intent(out) :: Status character (3) :: MemoryOrder character(PIO_MAX_NAME) :: dimname type(wrf_data_handle) ,pointer :: DH integer :: NDim character (VarNameLen) :: VarName integer ,dimension(NVarDims) :: VCount integer ,dimension(NVarDims) :: VStart integer ,dimension(NVarDims) :: VDimen integer ,dimension(NVarDims) :: Length #if 0 integer ,dimension(NVarDims) :: StoredLen #endif integer ,dimension(NVarDims) :: VDimIDs integer ,dimension(NVarDims) :: MemS integer ,dimension(NVarDims) :: MemE integer :: NVar character (VarNameLen) :: Name integer :: XType integer :: StoredDim integer :: VarID integer :: NDims integer :: NAtts integer(KIND=PIO_OFFSET) :: Len integer :: stat integer :: i, j, n, fldsize integer :: FType logical :: isbdy integer, dimension(:,:,:), allocatable :: tmp2dint character (len=2) :: readinStagger MemoryOrder = trim(adjustl(MemoryOrdIn)) call GetDim(MemoryOrder,NDim,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning BAD MEMORY ORDER |',TRIM(MemoryOrder),'| for |', & TRIM(Var),'| in ext_pio_read_field ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR |',TRIM(DateStr),'| for |',TRIM(Var), & '| in ext_pio_read_field ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ext_pio_read_field ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif VarName = Var DH%CurrentVariable = DH%CurrentVariable + 1 DH%VarNames(DH%CurrentVariable) = VarName if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then RETURN elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then !call pio_seterrorhandling(DH%file_handle, PIO_BCAST_ERROR) stat = pio_inq_varid(DH%file_handle,VarName,DH%descVar(DH%CurrentVariable)) !call pio_seterrorhandling(DH%file_handle, PIO_INTERNAL_ERROR) !if(stat /= PIO_NOERR) then ! DH%descVar(DH%CurrentVariable)%varID = 0 ! write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname, ',Varname, ' not found in file.' ! call wrf_debug ( WARN , TRIM(msg)) ! return !endif call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inquire_variable(DH%file_handle,DH%descVar(DH%CurrentVariable), & Name,XType,StoredDim,VDimIDs,NAtts) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_get_att(DH%file_handle,DH%descVar(DH%CurrentVariable),'FieldType',FType) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif readinStagger = '' stat = pio_get_att(DH%file_handle,DH%descVar(DH%CurrentVariable),'stagger',readinStagger) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,' ','CHAR',', line', __LINE__ call wrf_debug ( WARN , msg) return endif !---allow coercion between double and single prec real if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then if ( .NOT. (Ftype == WRF_REAL .OR. Ftype == WRF_DOUBLE )) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif else if(FieldType /= Ftype) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif select case (FieldType) case (WRF_REAL) !allow coercion between double and single prec real if(.NOT. (XType == PIO_REAL .OR. XType == PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__ endif case (WRF_DOUBLE) !allow coercion between double and single prec real if(.NOT. (XType == PIO_REAL .OR. XType == PIO_DOUBLE) ) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__ endif case (WRF_INTEGER) if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__ endif case (WRF_LOGICAL) if(XType /= PIO_INT) then Status = WRF_WARN_TYPE_MISMATCH write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__ endif case default Status = WRF_WARN_DATA_TYPE_NOT_FOUND write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ end select if(Status /= WRF_NO_ERR) then call wrf_debug ( WARN , TRIM(msg)) return endif ! NDim=0 for scalars. Handle read of old NDim=1 files. TBH: 20060502 IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN stat = pio_inq_dimname(DH%file_handle,VDimIDs(1),dimname) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif IF ( dimname(1:10) == 'ext_scalar' ) THEN NDim = 1 VCount(1) = 1 ENDIF ENDIF if(StoredDim /= NDim+1) then Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_pio_read_field ',TRIM(Var),TRIM(DateStr) call wrf_debug ( FATAL , msg) write(msg,*) ' StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1 call wrf_debug ( FATAL , msg) return endif #if 0 do n=1,NDim stat = pio_inq_dimlen(DH%file_handle,VDimIDs(n),StoredLen(n)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(VCount(n) > StoredLen(n)) then Status = WRF_WARN_READ_PAST_EOF write(msg,*) 'Warning READ PAST EOF in ext_pio_read_field of ',TRIM(Var),VCount(n),'>',StoredLen(n) call wrf_debug ( WARN , TRIM(msg)) return elseif(VCount(n) <= 0) then Status = WRF_WARN_ZERO_LENGTH_READ write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo #endif !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__ !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ', DH%CurrentVariable, ', name: ', trim(VarName) VStart(1:NDim) = PatchStart(1:NDim) VCount(1:NDim) = PatchEnd(1:NDim) - PatchStart(1:NDim) + 1 VDimen(1:NDim) = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1 !do n = 1, NDim ! write(unit=0, fmt='(4x,8(a,i2,a,i6))') & ! 'DomainStart(', n, ')=', DomainStart(n), ', DomainEnd(', n, ')=', DomainEnd(n), & ! ', MemoryStart(', n, ')=', MemoryStart(n), ', MemoryEnd(', n, ')=', MemoryEnd(n), & ! ', PatchStart(', n, ')=', PatchStart(n), ', PatchEnd(', n, ')=', PatchEnd(n), & ! ', VStart(', n, ')=', VStart(n), ', VCount(', n, ')=', VCount(n) !end do call ExtOrder(MemoryOrder,VStart,Status) call ExtOrder(MemoryOrder,VCount,Status) call ExtOrder(MemoryOrder,VDimen,Status) DH%vartype(DH%CurrentVariable) = NOT_LAND_SOIL_VAR fldsize = 1 do n = 1, NDim Length(n) = MemoryEnd(n) - MemoryStart(n) + 1 fldsize = fldsize * Length(n) !write(unit=0, fmt='(4x,2(a,i2,a,i6))') & ! 'VStart(', n, ')=', VStart(n), ', VCount(', n, ')=', VCount(n) if("land_cat_stag" == DH%DimNames(VDimIDs(n))) then DH%vartype(DH%CurrentVariable) = LAND_CAT_VAR else if("soil_cat_stag" == DH%DimNames(VDimIDs(n))) then DH%vartype(DH%CurrentVariable) = SOIL_CAT_VAR else if("soil_layers_stag" == DH%DimNames(VDimIDs(n))) then DH%vartype(DH%CurrentVariable) = SOIL_LAYERS_VAR else if("num_ext_model_couple_dom_stag" == DH%DimNames(VDimIDs(n))) then DH%vartype(DH%CurrentVariable) = MDL_CPL_VAR else if("ensemble_stag" == DH%DimNames(VDimIDs(n))) then DH%vartype(DH%CurrentVariable) = ENSEMBLE_VAR endif end do #ifndef INTSPECIAL isbdy = is_boundary(MemoryOrder) if(isbdy) then !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__ !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ', !DH%CurrentVariable, ', name: ', trim(VarName) call FieldBDY('read',DataHandle,DateStr,NDim,VDimen, & MemoryStart,MemoryEnd,PatchStart,PatchEnd, & FieldType,Field,Status) else !if((WRF_INTEGER == FieldType) .and. (1 == fldsize)) then ! Status = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),VCount(1:1)) ! Field(1) = VCount(1) !else call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, & readinStagger,FieldType,Field,Status) !endif endif #else if(WRF_INTEGER == FieldType) then if(1 == fldsize) then Status = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),VCount(1:1)) Field(1) = VCount(1) else if(2 == Ndim) then allocate(tmp2dint(Length(1),Length(2),1), stat=Status) call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), & DH%iodesc2d_m_int, tmp2dint, Status) ! DH%ioVar(DH%CurrentVariable), tmp2dint, Status) n = 0 do j=1,Length(2) do i=1,Length(1) n=n+1 Field(n) = tmp2dint(i,j,1) enddo enddo deallocate(tmp2dint) else call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, & readinStagger,FieldType,Field,Status) endif else isbdy = is_boundary(MemoryOrder) if(isbdy) then !write(unit=0, fmt='(//3a,i6)') 'file: ',__FILE__,', line', __LINE__ !write(unit=0, fmt='(4x,a,i6,2a)') 'DH%CurrentVariable = ', DH%CurrentVariable, ', name: ', trim(VarName) call FieldBDY('read',DataHandle,DateStr,NDim,VDimen, & MemoryStart,MemoryEnd,PatchStart,PatchEnd, & FieldType,Field,Status) else call FieldIO('read',DataHandle,DateStr,VDimen,VStart,VCount,Length,MemoryOrder, & readinStagger,FieldType,Field,Status) endif endif #endif else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_read_field subroutine ext_pio_inquire_opened( DataHandle, FileName , FileStatus, Status ) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(inout) :: FileName integer ,intent(out) :: FileStatus integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH call upgrade_filename(FileName) !call upgrade_filename(DH%FileName) call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then FileStatus = WRF_FILE_NOT_OPENED return endif if(trim(FileName) /= trim(DH%FileName)) then FileStatus = WRF_FILE_NOT_OPENED else FileStatus = DH%FileStatus endif Status = WRF_NO_ERR return end subroutine ext_pio_inquire_opened subroutine ext_pio_inquire_filename( Datahandle, FileName, FileStatus, Status ) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(out) :: FileName integer ,intent(out) :: FileStatus integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH FileStatus = WRF_FILE_NOT_OPENED call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif FileName = trim(DH%FileName) !call upgrade_filename(FileName) FileStatus = DH%FileStatus Status = WRF_NO_ERR return end subroutine ext_pio_inquire_filename subroutine ext_pio_set_time(DataHandle, DateStr, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: DateStr integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: i call DateCheck(DateStr,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_FILE_NOT_COMMITTED write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then do i=1,MaxTimes if(DH%Times(i)==DateStr) then DH%CurrentTime = i exit endif if(i==MaxTimes) then Status = WRF_WARN_TIME_NF return endif enddo DH%CurrentVariable = 0 Status = WRF_NO_ERR else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_set_time subroutine ext_pio_get_next_time(DataHandle, DateStr, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(out) :: DateStr integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then if(DH%CurrentTime >= DH%NumberTimes) then write(msg,*) 'Warning ext_pio_get_next_time: DH%CurrentTime >= DH%NumberTimes ',DH%CurrentTime,DH%NumberTimes call wrf_debug ( WARN , TRIM(msg)) Status = WRF_WARN_TIME_EOF return endif DH%CurrentTime = DH%CurrentTime +1 DateStr = DH%Times(DH%CurrentTime) DH%CurrentVariable = 0 Status = WRF_NO_ERR else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_next_time subroutine ext_pio_get_previous_time(DataHandle, DateStr, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(out) :: DateStr integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then if(DH%CurrentTime.GT.0) then DH%CurrentTime = DH%CurrentTime -1 endif DateStr = DH%Times(DH%CurrentTime) DH%CurrentVariable = 0 Status = WRF_NO_ERR else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_previous_time subroutine ext_pio_get_next_var(DataHandle, VarName, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(out) :: VarName integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat character (80) :: Name call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then DH%CurrentVariable = DH%CurrentVariable +1 if(DH%CurrentVariable > DH%NumVars) then Status = WRF_WARN_VAR_EOF return endif VarName = DH%VarNames(DH%CurrentVariable) Status = WRF_NO_ERR else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_next_var subroutine ext_pio_end_of_frame(DataHandle, Status) use pio_kinds use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH call GetDH(DataHandle,DH,Status) return end subroutine ext_pio_end_of_frame ! NOTE: For scalar variables NDim is set to zero and DomainStart and ! NOTE: DomainEnd are left unmodified. subroutine ext_pio_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle character*(*) ,intent(in) :: Name integer ,intent(out) :: NDim character*(*) ,intent(out) :: MemoryOrder character*(*) :: Stagger ! Dummy for now integer ,dimension(*) ,intent(out) :: DomainStart, DomainEnd integer ,intent(out) :: WrfType integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: VarID integer ,dimension(NVarDims) :: VDimIDs integer :: j integer :: stat integer :: XType call GetDH(DataHandle,DH,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif if(DH%FileStatus == WRF_FILE_NOT_OPENED) then Status = WRF_WARN_FILE_NOT_OPENED write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then Status = WRF_WARN_DRYRUN_READ write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then Status = WRF_WARN_READ_WONLY_FILE write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then stat = pio_inq_varid(DH%file_handle,Name,VarID) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_vartype(DH%file_handle,VarID,XType) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_get_att(DH%file_handle,VarID,'FieldType',WrfType) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif select case (XType) !case (PIO_BYTE) ! Status = WRF_WARN_BAD_DATA_TYPE ! write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ ! call wrf_debug ( WARN , TRIM(msg)) ! return case (PIO_CHAR) Status = WRF_WARN_BAD_DATA_TYPE write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return !case (PIO_SHORT) ! Status = WRF_WARN_BAD_DATA_TYPE ! write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__ ! call wrf_debug ( WARN , TRIM(msg)) ! return case (PIO_INT) if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then Status = WRF_WARN_BAD_DATA_TYPE write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif case (PIO_REAL) if(WrfType /= WRF_REAL) then Status = WRF_WARN_BAD_DATA_TYPE write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif case (PIO_DOUBLE) if(WrfType /= WRF_DOUBLE) then Status = WRF_WARN_BAD_DATA_TYPE write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif case default Status = WRF_WARN_DATA_TYPE_NOT_FOUND write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return end select stat = pio_get_att(DH%file_handle,VarID,'MemoryOrder',MemoryOrder) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif call GetDim(MemoryOrder,NDim,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif stat = pio_inq_vardimid(DH%file_handle,VarID,VDimIDs) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif do j = 1, NDim DomainStart(j) = 1 stat = pio_inq_dimlen(DH%file_handle,VDimIDs(j),DomainEnd(j)) call netcdf_err(stat,Status) if(Status /= WRF_NO_ERR) then write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__ call wrf_debug ( WARN , TRIM(msg)) return endif enddo else Status = WRF_ERR_FATAL_BAD_FILE_STATUS write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ call wrf_debug ( FATAL , msg) endif return end subroutine ext_pio_get_var_info subroutine ext_pio_warning_str( Code, ReturnString, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer , intent(in) ::Code character *(*), intent(out) :: ReturnString integer, intent(out) ::Status SELECT CASE (Code) CASE (0) ReturnString='No error' Status=WRF_NO_ERR return CASE (-1) ReturnString= 'File not found (or file is incomplete)' Status=WRF_NO_ERR return CASE (-2) ReturnString='Metadata not found' Status=WRF_NO_ERR return CASE (-3) ReturnString= 'Timestamp not found' Status=WRF_NO_ERR return CASE (-4) ReturnString= 'No more timestamps' Status=WRF_NO_ERR return CASE (-5) ReturnString= 'Variable not found' Status=WRF_NO_ERR return CASE (-6) ReturnString= 'No more variables for the current time' Status=WRF_NO_ERR return CASE (-7) ReturnString= 'Too many open files' Status=WRF_NO_ERR return CASE (-8) ReturnString= 'Data type mismatch' Status=WRF_NO_ERR return CASE (-9) ReturnString= 'Attempt to write read-only file' Status=WRF_NO_ERR return CASE (-10) ReturnString= 'Attempt to read write-only file' Status=WRF_NO_ERR return CASE (-11) ReturnString= 'Attempt to access unopened file' Status=WRF_NO_ERR return CASE (-12) ReturnString= 'Attempt to do 2 trainings for 1 variable' Status=WRF_NO_ERR return CASE (-13) ReturnString= 'Attempt to read past EOF' Status=WRF_NO_ERR return CASE (-14) ReturnString= 'Bad data handle' Status=WRF_NO_ERR return CASE (-15) ReturnString= 'Write length not equal to training length' Status=WRF_NO_ERR return CASE (-16) ReturnString= 'More dimensions requested than training' Status=WRF_NO_ERR return CASE (-17) ReturnString= 'Attempt to read more data than exists' Status=WRF_NO_ERR return CASE (-18) ReturnString= 'Input dimensions inconsistent' Status=WRF_NO_ERR return CASE (-19) ReturnString= 'Input MemoryOrder not recognized' Status=WRF_NO_ERR return CASE (-20) ReturnString= 'A dimension name with 2 different lengths' Status=WRF_NO_ERR return CASE (-21) ReturnString= 'String longer than provided storage' Status=WRF_NO_ERR return CASE (-22) ReturnString= 'Function not supportable' Status=WRF_NO_ERR return CASE (-23) ReturnString= 'Package implements this routine as NOOP' Status=WRF_NO_ERR return !netcdf-specific warning messages CASE (-1007) ReturnString= 'Bad data type' Status=WRF_NO_ERR return CASE (-1008) ReturnString= 'File not committed' Status=WRF_NO_ERR return CASE (-1009) ReturnString= 'File is opened for reading' Status=WRF_NO_ERR return CASE (-1011) ReturnString= 'Attempt to write metadata after open commit' Status=WRF_NO_ERR return CASE (-1010) ReturnString= 'I/O not initialized' Status=WRF_NO_ERR return CASE (-1012) ReturnString= 'Too many variables requested' Status=WRF_NO_ERR return CASE (-1013) ReturnString= 'Attempt to close file during a dry run' Status=WRF_NO_ERR return CASE (-1014) ReturnString= 'Date string not 19 characters in length' Status=WRF_NO_ERR return CASE (-1015) ReturnString= 'Attempt to read zero length words' Status=WRF_NO_ERR return CASE (-1016) ReturnString= 'Data type not found' Status=WRF_NO_ERR return CASE (-1017) ReturnString= 'Badly formatted date string' Status=WRF_NO_ERR return CASE (-1018) ReturnString= 'Attempt at read during a dry run' Status=WRF_NO_ERR return CASE (-1019) ReturnString= 'Attempt to get zero words' Status=WRF_NO_ERR return CASE (-1020) ReturnString= 'Attempt to put zero length words' Status=WRF_NO_ERR return CASE (-1021) ReturnString= 'NetCDF error' Status=WRF_NO_ERR return CASE (-1022) ReturnString= 'Requested length <= 1' Status=WRF_NO_ERR return CASE (-1023) ReturnString= 'More data available than requested' Status=WRF_NO_ERR return CASE (-1024) ReturnString= 'New date less than previous date' Status=WRF_NO_ERR return CASE DEFAULT ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. & & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & & to be calling a package-specific routine to return a message for this warning code.' Status=WRF_NO_ERR END SELECT return end subroutine ext_pio_warning_str !returns message string for all WRF and netCDF warning/error status codes !Other i/o packages must provide their own routines to return their own status messages subroutine ext_pio_error_str( Code, ReturnString, Status) use wrf_data_pio use pio_routines implicit none include 'wrf_status_codes.h' integer , intent(in) ::Code character *(*), intent(out) :: ReturnString integer, intent(out) ::Status SELECT CASE (Code) CASE (-100) ReturnString= 'Allocation Error' Status=WRF_NO_ERR return CASE (-101) ReturnString= 'Deallocation Error' Status=WRF_NO_ERR return CASE (-102) ReturnString= 'Bad File Status' Status=WRF_NO_ERR return CASE (-1004) ReturnString= 'Variable on disk is not 3D' Status=WRF_NO_ERR return CASE (-1005) ReturnString= 'Metadata on disk is not 1D' Status=WRF_NO_ERR return CASE (-1006) ReturnString= 'Time dimension too small' Status=WRF_NO_ERR return CASE DEFAULT ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. & & Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need & & to be calling a package-specific routine to return a message for this error code.' Status=WRF_NO_ERR END SELECT return end subroutine ext_pio_error_str subroutine ext_pio_end_independent_mode(DataHandle, Status) use wrf_data_pio use pio_routines include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat DH => WrfDataHandles(DataHandle) return end subroutine ext_pio_end_independent_mode subroutine ext_pio_start_independent_mode(DataHandle, Status) use wrf_data_pio use pio_routines include 'wrf_status_codes.h' integer ,intent(in) :: DataHandle integer ,intent(out) :: Status type(wrf_data_handle) ,pointer :: DH integer :: stat DH => WrfDataHandles(DataHandle) return end subroutine ext_pio_start_independent_mode