51 MODULE PROCEDURE vol7d_varvect_init
56 MODULE PROCEDURE vol7d_varvect_delete
62 MODULE PROCEDURE vol7d_varvect_index,vol7d_varvect_indexvect
67 MODULE PROCEDURE display_varvect
77 SUBROUTINE vol7d_varvect_init(this)
78 TYPE(vol7d_varvect),
INTENT(INOUT) :: this
80 NULLIFY(this%r, this%d, this%i, this%b, this%c)
82 END SUBROUTINE vol7d_varvect_init
87 elemental SUBROUTINE vol7d_varvect_delete(this)
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)
96 END SUBROUTINE vol7d_varvect_delete
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
116 IF (
PRESENT(ini))
THEN 122 IF (
PRESENT(nvarr))
THEN 124 IF (
ASSOCIATED(this%r))
DEALLOCATE(this%r)
125 ALLOCATE(this%r(nvarr))
133 IF (
PRESENT(nvard))
THEN 135 IF (
ASSOCIATED(this%d))
DEALLOCATE(this%d)
136 ALLOCATE(this%d(nvard))
144 IF (
PRESENT(nvari))
THEN 146 IF (
ASSOCIATED(this%i))
DEALLOCATE(this%i)
147 ALLOCATE(this%i(nvari))
155 IF (
PRESENT(nvarb))
THEN 157 IF (
ASSOCIATED(this%b))
DEALLOCATE(this%b)
158 ALLOCATE(this%b(nvarb))
166 IF (
PRESENT(nvarc))
THEN 168 IF (
ASSOCIATED(this%c))
DEALLOCATE(this%c)
169 ALLOCATE(this%c(nvarc))
178 END SUBROUTINE vol7d_varvect_alloc
183 FUNCTION vol7d_varvect_index(this, search, mask, back, type)
RESULT(index_)
186 LOGICAL,
INTENT(in),
OPTIONAL :: mask(:)
187 LOGICAL,
INTENT(in),
OPTIONAL :: back
188 character(len=*),
intent(inout),
optional ::
type 194 select case (optio_c(
type,1))
197 if (
associated(this%d))
then 198 index_=
index(this%d(:), search, mask, back)
202 if (
associated(this%r))
then 203 index_=
index(this%r(:), search, mask, back)
207 if (
associated(this%i))
then 208 index_=
index(this%i(:), search, mask, back)
212 if (
associated(this%b))
then 213 index_=
index(this%b(:), search, mask, back)
217 if (
associated(this%c))
then 218 index_=
index(this%c(:), search, mask, back)
223 if (
associated(this%d))
then 224 index_=
index(this%d(:), search, mask, back)
225 if (
present(type)) type=
"d" 229 if (
associated(this%r))
then 230 index_=
index(this%r(:), search, mask, back)
231 if (
present(type)) type=
"r" 236 if (
associated(this%i))
then 237 index_=
index(this%i(:), search, mask, back)
238 if (
present(type)) type=
"i" 243 if (
associated(this%b))
then 244 index_=
index(this%b(:), search, mask, back)
245 if (
present(type)) type=
"b" 250 if (
associated(this%c))
then 251 index_=
index(this%c(:), search, mask, back)
252 if (
present(type)) type=
"c" 256 if (index_ == 0) type=cmiss
260 CALL l4f_log(l4f_error,
'variable type not contemplated: '//type)
264 END FUNCTION vol7d_varvect_index
269 FUNCTION vol7d_varvect_indexvect(this, search, back, TYPE)
RESULT(index_)
272 LOGICAL,
INTENT(in),
OPTIONAL :: back
273 character(len=*),
intent(inout) ::
type(:)
274 INTEGER :: index_(size(search))
278 do i =1 ,
size(search)
279 index_(i) = vol7d_varvect_index(this, search(i), back=back, type=
type(i))
282 END FUNCTION vol7d_varvect_indexvect
286 subroutine display_varvect(this)
288 TYPE(vol7d_varvect),
INTENT(in) :: this
290 if (
associated(this%d))
then 291 print *,
"----------------- varvect --------------------------" 292 print*,
"double precision elements=",
size(this%d)
296 if (
associated(this%r))
then 297 print *,
"----------------- varvect --------------------------" 298 print*,
"real elements=",
size(this%r)
302 if (
associated(this%i))
then 303 print *,
"----------------- varvect --------------------------" 304 print*,
"integer elements=",
size(this%i)
308 if (
associated(this%b))
then 309 print *,
"----------------- varvect --------------------------" 310 print*,
"byte elements=",
size(this%b)
314 if (
associated(this%c))
then 315 print *,
"----------------- varvect --------------------------" 316 print*,
"character elements=",
size(this%c)
321 end subroutine display_varvect
display on the screen a brief content of object
Classe per gestire un vettore di oggetti di tipo vol7d_var_class::vol7d_var.
Distruttore per la classe vol7d_varvect.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Definisce un vettore di vol7d_var_class::vol7d_var per ogni tipo di dato supportato.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Costruttore per la classe vol7d_varvect.
Definitions of constants and functions for working with missing values.
classe per la gestione del logging
Definisce una variabile meteorologica osservata o un suo attributo.
Definition of constants to be used for declaring variables of a desired type.