| blob | 62a49fd93f3ecb20e6a6cfa160c9bf2285f04250 |
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 use wrf_data_adios2
17 use ext_adios2_support_routines
18 use adios2
19 implicit none
20 include 'wrf_status_codes.h'
21 integer ,intent(in) :: DataHandle
22 character*(*) ,intent(in) :: Element
23 character (DateStrLen),intent(in) :: DateStr
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 character (VarNameLen) :: VarName
31 character (40+len(Element)) :: Name
32 character (40+len(Element)) :: FName
33 integer :: stat
34 TYPE_BUFFER ,allocatable :: Buffer(:)
35 integer :: i
36 integer :: VDims (2)
37 integer :: VStart(2)
38 integer :: VCount(2)
39 integer :: NVar
40 integer :: TimeIndex
41 integer :: DimIDs(2)
42 type(adios2_variable) :: VarID
43 integer :: XType
44 integer :: NDims
45 integer :: NAtts
46 integer :: Len1
47 integer(kind=8) :: TimeIndex_int8
48 integer(kind=8),dimension(:),allocatable :: shape_dims
49 integer :: ndims_adios2
51 if(Count <= 0) then
52 Status = WRF_WARN_ZERO_LENGTH_GET
53 write(msg,*) &
54 'Warning ZERO LENGTH GET in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
55 call wrf_debug ( WARN , msg)
56 return
57 endif
58 VarName = Var
59 call DateCheck(DateStr,Status)
60 if(Status /= WRF_NO_ERR) then
61 write(msg,*) &
62 'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
63 call wrf_debug ( WARN , msg)
64 return
65 endif
66 call GetDH(DataHandle,DH,Status)
67 if(Status /= WRF_NO_ERR) then
68 write(msg,*) &
69 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
70 call wrf_debug ( WARN , msg)
71 return
72 endif
73 call GetName(Element, VarName, Name, Status)
74 if(Status /= WRF_NO_ERR) then
75 write(msg,*) &
76 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
77 call wrf_debug ( WARN , msg)
78 return
79 endif
80 if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
81 Status = WRF_WARN_FILE_NOT_OPENED
82 write(msg,*) &
83 'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
84 call wrf_debug ( WARN , msg)
85 elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
86 Status = WRF_WARN_DRYRUN_READ
87 write(msg,*) &
88 'Warning DRYRUN READ in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
89 call wrf_debug ( WARN , msg)
90 elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
91 Status = WRF_WARN_READ_WONLY_FILE
92 write(msg,*) &
93 'Warning READ WONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
94 call wrf_debug ( WARN , msg)
95 elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
96 call adios2_inquire_variable(VarID, DH%adios2IO, Name, stat)
97 call adios2_err(stat,Status)
98 if(Status /= WRF_NO_ERR) then
99 write(msg,*) 'adios2 error in ext_adios2_get_var_td ',__FILE__,', line', __LINE__
100 call wrf_debug ( WARN , TRIM(msg))
101 return
102 endif
103 call adios2_variable_shape(shape_dims, ndims_adios2, VarID, stat)
104 call adios2_err(stat,Status)
105 if(Status /= WRF_NO_ERR) then
106 write(msg,*) 'adios2 error in ext_adios2_get_var_td ',__FILE__,', line', __LINE__
107 call wrf_debug ( WARN , TRIM(msg))
108 return
109 endif
110 Len1 = shape_dims(1)
111 call GetTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
112 if(Status /= WRF_NO_ERR) then
113 write(msg,*) &
114 'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
115 call wrf_debug ( WARN , msg)
116 return
117 endif
118 TimeIndex_int8 = TimeIndex
119 call adios2_set_step_selection(VarID, TimeIndex_int8 -1_8, 1_8, stat)
120 call adios2_err(stat,Status)
121 if(Status /= WRF_NO_ERR) then
122 write(msg,*) 'adios2 error in ext_adios2_get_var_td ',__FILE__,', line', __LINE__
123 call wrf_debug ( WARN , TRIM(msg))
124 return
125 endif
126 VStart(1) = 1
127 VStart(2) = TimeIndex
128 VCount(1) = LENGTH
129 VCount(2) = 1
130 #ifndef CHAR_TYPE
131 allocate(Buffer(VCount(1)), STAT=stat)
132 if(stat/= 0) then
133 Status = WRF_ERR_FATAL_ALLOCATION_ERROR
134 write(msg,*) &
135 'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
136 call wrf_debug ( FATAL , msg)
137 return
138 endif
139 call adios2_get(DH%adios2Engine, VarID, Buffer, adios2_mode_sync, stat)
140 #else
141 Data = ''
142 call adios2_get(DH%adios2Engine, VarID, Data, adios2_mode_sync, stat)
143 #endif
144 call adios2_err(stat,Status)
145 if(Status /= WRF_NO_ERR) then
146 write(msg,*) 'adios2 error in ext_adios2_get_var_td ',__FILE__,', line', __LINE__
147 call wrf_debug ( WARN , TRIM(msg))
148 return
149 endif
150 #ifndef CHAR_TYPE
151 COPY
152 deallocate(Buffer, STAT=stat)
153 if(stat/= 0) then
154 Status = WRF_ERR_FATAL_DEALLOCATION_ERR
155 write(msg,*) &
156 'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
157 call wrf_debug ( FATAL , msg)
158 return
159 endif
160 if(Len1 > Count) then
161 OutCount = Count
162 Status = WRF_WARN_MORE_DATA_IN_FILE
163 else
164 OutCount = Len1
165 Status = WRF_NO_ERR
166 endif
167 #endif
168 else
169 Status = WRF_ERR_FATAL_BAD_FILE_STATUS
170 write(msg,*) &
171 'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
172 call wrf_debug ( FATAL , msg)
173 endif
174 return