external/io_pio/field_routines.F90

   1 !------------------------------------------------------------------
   2 !$Id$
   3 !------------------------------------------------------------------
   4
   5 subroutine ext_pio_RealFieldIO(whole,IO,DH,Starts,Counts,fldsize,datasize,Data,Status)
   6   use pio
   7   use pio_kinds
   8   use wrf_data_pio
   9   use pio_routines
  10   implicit none
  11   include 'wrf_status_codes.h'
  12   logical                     ,intent(in)    :: whole
  13   character (*)               ,intent(in)    :: IO
  14   type(wrf_data_handle)                      :: DH
  15   integer,dimension(NVarDims) ,intent(in)    :: Starts
  16   integer,dimension(NVarDims) ,intent(in)    :: Counts
  17   integer                     ,intent(in)    :: fldsize, datasize
  18   real, dimension(1:fldsize)  ,intent(inout) :: Data
  19   integer                     ,intent(out)   :: Status
  20   integer                                    :: stat
  21   real, parameter                            :: fillvalue = 9.96921e+36
  22
  23   if(IO == 'write') then
  24     if(whole)then
  25        stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable), &
  26                           Starts,Counts,Data(1:datasize))
  27     else
  28       call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
  29                             DH%ioVar(DH%CurrentVariable), Data, stat, fillvalue)
  30     end if
  31   else
  32     if(whole)then
  33       stat = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),Data(1:datasize))
  34     else
  35       call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
  36                            DH%ioVar(DH%CurrentVariable), Data, stat)
  37     end if
  38   endif
  39   call netcdf_err(stat,Status)
  40   if(Status /= WRF_NO_ERR) then
  41     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
  42     call wrf_debug ( WARN , msg)
  43   endif
  44
  45   return
  46 end subroutine ext_pio_RealFieldIO
  47
  48 subroutine ext_pio_DoubleFieldIO(whole,IO,DH,Starts,Counts,fldsize,datasize,Data,Status)
  49   use pio
  50   use pio_kinds
  51   use wrf_data_pio
  52   use pio_routines
  53   implicit none
  54   include 'wrf_status_codes.h'
  55   logical                     ,intent(in)    :: whole
  56   character (*)               ,intent(in)    :: IO
  57   type(wrf_data_handle)       ,pointer       :: DH
  58   integer,dimension(NVarDims) ,intent(in)    :: Starts
  59   integer,dimension(NVarDims) ,intent(in)    :: Counts
  60   integer                     ,intent(in)    :: fldsize, datasize
  61   real*8,dimension(1:fldsize), intent(inout) :: Data
  62   integer                     ,intent(out)   :: Status
  63   integer                                    :: stat
  64
  65   if(IO == 'write') then
  66     if(whole)then
  67       stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable), &
  68                          Starts,Counts,Data(1:datasize))
  69     else
  70       call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
  71                             DH%ioVar(DH%CurrentVariable), Data, stat)
  72     end if
  73   else
  74     if(whole)then
  75       stat = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),Data)
  76     else
  77       call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
  78                            DH%ioVar(DH%CurrentVariable), Data, stat)
  79     end if
  80   endif
  81   call netcdf_err(stat,Status)
  82   if(Status /= WRF_NO_ERR) then
  83     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
  84     call wrf_debug ( WARN , msg)
  85   endif
  86   return
  87 end subroutine ext_pio_DoubleFieldIO
  88
  89 subroutine ext_pio_IntFieldIO(whole,IO,DH,Starts,Counts,fldsize,datasize,Data,Status)
  90   use pio
  91   use pio_kinds
  92   use wrf_data_pio
  93   use pio_routines
  94   implicit none
  95   include 'wrf_status_codes.h'
  96   logical                     ,intent(in)    :: whole
  97   character (*)               ,intent(in)    :: IO
  98   type(wrf_data_handle)       ,pointer       :: DH
  99   integer,dimension(NVarDims) ,intent(in)    :: Starts
 100   integer,dimension(NVarDims) ,intent(in)    :: Counts
 101   integer                     ,intent(in)    :: fldsize, datasize
 102   integer,dimension(1:fldsize),intent(inout) :: Data
 103   integer                     ,intent(out)   :: Status
 104   integer                                    :: stat
 105   integer, parameter                         :: fillvalue = 20140822
 106   integer                                    :: Buffer(1)
 107
 108  !call pio_setdebuglevel(1)
 109
 110   if(IO == 'write') then
 111     if(whole)then
 112       stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable), &
 113                          Starts,Counts,Data(1:datasize))
 114     else
 115       call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
 116                             DH%ioVar(DH%CurrentVariable), Data, stat, fillvalue)
 117     end if
 118   else
 119     if(whole)then
 120       if(1 == fldsize) then
 121         stat = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),Buffer)
 122         Data(1) = Buffer(1)
 123       else
 124         stat = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),Data)
 125       endif
 126     else
 127       call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
 128                            DH%ioVar(DH%CurrentVariable), Data, stat)
 129     end if
 130   endif
 131   call netcdf_err(stat,Status)
 132   if(Status /= WRF_NO_ERR) then
 133     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 134     call wrf_debug ( WARN , msg)
 135   endif
 136   return
 137 end subroutine ext_pio_IntFieldIO
 138
 139 subroutine ext_pio_LogicalFieldIO(whole,IO,DH,Starts,Counts,fldsize,datasize,Data,Status)
 140   use pio
 141   use pio_kinds
 142   use wrf_data_pio
 143   use pio_routines
 144   implicit none
 145   include 'wrf_status_codes.h'
 146   logical                     ,intent(in)    :: whole
 147   character (*)               ,intent(in)    :: IO
 148   type(wrf_data_handle)       ,pointer       :: DH
 149   integer,dimension(NVarDims) ,intent(in)    :: Starts
 150   integer,dimension(NVarDims) ,intent(in)    :: Counts
 151   integer                     ,intent(in)    :: fldsize, datasize
 152   logical,dimension(1:fldsize),intent(inout) :: Data
 153   integer                     ,intent(out)   :: Status
 154   integer,dimension(1:fldsize)               :: Buffer
 155   integer                                    :: stat
 156   integer                                    :: n
 157
 158   if(IO == 'write') then
 159     do n=1,fldsize
 160       if(data(n)) then
 161         Buffer(n)=1
 162       else
 163         Buffer(n)=0
 164       endif
 165     enddo
 166     if(whole)then
 167       stat = pio_put_var(DH%file_handle,DH%descVar(DH%CurrentVariable), &
 168                          Starts,Counts,Buffer(1:datasize))
 169     else
 170       call pio_write_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
 171                             DH%ioVar(DH%CurrentVariable), Buffer, stat)
 172     end if
 173   else
 174     if(whole)then
 175       stat = pio_get_var(DH%file_handle,DH%descVar(DH%CurrentVariable),Buffer)
 176     else
 177       call pio_read_darray(DH%file_handle, DH%descVar(DH%CurrentVariable), &
 178                            DH%ioVar(DH%CurrentVariable), Buffer, stat)
 179     end if
 180     Data = Buffer == 1
 181   endif
 182   call netcdf_err(stat,Status)
 183   if(Status /= WRF_NO_ERR) then
 184     write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
 185     call wrf_debug ( WARN , msg)
 186     return
 187   endif
 188   return
 189 end subroutine ext_pio_LogicalFieldIO
 190