libsim  Versione 7.2.1
vol7d_ana_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_ana_class
25 USE kinds
28 IMPLICIT NONE
29 
31 INTEGER,PARAMETER :: vol7d_ana_lenident=20
32 
37 TYPE vol7d_ana
38  TYPE(geo_coord) :: coord
39  CHARACTER(len=vol7d_ana_lenident) :: ident
40 END TYPE vol7d_ana
41 
43 TYPE(vol7d_ana),PARAMETER :: vol7d_ana_miss=vol7d_ana(geo_coord_miss,cmiss)
44 
48 INTERFACE init
49  MODULE PROCEDURE vol7d_ana_init
50 END INTERFACE
51 
54 INTERFACE delete
55  MODULE PROCEDURE vol7d_ana_delete
56 END INTERFACE
57 
61 INTERFACE OPERATOR (==)
62  MODULE PROCEDURE vol7d_ana_eq
63 END INTERFACE
64 
68 INTERFACE OPERATOR (/=)
69  MODULE PROCEDURE vol7d_ana_ne
70 END INTERFACE
71 
72 
77 INTERFACE OPERATOR (>)
78  MODULE PROCEDURE vol7d_ana_gt
79 END INTERFACE
80 
85 INTERFACE OPERATOR (<)
86  MODULE PROCEDURE vol7d_ana_lt
87 END INTERFACE
88 
93 INTERFACE OPERATOR (>=)
94  MODULE PROCEDURE vol7d_ana_ge
95 END INTERFACE
96 
101 INTERFACE OPERATOR (<=)
102  MODULE PROCEDURE vol7d_ana_le
103 END INTERFACE
104 
105 
107 INTERFACE c_e
108  MODULE PROCEDURE vol7d_ana_c_e
109 END INTERFACE
110 
113 INTERFACE read_unit
114  MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
115 END INTERFACE
116 
119 INTERFACE write_unit
120  MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
121 END INTERFACE
122 
123 #define VOL7D_POLY_TYPE TYPE(vol7d_ana)
124 #define VOL7D_POLY_TYPES _ana
125 #define ENABLE_SORT
126 #include "array_utilities_pre.F90"
127 
129 INTERFACE to_char
130  MODULE PROCEDURE to_char_ana
131 END INTERFACE
132 
134 INTERFACE display
135  MODULE PROCEDURE display_ana
136 END INTERFACE
137 
138 CONTAINS
139 
143 SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
144 TYPE(vol7d_ana),INTENT(INOUT) :: this
145 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
146 REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
147 CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
148 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
149 INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
150 
151 CALL init(this%coord, lon=lon, lat=lat , ilon=ilon, ilat=ilat)
152 IF (PRESENT(ident)) THEN
153  this%ident = ident
154 ELSE
155  this%ident = cmiss
156 ENDIF
157 
158 END SUBROUTINE vol7d_ana_init
159 
160 
162 SUBROUTINE vol7d_ana_delete(this)
163 TYPE(vol7d_ana),INTENT(INOUT) :: this
164 
165 CALL delete(this%coord)
166 this%ident = cmiss
167 
168 END SUBROUTINE vol7d_ana_delete
169 
170 
171 
172 character(len=80) function to_char_ana(this)
173 
174 TYPE(vol7d_ana),INTENT(in) :: this
175 
176 to_char_ana="ANA: "//&
177  to_char(getlon(this%coord),miss="Missing lon",form="(f11.5)")//&
178  to_char(getlat(this%coord),miss="Missing lat",form="(f11.5)")//&
179  t2c(this%ident,miss="Missing ident")
180 
181 return
182 
183 end function to_char_ana
184 
185 
186 subroutine display_ana(this)
187 
188 TYPE(vol7d_ana),INTENT(in) :: this
189 
190 print*, trim(to_char(this))
191 
192 end subroutine display_ana
193 
194 
195 ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
196 TYPE(vol7d_ana),INTENT(IN) :: this, that
197 LOGICAL :: res
198 
199 res = this%coord == that%coord .AND. this%ident == that%ident
200 
201 END FUNCTION vol7d_ana_eq
202 
203 
204 ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
205 TYPE(vol7d_ana),INTENT(IN) :: this, that
206 LOGICAL :: res
207 
208 res = .NOT.(this == that)
209 
210 END FUNCTION vol7d_ana_ne
211 
212 
213 ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
214 TYPE(vol7d_ana),INTENT(IN) :: this, that
215 LOGICAL :: res
216 
217 res = this%ident > that%ident
218 
219 if ( this%ident == that%ident) then
220  res =this%coord > that%coord
221 end if
222 
223 END FUNCTION vol7d_ana_gt
224 
225 
226 ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
227 TYPE(vol7d_ana),INTENT(IN) :: this, that
228 LOGICAL :: res
229 
230 res = .not. this < that
231 
232 END FUNCTION vol7d_ana_ge
233 
234 
235 ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
236 TYPE(vol7d_ana),INTENT(IN) :: this, that
237 LOGICAL :: res
238 
239 res = this%ident < that%ident
240 
241 if ( this%ident == that%ident) then
242  res = this%coord < that%coord
243 end if
244 
245 END FUNCTION vol7d_ana_lt
246 
247 
248 ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
249 TYPE(vol7d_ana),INTENT(IN) :: this, that
250 LOGICAL :: res
251 
252 res = .not. (this > that)
253 
254 END FUNCTION vol7d_ana_le
255 
256 
257 
258 ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
259 TYPE(vol7d_ana),INTENT(IN) :: this
260 LOGICAL :: c_e
261 c_e = this /= vol7d_ana_miss
262 END FUNCTION vol7d_ana_c_e
263 
264 
269 SUBROUTINE vol7d_ana_read_unit(this, unit)
270 TYPE(vol7d_ana),INTENT(out) :: this
271 INTEGER, INTENT(in) :: unit
272 
273 CALL vol7d_ana_vect_read_unit((/this/), unit)
274 
275 END SUBROUTINE vol7d_ana_read_unit
276 
277 
282 SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
283 TYPE(vol7d_ana) :: this(:)
284 INTEGER, INTENT(in) :: unit
285 
286 CHARACTER(len=40) :: form
287 
288 CALL read_unit(this%coord, unit)
289 INQUIRE(unit, form=form)
290 IF (form == 'FORMATTED') THEN
291  READ(unit,'(A)')this(:)%ident
292 ELSE
293  READ(unit)this(:)%ident
294 ENDIF
295 
296 END SUBROUTINE vol7d_ana_vect_read_unit
297 
298 
303 SUBROUTINE vol7d_ana_write_unit(this, unit)
304 TYPE(vol7d_ana),INTENT(in) :: this
305 INTEGER, INTENT(in) :: unit
306 
307 CALL vol7d_ana_vect_write_unit((/this/), unit)
308 
309 END SUBROUTINE vol7d_ana_write_unit
310 
311 
316 SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
317 TYPE(vol7d_ana),INTENT(in) :: this(:)
318 INTEGER, INTENT(in) :: unit
319 
320 CHARACTER(len=40) :: form
321 
322 CALL write_unit(this%coord, unit)
323 INQUIRE(unit, form=form)
324 IF (form == 'FORMATTED') THEN
325  WRITE(unit,'(A)')this(:)%ident
326 ELSE
327  WRITE(unit)this(:)%ident
328 ENDIF
329 
330 END SUBROUTINE vol7d_ana_vect_write_unit
331 
332 
333 #include "array_utilities_inc.F90"
334 
335 
336 END MODULE vol7d_ana_class
check for missing value
Distruttore per la classe vol7d_ana.
Costruttore per la classe vol7d_ana.
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED.
Represent ana object in a pretty string.
Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED.
Classes for handling georeferenced sparse points in geographical corodinates.
Definition of constants to be used for declaring variables of a desired type.
Definition: kinds.F90:255
Definitions of constants and functions for working with missing values.
Classe per la gestione dell'anagrafica di stazioni meteo e affini.
Definisce l'anagrafica di una stazione.

Generated with Doxygen.