external/io_adios2/ext_adios2_get_var_ti.code

   1 !*----------------------------------------------------------------------------
   2 !*
   3 !*  WRF ADIOS2 I/O
   4 !*  Author: Michael Laufer
   5 !*          Toga Networks, a Huawei Company
   6 !*          michael.laufer@toganetworks.com
   7 !*  Author: Erick Fredj
   8 !*          Computer Science Department, The Jerusalem College of Technology
   9 !*          fredj@jct.ac.il
  10 !*          Toga Networks, a Huawei Company
  11 !*          erick.fredj@toganetworks.com
  12 !*
  13 !*  Date:    November 3, 2021
  14 !*
  15 !*----------------------------------------------------------------------------
  16
  17   use wrf_data_adios2
  18   use ext_adios2_support_routines
  19   use adios2
  20   implicit none
  21   include 'wrf_status_codes.h'
  22   integer               ,intent(in)     :: DataHandle
  23   character*(*)         ,intent(in)     :: Element
  24   character*(*)         ,intent(in)     :: Var
  25   TYPE_COUNT
  26   TYPE_DATA
  27   TYPE_OUTCOUNT
  28   integer               ,intent(out)    :: Status
  29   type(wrf_data_handle) ,pointer        :: DH
  30   integer                               :: XLen
  31   TYPE_BUFFER
  32   character (VarNameLen)                :: VarName
  33   integer                               :: stat
  34   integer                               :: NVar
  35   integer                               :: XType
  36   type(adios2_attribute)                :: AttributeID
  37
  38   if(Count <= 0) then
  39     Status = WRF_WARN_ZERO_LENGTH_GET
  40     write(msg,*) &
  41 'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  42     call wrf_debug ( WARN , msg)
  43     return
  44   endif
  45   VarName = Var
  46   call GetDH(DataHandle,DH,Status)
  47   if(Status /= WRF_NO_ERR) then
  48     write(msg,*) &
  49 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  50     call wrf_debug ( WARN , msg)
  51     return
  52   endif
  53   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
  54     Status = WRF_WARN_FILE_NOT_OPENED
  55     write(msg,*) &
  56 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  57     call wrf_debug ( WARN , msg)
  58   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
  59     Status = WRF_WARN_DRYRUN_READ
  60     write(msg,*) &
  61 'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  62     call wrf_debug ( WARN , msg)
  63   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
  64     Status = WRF_WARN_READ_WONLY_FILE
  65     write(msg,*) &
  66 'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  67     call wrf_debug ( WARN , msg)
  68   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
  69     do NVar=1,DH%NumVars
  70       if(DH%VarNames(NVar) == VarName) then
  71         exit
  72       elseif(NVar == DH%NumVars) then
  73         Status = WRF_WARN_VAR_NF
  74         write(msg,*) &
  75 'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  76         call wrf_debug ( WARN , msg)
  77         return
  78       endif
  79     enddo
  80     call adios2_inquire_variable_attribute(AttributeID, DH%adios2IO, trim(Element), VarName, '/', stat )
  81     call adios2_err(stat,Status)
  82       if(Status /= WRF_NO_ERR) then
  83         write(msg,*) 'adios2 error in ext_adios2_get_var_ti',__FILE__,', line', __LINE__
  84         call wrf_debug ( WARN , TRIM(msg))
  85         return
  86     endif
  87     XLen = AttributeID%length
  88 #ifndef CHAR_TYPE
  89     allocate(Buffer(XLen), STAT=stat)
  90     if(stat/= 0) then
  91       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
  92       write(msg,*) &
  93 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  94       call wrf_debug ( FATAL , msg)
  95       return
  96     endif
  97     call adios2_attribute_data(Buffer, AttributeID, stat)
  98 #else
  99     Data = ''
 100     call adios2_attribute_data(Data, AttributeID, stat)
 101 #endif
 102     call adios2_err(stat,Status)
 103       if(Status /= WRF_NO_ERR) then
 104         write(msg,*) 'adios2 error in ext_adios2_get_var_ti',__FILE__,', line', __LINE__
 105         call wrf_debug ( WARN , TRIM(msg))
 106         return
 107     endif
 108     COPY
 109 #ifndef CHAR_TYPE
 110     deallocate(Buffer, STAT=stat)
 111     if(stat/= 0) then
 112       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
 113       write(msg,*) &
 114 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 115       call wrf_debug ( FATAL , msg)
 116       return
 117     endif
 118     if(XLen > Count) then
 119       OutCount = Count
 120       Status   = WRF_WARN_MORE_DATA_IN_FILE
 121     else
 122       OutCount = XLen
 123       Status   = WRF_NO_ERR
 124     endif
 125 #endif
 126   else
 127     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 128     write(msg,*) &
 129 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 130     call wrf_debug ( FATAL , msg)
 131     return
 132   endif
 133   return