libsim  Versione 7.1.9
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/>.
23 USE kinds
27 USE log4fortran
28 
29 IMPLICIT NONE
30 
39  TYPE(vol7d_var),POINTER :: r(:)
40  TYPE(vol7d_var),POINTER :: d(:)
41  TYPE(vol7d_var),POINTER :: i(:)
42  TYPE(vol7d_var),POINTER :: b(:)
43  TYPE(vol7d_var),POINTER :: c(:)
44 END TYPE vol7d_varvect
45 
46 
50 INTERFACE init
51  MODULE PROCEDURE vol7d_varvect_init
52 END INTERFACE
53 
55 INTERFACE delete
56  MODULE PROCEDURE vol7d_varvect_delete
57 END INTERFACE
58 
61 INTERFACE index
62  MODULE PROCEDURE vol7d_varvect_index,vol7d_varvect_indexvect
63 END INTERFACE
64 
66 INTERFACE display
67  MODULE PROCEDURE display_varvect
68 END INTERFACE
69 
70 
71 CONTAINS
72 
77 SUBROUTINE vol7d_varvect_init(this)
78 TYPE(vol7d_varvect),INTENT(INOUT) :: this
79 
80 NULLIFY(this%r, this%d, this%i, this%b, this%c)
81 
82 END SUBROUTINE vol7d_varvect_init
83 
84 
87 elemental SUBROUTINE vol7d_varvect_delete(this)
88 TYPE(vol7d_varvect),INTENT(INOUT) :: this
89 
90 IF (ASSOCIATED(this%r)) DEALLOCATE(this%r)
91 IF (ASSOCIATED(this%d)) DEALLOCATE(this%d)
92 IF (ASSOCIATED(this%i)) DEALLOCATE(this%i)
93 IF (ASSOCIATED(this%b)) DEALLOCATE(this%b)
94 IF (ASSOCIATED(this%c)) DEALLOCATE(this%c)
95 
96 END SUBROUTINE vol7d_varvect_delete
97 
98 
104 SUBROUTINE vol7d_varvect_alloc(this, nvarr, nvard, nvari, nvarb, nvarc, ini)
105 TYPE(vol7d_varvect),INTENT(INOUT) :: this
106 INTEGER,INTENT(in),OPTIONAL :: nvarr
107 INTEGER,INTENT(in),OPTIONAL :: nvard
108 INTEGER,INTENT(in),OPTIONAL :: nvari
109 INTEGER,INTENT(in),OPTIONAL :: nvarb
110 INTEGER,INTENT(in),OPTIONAL :: nvarc
111 LOGICAL,INTENT(in),OPTIONAL :: ini
112 
113 INTEGER :: i
114 LOGICAL :: linit
115 
116 IF (PRESENT(ini)) THEN
117  linit = ini
118 ELSE
119  linit = .false.
120 ENDIF
121 
122 IF (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
132 ENDIF
133 IF (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
143 ENDIF
144 IF (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
154 ENDIF
155 IF (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
165 ENDIF
166 IF (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
176 ENDIF
177 
178 END SUBROUTINE vol7d_varvect_alloc
179 
180 
183 FUNCTION vol7d_varvect_index(this, search, mask, back, type) RESULT(index_)
184 TYPE(vol7d_varvect),intent(in) :: this
185 type(vol7d_var),INTENT(in) :: search
186 LOGICAL,INTENT(in),OPTIONAL :: mask(:)
187 LOGICAL,INTENT(in),OPTIONAL :: back
188 character(len=*),intent(inout),optional :: type
189 INTEGER :: index_
190 
191 
192 index_=0
193 
194 select case (optio_c(type,1))
195 
196 case ("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 
201 case ("r")
202  if (associated(this%r))then
203  index_=index(this%r(:), search, mask, back) ! vettore di variabili reali
204  end if
205 
206 case ("i")
207  if (associated(this%i))then
208  index_=index(this%i(:), search, mask, back) ! vettore di variabili intere
209  end if
210 
211 case ("b")
212  if (associated(this%b))then
213  index_=index(this%b(:), search, mask, back) ! vettore di variabili byte
214  end if
215 
216 case ("c")
217  if (associated(this%c))then
218  index_=index(this%c(:), search, mask, back) ! vettore di variabili carattere
219  end if
220 
221 case (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
240 end 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 
258 case default
259 
260  CALL l4f_log(l4f_error, 'variable type not contemplated: '//type)
261 
262 end select
263 
264 END FUNCTION vol7d_varvect_index
265 
266 
269 FUNCTION vol7d_varvect_indexvect(this, search, back, TYPE) RESULT(index_)
270 TYPE(vol7d_varvect),intent(in) :: this
271 type(vol7d_var),INTENT(in) :: search(:)
272 LOGICAL,INTENT(in),OPTIONAL :: back
273 character(len=*),intent(inout) :: type(:)
274 INTEGER :: index_(size(search))
275 
276 integer :: i
277 
278 do i =1 ,size(search)
279  index_(i) = vol7d_varvect_index(this, search(i), back=back, type=type(i))
280 end do
281 
282 END FUNCTION vol7d_varvect_indexvect
283 
284 
286 subroutine display_varvect(this)
287 
288 TYPE(vol7d_varvect),INTENT(in) :: this
289 
290 if (associated(this%d))then
291 print *,"----------------- varvect --------------------------"
292  print*,"double precision elements=",size(this%d)
293  call display(this%d(:)) ! vettore di variabili a doppia precisione
294 end if
295 
296 if (associated(this%r))then
297 print *,"----------------- varvect --------------------------"
298  print*,"real elements=",size(this%r)
299  call display(this%r(:)) ! vettore di variabili reali
300 end if
301 
302 if (associated(this%i))then
303 print *,"----------------- varvect --------------------------"
304  print*,"integer elements=",size(this%i)
305  call display(this%i(:)) ! vettore di variabili intere
306 end if
307 
308 if (associated(this%b))then
309 print *,"----------------- varvect --------------------------"
310  print*,"byte elements=",size(this%b)
311  call display(this%b(:)) ! vettore di variabili byte
312 end if
313 
314 if (associated(this%c))then
315 print *,"----------------- varvect --------------------------"
316  print*,"character elements=",size(this%c)
317  call display(this%c(:)) ! vettore di variabili carattere
318 end if
319 
320 
321 end subroutine display_varvect
322 
323 
324 END 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:251
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.