libsim Versione 7.2.6
vol7d_varvect_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!> Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var.
19!! Questo modulo definisce una classe per gestire un vettore di ogetti vol7d_var,
20!! cioè variabili meteorologiche osservate, anche aventi tipi numerici diversi.
21!! \ingroup vol7d
23USE kinds
28
29IMPLICIT NONE
30
31!> Definisce un vettore di vol7d_var_class::vol7d_var per ogni tipo di dato
32!! supportato.
33!! Un puntatore non associato indica che non c'è nessuna variabile avente
34!! dati di quel tipo.
35!! I membri di \a vol7d_varvect sono pubblici e quindi liberamente
36!! accessibili e scrivibili, ma è comunque consigliato allocarli tramite
37!! l'apposito metodo.
39 TYPE(vol7d_var),POINTER :: r(:) !< vettore di variabili reali
40 TYPE(vol7d_var),POINTER :: d(:) !< vettore di variabili a doppia precisione
41 TYPE(vol7d_var),POINTER :: i(:) !< vettore di variabili intere
42 TYPE(vol7d_var),POINTER :: b(:) !< vettore di variabili byte
43 TYPE(vol7d_var),POINTER :: c(:) !< vettore di variabili carattere
44END TYPE vol7d_varvect
45
46
47!> Costruttore per la classe vol7d_varvect.
48!! Deve essere richiamato
49!! per tutti gli oggetti di questo tipo definiti in un programma.
50INTERFACE init
51 MODULE PROCEDURE vol7d_varvect_init
52END INTERFACE
53
54!> Distruttore per la classe vol7d_varvect.
55INTERFACE delete
56 MODULE PROCEDURE vol7d_varvect_delete
57END INTERFACE
58
59!> Return the index of first or last element of \a this equal to \a
60!! search.
61INTERFACE index
62 MODULE PROCEDURE vol7d_varvect_index,vol7d_varvect_indexvect
63END INTERFACE
64
65!> \brief display on the screen a brief content of object
66INTERFACE display
67 MODULE PROCEDURE display_varvect
68END INTERFACE
69
70
71CONTAINS
72
73!> Inizializza un oggetto di tipo vol7d_varvect.
74!! Non riceve alcun parametro tranne l'oggetto stesso. Attenzione, è necessario
75!! comunque chiamare sempre il costruttore per evitare di avere dei puntatori in
76!! uno stato indefinito.
77SUBROUTINE vol7d_varvect_init(this)
78TYPE(vol7d_varvect),INTENT(INOUT) :: this !< oggetto da inizializzare
79
80NULLIFY(this%r, this%d, this%i, this%b, this%c)
81
82END SUBROUTINE vol7d_varvect_init
83
84
85!> Distrugge l'oggetto in maniera pulita, liberando l'eventuale memoria
86!! dinamicamente allocata.
87elemental SUBROUTINE vol7d_varvect_delete(this)
88TYPE(vol7d_varvect),INTENT(INOUT) :: this !< oggetto da distruggere
89
90IF (ASSOCIATED(this%r)) DEALLOCATE(this%r)
91IF (ASSOCIATED(this%d)) DEALLOCATE(this%d)
92IF (ASSOCIATED(this%i)) DEALLOCATE(this%i)
93IF (ASSOCIATED(this%b)) DEALLOCATE(this%b)
94IF (ASSOCIATED(this%c)) DEALLOCATE(this%c)
95
96END SUBROUTINE vol7d_varvect_delete
97
98
99!> Metodo per allocare i vettori di variabili richiesti.
100!! Se uno dei parametri \a nvar* non è presente o è <= 0 non viene
101!! allocato niente per quel tipo di variabile.
102!! Il metodo può essere chiamato più volte per allocare successivamente
103!! diversi tipi di variabili.
104SUBROUTINE vol7d_varvect_alloc(this, nvarr, nvard, nvari, nvarb, nvarc, ini)
105TYPE(vol7d_varvect),INTENT(INOUT) :: this !< oggetto in cui allocare i vettori
106INTEGER,INTENT(in),OPTIONAL :: nvarr !< numero di variabili con dati reali
107INTEGER,INTENT(in),OPTIONAL :: nvard !< numero di variabili con dati a doppia precisione
108INTEGER,INTENT(in),OPTIONAL :: nvari !< numero di variabili con dati interi
109INTEGER,INTENT(in),OPTIONAL :: nvarb !< numero di variabili con dati byte
110INTEGER,INTENT(in),OPTIONAL :: nvarc !< numero di variabili con dati carattere
111LOGICAL,INTENT(in),OPTIONAL :: ini !< se fornito e vale \c .TRUE., viene chiamato il costruttore vol7d_var_class::init (senza parametri opzionali) per ognuna delle variabili allocate in ciascun vettore
112
113INTEGER :: i
114LOGICAL :: linit
115
116IF (PRESENT(ini)) THEN
117 linit = ini
118ELSE
119 linit = .false.
120ENDIF
121
122IF (PRESENT(nvarr)) THEN
123 IF (nvarr > 0) THEN
124 IF (ASSOCIATED(this%r)) DEALLOCATE(this%r)
125 ALLOCATE(this%r(nvarr))
126 IF (linit) THEN
127 DO i = 1, nvarr
128 CALL init(this%r(i))
129 ENDDO
130 ENDIF
131 ENDIF
132ENDIF
133IF (PRESENT(nvard)) THEN
134 IF (nvard > 0) THEN
135 IF (ASSOCIATED(this%d)) DEALLOCATE(this%d)
136 ALLOCATE(this%d(nvard))
137 IF (linit) THEN
138 DO i = 1, nvard
139 CALL init(this%d(i))
140 ENDDO
141 ENDIF
142 ENDIF
143ENDIF
144IF (PRESENT(nvari)) THEN
145 IF (nvari > 0) THEN
146 IF (ASSOCIATED(this%i)) DEALLOCATE(this%i)
147 ALLOCATE(this%i(nvari))
148 IF (linit) THEN
149 DO i = 1, nvari
150 CALL init(this%i(i))
151 ENDDO
152 ENDIF
153 ENDIF
154ENDIF
155IF (PRESENT(nvarb)) THEN
156 IF (nvarb > 0) THEN
157 IF (ASSOCIATED(this%b)) DEALLOCATE(this%b)
158 ALLOCATE(this%b(nvarb))
159 IF (linit) THEN
160 DO i = 1, nvarb
161 CALL init(this%b(i))
162 ENDDO
163 ENDIF
164 ENDIF
165ENDIF
166IF (PRESENT(nvarc)) THEN
167 IF (nvarc > 0) THEN
168 IF (ASSOCIATED(this%c)) DEALLOCATE(this%c)
169 ALLOCATE(this%c(nvarc))
170 IF (linit) THEN
171 DO i = 1, nvarc
172 CALL init(this%c(i))
173 ENDDO
174 ENDIF
175 ENDIF
176ENDIF
177
178END SUBROUTINE vol7d_varvect_alloc
179
180
181!> Return the index of first or last element of \a this equal to \a
182!! search.
183FUNCTION vol7d_varvect_index(this, search, mask, back, type) RESULT(index_)
184TYPE(vol7d_varvect),intent(in) :: this !< object to search in
185type(vol7d_var),INTENT(in) :: search !< what to search
186LOGICAL,INTENT(in),OPTIONAL :: mask(:) !< search only among elements for which \a mask is \a .TRUE.
187LOGICAL,INTENT(in),OPTIONAL :: back !< if \a .TRUE. search from the end
188character(len=*),intent(inout),optional :: type !< type of vector found ("d","r","i","b","c")
189INTEGER :: index_
190
191
192index_=0
193
194select case (optio_c(type,1))
195
196case ("d")
197 if (associated(this%d))then
198 index_=index(this%d(:), search, mask, back) ! vettore di variabili a doppia precisione
199 end if
200
201case ("r")
202 if (associated(this%r))then
203 index_=index(this%r(:), search, mask, back) ! vettore di variabili reali
204 end if
205
206case ("i")
207 if (associated(this%i))then
208 index_=index(this%i(:), search, mask, back) ! vettore di variabili intere
209 end if
210
211case ("b")
212 if (associated(this%b))then
213 index_=index(this%b(:), search, mask, back) ! vettore di variabili byte
214 end if
215
216case ("c")
217 if (associated(this%c))then
218 index_=index(this%c(:), search, mask, back) ! vettore di variabili carattere
219 end if
220
221case (cmiss)
222
223 if (associated(this%d))then
224 index_=index(this%d(:), search, mask, back) ! vettore di variabili a doppia precisione
225 if (present(type)) type="d"
226 end if
227
228 if(index_ == 0)then
229 if (associated(this%r))then
230 index_=index(this%r(:), search, mask, back) ! vettore di variabili reali
231 if (present(type)) type="r"
232 end if
233 end if
234
235 if(index_ == 0)then
236 if (associated(this%i))then
237 index_=index(this%i(:), search, mask, back) ! vettore di variabili intere
238 if (present(type)) type="i"
239 end if
240end if
241
242 if(index_ == 0)then
243 if (associated(this%b))then
244 index_=index(this%b(:), search, mask, back) ! vettore di variabili byte
245 if (present(type)) type="b"
246 end if
247 end if
248
249 if(index_ == 0)then
250 if (associated(this%c))then
251 index_=index(this%c(:), search, mask, back) ! vettore di variabili carattere
252 if (present(type)) type="c"
253 end if
254 end if
255
256 if (index_ == 0) type=cmiss
257
258case default
259
260 CALL l4f_log(l4f_error, 'variable type not contemplated: '//type)
261
262end select
263
264END FUNCTION vol7d_varvect_index
265
266
267!> Return the index of first or last element of \a this equal to \a
268!! search.
269FUNCTION vol7d_varvect_indexvect(this, search, back, TYPE) RESULT(index_)
270TYPE(vol7d_varvect),intent(in) :: this !< object to search in
271type(vol7d_var),INTENT(in) :: search(:) !< what to search
272LOGICAL,INTENT(in),OPTIONAL :: back !< if \a .TRUE. search from the end
273character(len=*),intent(inout) :: type(:) !< type of vector found ("d","r","i","b","c")
274INTEGER :: index_(size(search))
275
276integer :: i
277
278do i =1 ,size(search)
279 index_(i) = vol7d_varvect_index(this, search(i), back=back, type=type(i))
280end do
281
282END FUNCTION vol7d_varvect_indexvect
283
284
285!> \brief display on the screen a brief content of vol7d_var object
286subroutine display_varvect(this)
287
288TYPE(vol7d_varvect),INTENT(in) :: this !< vol7d_varvect object to display
289
290if (associated(this%d))then
291print *,"----------------- varvect --------------------------"
292 print*,"double precision elements=",size(this%d)
293 call display(this%d(:)) ! vettore di variabili a doppia precisione
294end if
295
296if (associated(this%r))then
297print *,"----------------- varvect --------------------------"
298 print*,"real elements=",size(this%r)
299 call display(this%r(:)) ! vettore di variabili reali
300end if
301
302if (associated(this%i))then
303print *,"----------------- varvect --------------------------"
304 print*,"integer elements=",size(this%i)
305 call display(this%i(:)) ! vettore di variabili intere
306end if
307
308if (associated(this%b))then
309print *,"----------------- varvect --------------------------"
310 print*,"byte elements=",size(this%b)
311 call display(this%b(:)) ! vettore di variabili byte
312end if
313
314if (associated(this%c))then
315print *,"----------------- varvect --------------------------"
316 print*,"character elements=",size(this%c)
317 call display(this%c(:)) ! vettore di variabili carattere
318end if
319
320
321end subroutine display_varvect
322
323
324END MODULE vol7d_varvect_class
Index method.
Distruttore per la classe vol7d_varvect.
display on the screen a brief content of object
Costruttore per la classe vol7d_varvect.
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var.
Definisce una variabile meteorologica osservata o un suo attributo.
Definisce un vettore di vol7d_var_class::vol7d_var per ogni tipo di dato supportato.

Generated with Doxygen.