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

Generated with Doxygen.