libsim  Versione6.3.0
vol7d_var_class.F90
1 ! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Davide Cesari <dcesari@arpa.emr.it>
4 ! Paolo Patruno <ppatruno@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 #include "config.h"
19 
24 MODULE vol7d_var_class
25 USE kinds
27 IMPLICIT NONE
28 
37 TYPE vol7d_var
38  CHARACTER(len=10) :: btable
39  CHARACTER(len=65) :: description
40  CHARACTER(len=24) :: unit
41  integer :: scalefactor
42 
43  INTEGER :: r
44  INTEGER :: d
45  INTEGER :: i
46  INTEGER :: b
47  INTEGER :: c
48 end type vol7d_var
49 
51 TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
52  vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss)
53 
57 INTERFACE init
58  MODULE PROCEDURE vol7d_var_init
59 END INTERFACE
60 
63 INTERFACE delete
64  MODULE PROCEDURE vol7d_var_delete
65 END INTERFACE
66 
72 INTERFACE operator (==)
73  MODULE PROCEDURE vol7d_var_eq
74 !!$, vol7d_var_eqsv
75 END INTERFACE
76 
82 INTERFACE operator (/=)
83  MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
84 END INTERFACE
85 
87 INTERFACE c_e
88  MODULE PROCEDURE vol7d_var_c_e
89 END INTERFACE
90 
91 #define VOL7D_POLY_TYPE TYPE(vol7d_var)
92 #define VOL7D_POLY_TYPES _var
93 #include "array_utilities_pre.F90"
94 
96 INTERFACE display
97  MODULE PROCEDURE display_var, display_var_vect
98 END INTERFACE
99 
100 ! constants for vol7d_vartype
101 INTEGER,PARAMETER :: var_ord=0
102 INTEGER,PARAMETER :: var_dir360=1
103 INTEGER,PARAMETER :: var_press=2
104 INTEGER,PARAMETER :: var_ucomp=3
105 INTEGER,PARAMETER :: var_vcomp=4
106 INTEGER,PARAMETER :: var_wcomp=5
107 
108 
109 CONTAINS
110 
116 elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
117 TYPE(vol7d_var),INTENT(INOUT) :: this
118 CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
119 CHARACTER(len=*),INTENT(in),OPTIONAL :: description
120 CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
121 INTEGER,INTENT(in),OPTIONAL :: scalefactor
122 
123 IF (present(btable)) THEN
124  this%btable = btable
125 ELSE
126  this%btable = cmiss
127  this%description = cmiss
128  this%unit = cmiss
129  this%scalefactor = imiss
130  RETURN
131 ENDIF
132 IF (present(description)) THEN
133  this%description = description
134 ELSE
135  this%description = cmiss
136 ENDIF
137 IF (present(unit)) THEN
138  this%unit = unit
139 ELSE
140  this%unit = cmiss
141 ENDIF
142 if (present(scalefactor)) then
143  this%scalefactor = scalefactor
144 else
145  this%scalefactor = imiss
146 endif
147 
148 this%r = -1
149 this%d = -1
150 this%i = -1
151 this%b = -1
152 this%c = -1
153 
154 END SUBROUTINE vol7d_var_init
155 
156 
157 ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
158 CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
159 CHARACTER(len=*),INTENT(in),OPTIONAL :: description
160 CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
161 INTEGER,INTENT(in),OPTIONAL :: scalefactor
162 
163 TYPE(vol7d_var) :: this
164 
165 CALL init(this,btable, description, unit, scalefactor)
166 
167 END FUNCTION vol7d_var_new
168 
169 
171 elemental SUBROUTINE vol7d_var_delete(this)
172 TYPE(vol7d_var),INTENT(INOUT) :: this
173 
174 this%btable = cmiss
175 this%description = cmiss
176 this%unit = cmiss
177 this%scalefactor = imiss
178 
179 END SUBROUTINE vol7d_var_delete
180 
181 
182 elemental FUNCTION vol7d_var_eq(this, that) RESULT(res)
183 TYPE(vol7d_var),INTENT(IN) :: this, that
184 LOGICAL :: res
185 
186 res = this%btable == that%btable
187 
188 END FUNCTION vol7d_var_eq
189 
190 
191 !!$FUNCTION vol7d_var_eqsv(this, that) RESULT(res)
192 !!$TYPE(vol7d_var),INTENT(IN) :: this, that(:)
193 !!$LOGICAL :: res(SIZE(that))
194 !!$
195 !!$INTEGER :: i
196 !!$
197 !!$DO i = 1, SIZE(that)
198 !!$ res(i) = this == that(i)
199 !!$ENDDO
200 !!$
201 !!$END FUNCTION vol7d_var_eqsv
202 
203 
204 elemental FUNCTION vol7d_var_ne(this, that) RESULT(res)
205 TYPE(vol7d_var),INTENT(IN) :: this, that
206 LOGICAL :: res
207 
208 res = .NOT.(this == that)
209 
210 END FUNCTION vol7d_var_ne
211 
212 
213 FUNCTION vol7d_var_nesv(this, that) RESULT(res)
214 TYPE(vol7d_var),INTENT(IN) :: this, that(:)
215 LOGICAL :: res(size(that))
216 
217 INTEGER :: i
219 DO i = 1, SIZE(that)
220  res(i) = .NOT.(this == that(i))
221 ENDDO
222 
223 END FUNCTION vol7d_var_nesv
224 
225 
226 
228 subroutine display_var(this)
229 
230 TYPE(vol7d_var),INTENT(in) :: this
232 print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
233  " scale factor",this%scalefactor
235 end subroutine display_var
236 
239 subroutine display_var_vect(this)
241 TYPE(vol7d_var),INTENT(in) :: this(:)
242 integer :: i
243 
244 do i=1,size(this)
245  call display_var(this(i))
246 end do
247 
248 end subroutine display_var_vect
249 
250 FUNCTION vol7d_var_c_e(this) RESULT(c_e)
251 TYPE(vol7d_var),INTENT(IN) :: this
252 LOGICAL :: c_e
253 c_e = this /= vol7d_var_miss
254 END FUNCTION vol7d_var_c_e
255 
256 
261 ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
262 TYPE(vol7d_var),INTENT(in) :: this
263 
264 INTEGER :: vartype
265 
266 vartype = var_ord
267 SELECT CASE(this%btable)
268 CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
269  vartype = var_dir360
270 CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
271  vartype = var_press
272 CASE('B11003', 'B11200') ! u-component
273  vartype = var_ucomp
274 CASE('B11004', 'B11201') ! v-component
275  vartype = var_vcomp
276 CASE('B11005', 'B11006') ! w-component
277  vartype = var_wcomp
278 END SELECT
279 
280 END FUNCTION vol7d_vartype
282 
283 #include "array_utilities_inc.F90"
284 
285 
286 END MODULE vol7d_var_class
Definitions of constants and functions for working with missing values.
Distruttore per la classe vol7d_var.
display on the screen a brief content of object
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Costruttore per la classe vol7d_var.
to be documented
Definisce una variabile meteorologica osservata o un suo attributo.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:251

Generated with Doxygen.