!*------------------------------------------------------------------------------
!* Standard Disclaimer
!*
!* Forecast Systems Laboratory
!* NOAA/OAR/ERL/FSL
!* 325 Broadway
!* Boulder, CO 80303
!*
!* AVIATION DIVISION
!* ADVANCED COMPUTING BRANCH
!* SMS/NNT Version: 2.0.0
!*
!* This software and its documentation are in the public domain and
!* are furnished "as is". The United States government, its
!* instrumentalities, officers, employees, and agents make no
!* warranty, express or implied, as to the usefulness of the software
!* and documentation for any purpose. They assume no
!* responsibility (1) for the use of the software and documentation;
!* or (2) to provide technical support to users.
!*
!* Permission to use, copy, modify, and distribute this software is
!* hereby granted, provided that this disclaimer notice appears in
!* all copies. All modifications to this software must be clearly
!* documented, and are solely the responsibility of the agent making
!* the modification. If significant modifications or enhancements
!* are made to this software, the SMS Development team
!* (sms-info@fsl.noaa.gov) should be notified.
!*
!*----------------------------------------------------------------------------
!*
!* WRF NetCDF I/O
! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov
!* Date: October 6, 2000
!*
!*----------------------------------------------------------------------------
subroutine ext_ncd_RealFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) 1,4
use wrf_data
use ext_ncd_support_routines
implicit none
include 'wrf_status_codes.h'
include 'netcdf.inc'
character (*) ,intent(in) :: IO
integer ,intent(in) :: NCID
integer ,intent(in) :: VarID
integer ,dimension(NVarDims),intent(in) :: VStart
integer ,dimension(NVarDims),intent(in) :: VCount
real, dimension(*) ,intent(inout) :: Data
integer ,intent(out) :: Status
integer :: stat
if(IO == 'write') then
stat = NF_PUT_VARA_REAL(NCID,VarID,VStart,VCount,Data)
else
stat = NF_GET_VARA_REAL(NCID,VarID,VStart,VCount,Data)
endif
call netcdf_err
(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
call wrf_debug
( WARN , msg)
endif
return
end subroutine ext_ncd_RealFieldIO
subroutine ext_ncd_DoubleFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) 1,4
use wrf_data
use ext_ncd_support_routines
implicit none
include 'wrf_status_codes.h'
include 'netcdf.inc'
character (*) ,intent(in) :: IO
integer ,intent(in) :: NCID
integer ,intent(in) :: VarID
integer ,dimension(NVarDims),intent(in) :: VStart
integer ,dimension(NVarDims),intent(in) :: VCount
real*8 ,intent(inout) :: Data
integer ,intent(out) :: Status
integer :: stat
if(IO == 'write') then
stat = NF_PUT_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
else
stat = NF_GET_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
endif
call netcdf_err
(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
call wrf_debug
( WARN , msg)
endif
return
end subroutine ext_ncd_DoubleFieldIO
subroutine ext_ncd_IntFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) 1,4
use wrf_data
use ext_ncd_support_routines
implicit none
include 'wrf_status_codes.h'
include 'netcdf.inc'
character (*) ,intent(in) :: IO
integer ,intent(in) :: NCID
integer ,intent(in) :: VarID
integer ,dimension(NVarDims),intent(in) :: VStart
integer ,dimension(NVarDims),intent(in) :: VCount
integer ,intent(inout) :: Data
integer ,intent(out) :: Status
integer :: stat
if(IO == 'write') then
stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Data)
else
stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Data)
endif
call netcdf_err
(stat,Status)
if(Status /= WRF_NO_ERR) then
write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
call wrf_debug
( WARN , msg)
endif
return
end subroutine ext_ncd_IntFieldIO
subroutine ext_ncd_LogicalFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status) 1,6
use wrf_data
use ext_ncd_support_routines
implicit none
include 'wrf_status_codes.h'
include 'netcdf.inc'
character (*) ,intent(in) :: IO
integer ,intent(in) :: NCID
integer ,intent(in) :: VarID
integer,dimension(NVarDims) ,intent(in) :: VStart
integer,dimension(NVarDims) ,intent(in) :: VCount
logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data
integer ,intent(out) :: Status
integer,dimension(:,:,:),allocatable :: Buffer
integer :: stat
integer :: i,j,k
allocate(Buffer(VCount(1),VCount(2),VCount(3)), 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
if(IO == 'write') then
do k=1,VCount(3)
do j=1,VCount(2)
do i=1,VCount(1)
if(data(i,j,k)) then
Buffer(i,j,k)=1
else
Buffer(i,j,k)=0
endif
enddo
enddo
enddo
stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
else
stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
Data = Buffer == 1
endif
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
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
return
end subroutine ext_ncd_LogicalFieldIO