external/io_adios2/ext_adios2_get_dom_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   TYPE_COUNT
  25   TYPE_DATA
  26   TYPE_OUTCOUNT
  27   integer               ,intent(out)    :: Status
  28   type(wrf_data_handle) ,pointer        :: DH
  29   integer                               :: XType
  30   integer                               :: Len
  31   integer                               :: stat
  32   type(adios2_attribute)                :: attribute
  33   TYPE_BUFFER
  34
  35   call GetDH(DataHandle,DH,Status)
  36   if(Status /= WRF_NO_ERR) then
  37     write(msg,*) &
  38 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  39     call wrf_debug ( WARN , msg)
  40     return
  41   endif
  42 ! Do nothing unless it is time to read time-independent domain metadata.
  43 IF ( adios2_ok_to_get_dom_ti( DataHandle ) ) THEN
  44   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
  45     Status = WRF_WARN_FILE_NOT_OPENED
  46     write(msg,*) &
  47 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  48     call wrf_debug ( WARN , msg)
  49   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
  50     Status = WRF_WARN_DRYRUN_READ
  51     write(msg,*) &
  52 'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  53     call wrf_debug ( WARN , msg)
  54   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
  55     Status = WRF_WARN_READ_WONLY_FILE
  56     write(msg,*) &
  57 'Warning READ WRITE ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  58     call wrf_debug ( WARN , msg)
  59   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
  60     call adios2_inquire_attribute(attribute, DH%adios2IO, Element, stat)
  61     call adios2_err(stat,Status)
  62       if(Status /= WRF_NO_ERR) then
  63         write(msg,*) 'adios2 error in ext_adios2_get_dom_ti',__FILE__,', line', __LINE__
  64         call wrf_debug ( WARN , TRIM(msg))
  65         return
  66     endif
  67     Len = attribute%length
  68 #ifndef CHAR_TYPE
  69     allocate(Buffer(Len), STAT=stat)
  70     if(stat/= 0) then
  71       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
  72       write(msg,*) &
  73 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  74       call wrf_debug ( FATAL , msg)
  75       return
  76     endif
  77     call adios2_attribute_data(Buffer, attribute, stat)
  78 #else
  79     Data = ''
  80     call adios2_attribute_data(Data, attribute, stat)
  81 #endif
  82     call adios2_err(stat,Status)
  83       if(Status /= WRF_NO_ERR) then
  84         write(msg,*) 'adios2 error in ext_adios2_get_dom_ti',__FILE__,', line', __LINE__
  85         call wrf_debug ( WARN , TRIM(msg))
  86         return
  87     endif
  88 #ifndef CHAR_TYPE
  89     COPY
  90     deallocate(Buffer, STAT=stat)
  91     if(stat/= WRF_NO_ERR) then
  92       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
  93       write(msg,*) &
  94 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  95       call wrf_debug ( FATAL , msg)
  96       return
  97     endif
  98     if(Len > Count) then
  99       OutCount = Count
 100       Status = WRF_WARN_MORE_DATA_IN_FILE
 101     else
 102       OutCount = Len
 103       Status = WRF_NO_ERR
 104     endif
 105 #endif
 106   else
 107     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 108     write(msg,*) &
 109 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 110     call wrf_debug ( FATAL , msg)
 111   endif
 112 ENDIF
 113   return