external/io_adios2/ext_adios2_put_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   integer               ,intent(out)    :: Status
  28   type(wrf_data_handle) ,pointer        :: DH
  29   character(31)                         :: VarName
  30   integer                               :: stat
  31   integer               ,allocatable    :: Buffer(:)
  32   integer                               :: i
  33   integer                               :: NVar
  34   character*1                           :: null
  35   type(adios2_attribute)                :: AttributeID
  36
  37   null=char(0)
  38   VarName = Var
  39   call GetDH(DataHandle,DH,Status)
  40   if(Status /= WRF_NO_ERR) then
  41     write(msg,*) &
  42 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  43     call wrf_debug ( WARN , msg)
  44     return
  45   endif
  46   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
  47     Status = WRF_WARN_FILE_NOT_OPENED
  48     write(msg,*) &
  49 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  50     call wrf_debug ( WARN , msg)
  51   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
  52     Status = WRF_WARN_WRITE_RONLY_FILE
  53     write(msg,*) &
  54 'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  55     call wrf_debug ( WARN , msg)
  56   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
  57     Status = WRF_WARN_MD_AFTER_OPEN
  58     write(msg,*) &
  59 'Warning WRITE METADATA AFTER OPEN in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  60     call wrf_debug ( WARN , msg)
  61     return
  62   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
  63     do NVar=1,MaxVars
  64       if(TRIM(DH%VarNames(NVar)) == TRIM(VarName)) then
  65         exit
  66       elseif(NVar == MaxVars) then
  67         Status = WRF_WARN_VAR_NF
  68         write(msg,*) &
  69 'Warning VARIABLE NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ &
  70                         ,NVar,VarName
  71         call wrf_debug ( WARN , msg)
  72         return
  73       endif
  74     enddo
  75 #ifdef LOG
  76     allocate(Buffer(Count), STAT=stat)
  77     if(stat/= 0) then
  78       Status = WRF_ERR_FATAL_ALLOCATION_ERROR
  79       write(msg,*) &
  80 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
  81       call wrf_debug ( FATAL , msg)
  82       return
  83     endif
  84     do i=1,Count
  85       if(data(i)) then
  86          Buffer(i)=1
  87       else
  88          Buffer(i)=0
  89       endif
  90     enddo
  91     call adios2_define_attribute(AttributeID,DH%adios2IO, trim(Element), &
  92               Buffer, Count, DH%VarIDs(NVar)%name, stat)
  93     call adios2_err(stat,Status)
  94     if(Status /= WRF_NO_ERR) then
  95       write(msg,*) 'ext_adios2_put_var_ti: adios2 error in ',__FILE__,', line', __LINE__
  96       call wrf_debug ( WARN , TRIM(msg))
  97       return
  98     endif
  99 #elif defined(CHAR_TYPE)
 100     call adios2_define_attribute(AttributeID,DH%adios2IO, trim(Element), &
 101               Data, 1, DH%VarIDs(NVar)%name, stat)
 102     call adios2_err(stat,Status)
 103     if(Status /= WRF_NO_ERR) then
 104       write(msg,*) 'ext_adios2_put_var_ti: adios2 error in ',__FILE__,', line', __LINE__
 105       call wrf_debug ( WARN , TRIM(msg))
 106       return
 107     endif
 108 #else
 109     call adios2_define_attribute(AttributeID,DH%adios2IO, trim(Element), &
 110               Data, Count, DH%VarIDs(NVar)%name, stat)
 111     call adios2_err(stat,Status)
 112     if(Status /= WRF_NO_ERR) then
 113       write(msg,*) 'ext_adios2_put_var_ti : adios2 error in ',__FILE__,', line', __LINE__
 114       call wrf_debug ( WARN , TRIM(msg))
 115       return
 116     endif
 117 #endif
 118 #ifdef LOG
 119     deallocate(Buffer, STAT=stat)
 120     if(stat/= 0) then
 121       Status = WRF_ERR_FATAL_DEALLOCATION_ERR
 122       write(msg,*) &
 123 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 124       call wrf_debug ( FATAL , msg)
 125       return
 126     endif
 127 #endif
 128   else
 129     Status = WRF_ERR_FATAL_BAD_FILE_STATUS
 130     write(msg,*) &
 131 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 132     call wrf_debug ( FATAL , msg)
 133     return
 134   endif
 135   return