The TELEMAC-MASCARET system  trunk
api_handle_var_sis.f
Go to the documentation of this file.
1 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4 !
5  MODULE api_handle_var_sis
6 
7  USE api_handle_error
8  USE api_instance_sis
9  IMPLICIT NONE
11  INTEGER, PARAMETER :: sis_var_len=40
13  INTEGER, PARAMETER :: sis_type_len=12
15  INTEGER, PARAMETER :: sis_info_len=200
17  INTEGER, PARAMETER :: nb_var_sis=42
19  CHARACTER(LEN=SIS_VAR_LEN),ALLOCATABLE :: vname_sis(:)
21  CHARACTER(LEN=SIS_INFO_LEN),ALLOCATABLE :: vinfo_sis(:)
22 !
23  CONTAINS
24 !
25  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
28  SUBROUTINE get_double_array_sis_d
29  & (inst, varname, valeur, dim1, ierr , block_index)
30 !
31  TYPE(instance_sis), INTENT(IN) :: INST
32  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
33  INTEGER, INTENT(IN) :: DIM1
34  INTEGER, OPTIONAL, INTENT(IN) :: BLOCK_INDEX
35  DOUBLE PRECISION, INTENT(OUT):: VALEUR(dim1)
36  INTEGER, INTENT(OUT):: IERR
37 !
38  ierr = 0
39  valeur = 0.0
40 !
41  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
42  valeur(1:inst%Q%DIM1) = inst%Q%R(1:inst%Q%DIM1)
43  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
44  valeur(1:inst%E%DIM1) = inst%E%R(1:inst%E%DIM1)
45  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
46  valeur(1:inst%Z%DIM1) = inst%Z%R(1:inst%Z%DIM1)
47  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
48  valeur(1:inst%ZF%DIM1) = inst%ZF%R(1:inst%ZF%DIM1)
49  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
50  valeur(1:inst%ZF_C%DIM1) = inst%ZF_C%R(1:inst%ZF_C%DIM1)
51  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
52  valeur(1:inst%FLBOR%DIM1) = inst%FLBOR%R(1:inst%FLBOR%DIM1)
53  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
54  valeur(1:inst%FLBOR_SIS%DIM1) =
55  & inst%FLBOR_SIS%R(1:inst%FLBOR_SIS%DIM1)
56  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
57  valeur(1:inst%MESH%X%DIM1) = inst%MESH%X%R(1:inst%MESH%X%DIM1)
58  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
59  valeur(1:inst%MESH%Y%DIM1) = inst%MESH%Y%R(1:inst%MESH%Y%DIM1)
60  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
61  valeur(1:inst%MESH%XNEBOR%DIM1) =
62  & inst%MESH%XNEBOR%R(1:inst%MESH%XNEBOR%DIM1)
63  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
64  valeur(1:inst%MESH%YNEBOR%DIM1) =
65  & inst%MESH%YNEBOR%R(1:inst%MESH%YNEBOR%DIM1)
66  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
67  valeur(1:inst%TOB%DIM1) = inst%TOB%R(1:inst%TOB%DIM1)
68  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
69  valeur(1:inst%CHESTR%DIM1) = inst%CHESTR%R(1:inst%CHESTR%DIM1)
70  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
71  IF(PRESENT(block_index))THEN
72  valeur(1:inst%CS%ADR(block_index)%P%DIM1) =
73  & inst%CS%ADR(block_index)%P%R(1:inst%CS%ADR(block_index)%P%DIM1)
74  ELSE
75  ierr = index_block_missing
76  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
77  END IF
78  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
79  IF(PRESENT(block_index))THEN
80  valeur(1:inst%QBOR%ADR(block_index)%P%DIM1) =
81  & inst%QBOR%ADR(block_index)%P%R(
82  & 1:inst%QBOR%ADR(block_index)%P%DIM1)
83  ELSE
84  ierr = index_block_missing
85  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
86  END IF
87  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
88  IF(PRESENT(block_index))THEN
89  valeur(1:inst%CBOR%ADR(block_index)%P%DIM1) =
90  & inst%CBOR%ADR(block_index)%P%R(
91  & 1:inst%CBOR%ADR(block_index)%P%DIM1)
92  ELSE
93  ierr = index_block_missing
94  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
95  END IF
96  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
97  IF(PRESENT(block_index))THEN
98  valeur(1:inst%EBOR%ADR(block_index)%P%DIM1) =
99  & inst%EBOR%ADR(block_index)%P%R(
100  & 1:inst%EBOR%ADR(block_index)%P%DIM1)
101  ELSE
102  ierr = index_block_missing
103  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
104  END IF
105  ! <get_double_array>
106  ELSE
107  ierr = unknown_var_error
108  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
109  ENDIF
110 !
111  END SUBROUTINE get_double_array_sis_d
112 
113  !
114  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
116  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
117  SUBROUTINE set_double_array_sis_d
118  & (inst, varname, valeur, dim1, ierr, block_index)
119 !
120  TYPE(instance_sis), INTENT(INOUT) :: INST
121  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
122  INTEGER, OPTIONAL, INTENT(IN) :: BLOCK_INDEX
123  INTEGER, INTENT(IN) :: DIM1
124  DOUBLE PRECISION, INTENT(IN) :: VALEUR(dim1)
125  INTEGER, INTENT(OUT) :: IERR
126 !
127  ierr = 0
128 
129 !
130  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
131  inst%Q%R(1:inst%Q%DIM1) = valeur(1:inst%Q%DIM1)
132  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
133  inst%E%R(1:inst%E%DIM1) = valeur(1:inst%E%DIM1)
134  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
135  inst%Z%R(1:inst%Z%DIM1) = valeur(1:inst%Z%DIM1)
136  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
137  inst%ZF%R(1:inst%ZF%DIM1) = valeur(1:inst%ZF%DIM1)
138  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
139  inst%ZF_C%R(1:inst%ZF_C%DIM1) = valeur(1:inst%ZF_C%DIM1)
140  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
141  inst%FLBOR%R(1:inst%FLBOR%DIM1) = valeur(1:inst%FLBOR%DIM1)
142  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
143  inst%FLBOR_SIS%R(1:inst%FLBOR_SIS%DIM1) =
144  & valeur(1:inst%FLBOR_SIS%DIM1)
145  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
146  inst%MESH%X%R(1:inst%MESH%X%DIM1) = valeur(1:inst%MESH%X%DIM1)
147  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
148  inst%MESH%Y%R(1:inst%MESH%Y%DIM1) = valeur(1:inst%MESH%Y%DIM1)
149  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
150  inst%MESH%XNEBOR%R(1:inst%MESH%XNEBOR%DIM1) =
151  & valeur(1:inst%MESH%XNEBOR%DIM1)
152  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
153  inst%MESH%YNEBOR%R(1:inst%MESH%YNEBOR%DIM1) =
154  & valeur(1:inst%MESH%YNEBOR%DIM1)
155  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
156  inst%TOB%R(1:inst%TOB%DIM1) = valeur(1:inst%TOB%DIM1)
157  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
158  inst%CHESTR%R(1:inst%CHESTR%DIM1) = valeur(1:inst%CHESTR%DIM1)
159  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
160  IF(PRESENT(block_index))THEN
161  inst%CS%ADR(block_index)%P%R(1:inst%CS%ADR
162  & (block_index)%P%DIM1) =valeur(1:inst%CS%ADR
163  & (block_index)%P%DIM1)
164  ELSE
165  ierr = index_block_missing
166  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
167  END IF
168  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
169  IF(PRESENT(block_index))THEN
170  inst%QBOR%ADR(block_index)%P%R(1:inst%QBOR%ADR
171  & (block_index)%P%DIM1) =valeur(1:inst%QBOR%ADR
172  & (block_index)%P%DIM1)
173  ELSE
174  ierr = index_block_missing
175  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
176  END IF
177  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
178  IF(PRESENT(block_index))THEN
179  inst%CBOR%ADR(block_index)%P%R(1:inst%CBOR%ADR
180  & (block_index)%P%DIM1) = valeur(1:inst%CBOR%ADR
181  & (block_index)%P%DIM1)
182  ELSE
183  ierr = index_block_missing
184  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
185  END IF
186  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
187  IF(PRESENT(block_index))THEN
188  inst%EBOR%ADR(block_index)%P%R(1:inst%EBOR%ADR
189  & (block_index)%P%DIM1) =valeur(1:inst%EBOR%ADR
190  & (block_index)%P%DIM1)
191  ELSE
192  ierr = index_block_missing
193  err_mess = 'THE BOCK NUMBER IS MISSING FOR'//trim(varname)
194  END IF
195  ! <set_double_array>
196  ELSE
197  ierr = unknown_var_error
198  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
199  ENDIF
200 !
201  END SUBROUTINE set_double_array_sis_d
202 !
203  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
205  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
206  SUBROUTINE get_integer_array_sis_d
207  & (inst, varname, valeur, dim1, ierr)
208 !
209  TYPE(instance_sis), INTENT(IN) :: INST
210  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
211  INTEGER, INTENT(IN) :: DIM1
212  INTEGER, INTENT(OUT) :: VALEUR(dim1)
213  INTEGER, INTENT(OUT) :: IERR
214 !
215  ierr = 0
216  valeur = -1
217  IF(trim(varname).EQ.'MODEL.LIHBOR') THEN
218  valeur(1:inst%LIHBOR%DIM1) = inst%LIHBOR%I(1:inst%LIHBOR%DIM1)
219  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
220  valeur(1:inst%CLU%DIM1) = inst%CLU%I(1:inst%CLU%DIM1)
221  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
222  valeur(1:inst%CLV%DIM1) = inst%CLV%I(1:inst%CLV%DIM1)
223  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
224  valeur(1:inst%LIQBOR%DIM1) =
225  & inst%LIQBOR%I(1:inst%LIQBOR%DIM1)
226  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
227  valeur(1:inst%LICBOR%DIM1) =
228  & inst%LICBOR%I(1:inst%LICBOR%DIM1)
229  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
230  valeur(1:inst%LIEBOR%DIM1) =
231  & inst%LIEBOR%I(1:inst%LIEBOR%DIM1)
232  ELSE IF(trim(varname).EQ.'MODEL.NUMLIQ') THEN
233  valeur(1:inst%NUMLIQ%DIM1) =
234  & inst%NUMLIQ%I(1:inst%NUMLIQ%DIM1)
235  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
236  valeur(1:SIZE(inst%MESH%IKLE%I)) =
237  & inst%MESH%IKLE%I(1:SIZE(inst%MESH%IKLE%I))
238  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
239  valeur(1:SIZE(inst%MESH%NACHB%I)) =
240  & inst%MESH%NACHB%I(1:SIZE(inst%MESH%NACHB%I))
241  ! <get_integer_array>
242  ELSE
243  ierr = unknown_var_error
244  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
245  ENDIF
246 !
247  END SUBROUTINE get_integer_array_sis_d
248 
249 !
250  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
252  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
253  SUBROUTINE set_integer_array_sis_d
254  & (inst, varname, valeur, dim1, ierr)
255 !
256  TYPE(instance_sis), INTENT(INOUT) :: INST
257  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
258  INTEGER, INTENT(IN) :: DIM1
259  INTEGER, INTENT(IN) :: VALEUR(dim1)
260  INTEGER, INTENT(OUT) :: IERR
261 !
262  ierr = 0
263  IF(trim(varname).EQ.'MODEL.LIHBOR') THEN
264  inst%LIHBOR%I(1:inst%LIHBOR%DIM1) = valeur(1:inst%LIHBOR%DIM1)
265  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
266  inst%CLU%I(1:inst%CLU%DIM1) = valeur(1:inst%CLU%DIM1)
267  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
268  inst%CLV%I(1:inst%CLV%DIM1) = valeur(1:inst%CLV%DIM1)
269  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
270  inst%LIQBOR%I(1:inst%LIQBOR%DIM1) = valeur(1:inst%LIQBOR%DIM1)
271  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
272  inst%LICBOR%I(1:inst%LICBOR%DIM1) = valeur(1:inst%LICBOR%DIM1)
273  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
274  inst%LIEBOR%I(1:inst%LIEBOR%DIM1) = valeur(1:inst%LIEBOR%DIM1)
275  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
276  inst%MESH%IKLE%I(1:SIZE(inst%MESH%IKLE%I)) =
277  & valeur(1:SIZE(inst%MESH%IKLE%I))
278  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
279  inst%MESH%NACHB%I(1:SIZE(inst%MESH%NACHB%I)) =
280  & valeur(1:SIZE(inst%MESH%NACHB%I))
281  ! <set_integer_array>
282  ELSE
283  ierr = unknown_var_error
284  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
285  ENDIF
286 !
287  END SUBROUTINE set_integer_array_sis_d
288 !
289  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
291  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
300  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
301  SUBROUTINE get_double_sis_d
302  & (inst, varname, valeur, index1, index2, index3, ierr)
303 !
304  TYPE(instance_sis), INTENT(IN) :: INST
305  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
306  DOUBLE PRECISION, INTENT(OUT):: VALEUR
307  INTEGER, INTENT(IN) :: INDEX1
308  INTEGER, INTENT(IN) :: INDEX2
309  INTEGER, INTENT(IN) :: INDEX3
310  INTEGER, INTENT(OUT):: IERR
311 !
312  ierr = 0
313  valeur = 0.0
314 !
315  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
316  valeur=inst%Q%R(index1)
317  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
318  valeur = inst%E%R(index1)
319  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
320  valeur = inst%Z%R(index1)
321  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
322  valeur = inst%ZF%R(index1)
323  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
324  valeur = inst%ZF_C%R(index1)
325  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
326  valeur = inst%FLBOR%R(index1)
327  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
328  valeur = inst%FLBOR_SIS%R(index1)
329  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
330  valeur = inst%MESH%X%R(index1)
331  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
332  valeur = inst%MESH%Y%R(index1)
333  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
334  valeur = inst%MESH%XNEBOR%R(index1)
335  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
336  valeur = inst%MESH%YNEBOR%R(index1)
337  ELSE IF(trim(varname).EQ.'MODEL.TIMESTEP') THEN
338  valeur = inst%DT
339  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
340  valeur = inst%TOB%R(index1)
341  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
342  valeur = inst%CHESTR%R(index1)
343  ELSE IF(trim(varname).EQ.'MODEL.D50') THEN
344  valeur = inst%D50(index1)
345  ELSE IF(trim(varname).EQ.'MODEL.CBOR_CLASSE') THEN
346  valeur = inst%CBOR_CLASSE(index1)
347  ELSE IF(trim(varname).EQ.'MODEL.MPM') THEN
348  valeur = inst%MPM
349  ELSE IF(trim(varname).EQ.'MODEL.PARTHENIADES') THEN
350  valeur = inst%PARTHENIADES
351  ELSE IF(trim(varname).EQ.'MODEL.SHIELDS') THEN
352  valeur = inst%AC(index1)
353  ELSE IF(trim(varname).EQ.'MODEL.XWC') THEN
354  valeur = inst%XWC(index1)
355  ELSE IF(trim(varname).EQ.'MODEL.POROSITY') THEN
356  valeur = inst%XKV
357  ELSE IF(trim(varname).EQ.'MODEL.KSPRATIO') THEN
358  valeur = inst%KSPRATIO
359  ELSE IF(trim(varname).EQ.'MODEL.PHISED') THEN
360  valeur = inst%PHISED
361  ELSE IF(trim(varname).EQ.'MODEL.BETA') THEN
362  valeur = inst%BETA2
363  ELSE IF(trim(varname).EQ.'MODEL.ALPHA') THEN
364  valeur = inst%ALPHA
365  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
366  valeur = inst%CS%ADR(index1)%P%R(index2)
367  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
368  valeur = inst%QBOR%ADR(index1)%P%R(index2)
369  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
370  valeur = inst%EBOR%ADR(index1)%P%R(index2)
371  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
372  valeur = inst%CBOR%ADR(index1)%P%R(index2)
373  ! <get_double>
374  ELSE
375  ierr = unknown_var_error
376  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
377  ENDIF
378 !
379  END SUBROUTINE get_double_sis_d
380 
381  !
382  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
384  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
393  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
394  SUBROUTINE set_double_sis_d
395  & (inst, varname, valeur, index1, index2, index3, ierr)
396 !
397  TYPE(instance_sis), INTENT(INOUT) :: INST
398  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
399  DOUBLE PRECISION, INTENT(IN) :: VALEUR
400  INTEGER, INTENT(IN) :: INDEX1
401  INTEGER, INTENT(IN) :: INDEX2
402  INTEGER, INTENT(IN) :: INDEX3
403  INTEGER, INTENT(OUT) :: IERR
404 !
405  ierr = 0
406 
407 !
408  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
409  inst%Q%R(index1) = valeur
410  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
411  inst%E%R(index1) = valeur
412  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
413  inst%Z%R(index1) = valeur
414  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
415  inst%ZF%R(index1) = valeur
416  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
417  inst%ZF_C%R(index1) = valeur
418  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
419  inst%FLBOR%R(index1) = valeur
420  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
421  inst%FLBOR_SIS%R(index1) = valeur
422  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
423  inst%MESH%X%R(index1) = valeur
424  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
425  inst%MESH%Y%R(index1) = valeur
426  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
427  inst%MESH%XNEBOR%R(index1) = valeur
428  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
429  inst%MESH%YNEBOR%R(index1) = valeur
430  ELSE IF(trim(varname).EQ.'MODEL.TIMESTEP') THEN
431  inst%DT = valeur
432  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
433  inst%TOB%R(index1) = valeur
434  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
435  inst%CHESTR%R(index1) = valeur
436  ELSE IF(trim(varname).EQ.'MODEL.D50') THEN
437  inst%D50(index1) = valeur
438  ELSE IF(trim(varname).EQ.'MODEL.CBOR_CLASSE') THEN
439  inst%CBOR_CLASSE(index1) = valeur
440  ELSE IF(trim(varname).EQ.'MODEL.MPM') THEN
441  inst%MPM = valeur
442  inst%MPM_ARAY%R(:) = valeur
443  ELSE IF(trim(varname).EQ.'MODEL.PARTHENIADES') THEN
444  inst%PARTHENIADES = valeur
445  ELSE IF(trim(varname).EQ.'MODEL.SHIELDS') THEN
446  inst%AC(index1) = valeur
447  ELSE IF(trim(varname).EQ.'MODEL.XWC') THEN
448  inst%XWC(index1) = valeur
449  ELSE IF(trim(varname).EQ.'MODEL.POROSITY') THEN
450  inst%XKV = valeur
451  inst%CSF_SABLE = 1 - valeur
452  ELSE IF(trim(varname).EQ.'MODEL.KSPRATIO') THEN
453  inst%KSPRATIO = valeur
454  ELSE IF(trim(varname).EQ.'MODEL.PHISED') THEN
455  inst%PHISED = valeur
456  ELSE IF(trim(varname).EQ.'MODEL.BETA') THEN
457  inst%BETA2 = valeur
458  ELSE IF(trim(varname).EQ.'MODEL.ALPHA') THEN
459  inst%ALPHA = valeur
460  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
461  inst%CS%ADR(index1)%P%R(index2) = valeur
462  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
463  inst%QBOR%ADR(index1)%P%R(index2) = valeur
464  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
465  inst%CBOR%ADR(index1)%P%R(index2) = valeur
466  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
467  inst%EBOR%ADR(index1)%P%R(index2) = valeur
468  ! <set_double>
469  ELSE
470  ierr = unknown_var_error
471  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
472  ENDIF
473 !
474  END SUBROUTINE set_double_sis_d
475 !
476  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
478  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
487  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
488  SUBROUTINE get_integer_sis_d
489  & (inst, varname, valeur, index1, index2, index3, ierr)
490 !
491  TYPE(instance_sis), INTENT(IN) :: INST
492  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
493  INTEGER, INTENT(OUT) :: VALEUR
494  INTEGER, INTENT(IN) :: INDEX1
495  INTEGER, INTENT(IN) :: INDEX2
496  INTEGER, INTENT(IN) :: INDEX3
497  INTEGER, INTENT(OUT) :: IERR
498 !
499  ierr = 0
500  valeur = -1
501  IF(trim(varname).EQ.'MODEL.LIHBOR') THEN
502  valeur = inst%LIHBOR%I(index1)
503  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
504  valeur = inst%CLU%I(index1)
505  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
506  valeur = inst%CLV%I(index1)
507  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
508  valeur = inst%LIQBOR%I(index1)
509  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
510  valeur = inst%LICBOR%I(index1)
511  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
512  valeur = inst%LIEBOR%I(index1)
513  ELSE IF(trim(varname).EQ.'MODEL.NUMLIQ') THEN
514  valeur = inst%NUMLIQ%I(index1)
515  ELSE IF(trim(varname).EQ.'MODEL.NPOIN') THEN
516  valeur = inst%MESH%NPOIN
517  ELSE IF(trim(varname).EQ.'MODEL.NELEM') THEN
518  valeur = inst%MESH%NELEM
519  ELSE IF(trim(varname).EQ.'MODEL.NPTFR') THEN
520  valeur = inst%MESH%NPTFR
521  ELSE IF(trim(varname).EQ.'MODEL.NELMAX') THEN
522  valeur = inst%MESH%NELMAX
523  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
524  valeur = inst%MESH%IKLE%I((index2-1)*inst%MESH%IKLE%DIM1
525  & + index1)
526  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
527  valeur = inst%MESH%NACHB%I((index2-1)*inst%NBMAXNSHARE
528  & + index1)
529  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
530  valeur = inst%NIT
531  ELSE IF(trim(varname).EQ.'MODEL.CURRENTSTEP') THEN
532  valeur = inst%LT
533  ELSE IF(trim(varname).EQ.'MODEL.CPL_PERIOD') THEN
534  valeur = inst%TEL%PERICOU
535  ELSE IF(trim(varname).EQ.'MODEL.NSICLA') THEN
536  valeur = inst%NSICLA
537  ! <get_integer>
538  ELSE
539  ierr = unknown_var_error
540  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
541  ENDIF
542 !
543  END SUBROUTINE get_integer_sis_d
544 
545 !
546  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
548  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
557  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
558  SUBROUTINE set_integer_sis_d
559  & (inst, varname, valeur, index1, index2, index3, ierr)
560 !
561  TYPE(instance_sis), INTENT(INOUT) :: INST
562  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
563  INTEGER, INTENT(IN) :: VALEUR
564  INTEGER, INTENT(IN) :: INDEX1
565  INTEGER, INTENT(IN) :: INDEX2
566  INTEGER, INTENT(IN) :: INDEX3
567  INTEGER, INTENT(OUT) :: IERR
568 !
569  ierr = 0
570  IF(trim(varname).EQ.'MODEL.LIHBOR') THEN
571  inst%LIHBOR%I(index1) = valeur
572  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
573  inst%CLU%I(index1) = valeur
574  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
575  inst%CLV%I(index1) = valeur
576  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
577  inst%LIQBOR%I(index1) = valeur
578  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
579  inst%LICBOR%I(index1) = valeur
580  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
581  inst%LIEBOR%I(index1) = valeur
582  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
583  inst%NIT = valeur
584  ELSE IF(trim(varname).EQ.'MODEL.NSICLA') THEN
585  inst%NSICLA = valeur
586  ! <set_integer>
587  ELSE
588  ierr = unknown_var_error
589  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
590  ENDIF
591 !
592  END SUBROUTINE set_integer_sis_d
593 !
594  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
596  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
605  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
606  SUBROUTINE get_string_sis_d
607  & (inst, varname, valeur, valuelen, index1, index2, ierr)
608 !
609  TYPE(instance_sis), INTENT(IN) :: INST
610  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
611  INTEGER, INTENT(IN) :: VALUELEN
612  INTEGER, INTENT(IN) :: INDEX1
613  INTEGER, INTENT(IN) :: INDEX2
614  CHARACTER, INTENT(OUT) :: VALEUR(valuelen)
615  INTEGER, INTENT(OUT) :: IERR
616 !
617  INTEGER I,J
618 !
619  ierr = 0
620  valeur = ""
621  IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
622  i = inst%SISRES
623  DO j = 1,250
624  valeur(j:j) = inst%SIS_FILES(i)%NAME(j:j)
625  ENDDO
626  ELSE IF(trim(varname).EQ.'MODEL.BCFILE') THEN
627  i = inst%SISCLI
628  DO j = 1,250
629  valeur(j:j) = inst%SIS_FILES(i)%NAME(j:j)
630  ENDDO
631  ELSE IF(trim(varname).EQ.'MODEL.GEOMETRYFILE') THEN
632  i = inst%SISGEO
633  DO j = 1,250
634  valeur(j:j) = inst%SIS_FILES(i)%NAME(j:j)
635  ENDDO
636  ! <get_string>
637  ELSE
638  ierr = unknown_var_error
639  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
640  ENDIF
641 !
642  END SUBROUTINE get_string_sis_d
643 
644  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
646  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
655  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
656  SUBROUTINE set_string_sis_d
657  & (inst, varname, valeur, valuelen, index1, index2, ierr)
658 !
659  TYPE(instance_sis), INTENT(INOUT) :: INST
660  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
661  INTEGER, INTENT(IN) :: VALUELEN
662  INTEGER, INTENT(IN) :: INDEX1
663  INTEGER, INTENT(IN) :: INDEX2
664  CHARACTER, INTENT(IN) :: VALEUR(valuelen)
665  INTEGER, INTENT(OUT) :: IERR
666 !
667  INTEGER I,J
668 !
669  ierr = 0
670  IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
671  i = inst%SISRES
672  DO j=1,valuelen
673  inst%SIS_FILES(i)%NAME(j:j) = valeur(j)
674  ENDDO
675  ! <set_string>
676  ELSE
677  ierr = unknown_var_error
678  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
679  ENDIF
680 !
681  END SUBROUTINE set_string_sis_d
682 
683  !
684  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
686  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
695  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
696  SUBROUTINE get_boolean_sis_d
697  & (inst, varname, valeur, index1, index2, index3, ierr)
698 !
699  TYPE(instance_sis), INTENT(IN) :: INST
700  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
701  INTEGER, INTENT(OUT) :: VALEUR
702  INTEGER, INTENT(IN) :: INDEX1
703  INTEGER, INTENT(IN) :: INDEX2
704  INTEGER, INTENT(IN) :: INDEX3
705  INTEGER, INTENT(OUT) :: IERR
706 !
707  ierr = 0
708  valeur = 0
709  IF(trim(varname).EQ.'XXXXXX') THEN
710  valeur = 0
711  ! <get_boolean>
712  ELSE
713  ierr = unknown_var_error
714  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
715  ENDIF
716 !
717  END SUBROUTINE get_boolean_sis_d
718 !
719  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
721  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
730  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
731  SUBROUTINE set_boolean_sis_d
732  & (inst, varname, valeur, index1, index2, index3, ierr)
733 !
734  TYPE(instance_sis), INTENT(INOUT) :: INST
735  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
736  INTEGER, INTENT(IN) :: VALEUR
737  INTEGER, INTENT(IN) :: INDEX1
738  INTEGER, INTENT(IN) :: INDEX2
739  INTEGER, INTENT(IN) :: INDEX3
740  INTEGER, INTENT(OUT) :: IERR
741 !
742  INTEGER DEBUG
743 !
744  ierr = 0
745  IF(trim(varname).EQ.'XXXXXX') THEN
746  debug = 1
747  ! <set_boolean>
748  ELSE
749  ierr = unknown_var_error
750  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
751  ENDIF
752 !
753  END SUBROUTINE set_boolean_sis_d
754 
755  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
757  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
766  SUBROUTINE get_var_size_sis_d
767  & (inst, varname, dim1, dim2, dim3, ierr)
768  TYPE(instance_sis), INTENT(IN) :: INST
769  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
770  INTEGER, INTENT(OUT) :: DIM1
771  INTEGER, INTENT(OUT) :: DIM2
772  INTEGER, INTENT(OUT) :: DIM3
773  INTEGER, INTENT(OUT) :: IERR
774 !
775  ierr = 0
776  dim1 = 0
777  dim2 = 0
778  dim3 = 0
779  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
780  dim1 = inst%Q%DIM1
781  ELSE IF(trim(varname).EQ.'MODEL.D50') THEN
782  dim1 = SIZE(inst%D50)
783  ELSE IF(trim(varname).EQ.'MODEL.CBOR_CLASSE') THEN
784  dim1 = SIZE(inst%CBOR_CLASSE)
785  ELSE IF(trim(varname).EQ.'MODEL.SHIELDS') THEN
786  dim1 = SIZE(inst%AC)
787  ELSE IF(trim(varname).EQ.'MODEL.XWC') THEN
788  dim1 = SIZE(inst%XWC)
789  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
790  dim1 = inst%E%DIM1
791  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
792  dim1 = inst%Z%DIM1
793  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
794  dim1 = inst%ZF%DIM1
795  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
796  dim1 = inst%ZF_C%DIM1
797  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
798  dim1 = inst%FLBOR%DIM1
799  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
800  dim1 = inst%FLBOR_SIS%DIM1
801  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
802  dim1 = inst%MESH%X%DIM1
803  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
804  dim1 = inst%MESH%Y%DIM1
805  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
806  dim1 = inst%MESH%XNEBOR%DIM1
807  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
808  dim1 = inst%MESH%YNEBOR%DIM1
809  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
810  dim1 = inst%TOB%DIM1
811  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
812  dim1 = inst%CHESTR%DIM1
813  ELSEIF(trim(varname).EQ.'MODEL.LIHBOR') THEN
814  dim1 = inst%LIHBOR%DIM1
815  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
816  dim1 = inst%CLU%DIM1
817  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
818  dim1 = inst%CLV%DIM1
819  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
820  dim1 = inst%LIQBOR%DIM1
821  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
822  dim1 = inst%LICBOR%DIM1
823  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
824  dim1 = inst%LIEBOR%DIM1
825  ELSE IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
826  dim1 = 250
827  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
828  dim1 = 0
829  ELSE IF(trim(varname).EQ.'MODEL.PARTHENIADES') THEN
830  dim1 = 0
831  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
832  dim1 = inst%MESH%IKLE%DIM2
833  dim2 = inst%MESH%IKLE%DIM1
834  ELSE IF(trim(varname).EQ.'MODEL.NACHB')THEN
835  dim1 = inst%NPTIR
836  dim2 = inst%NBMAXNSHARE
837  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
838  dim1 = inst%CS%N
839  dim2 = inst%CS%ADR(1)%P%DIM1
840  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
841  dim1 = inst%QBOR%N
842  dim2 = inst%QBOR%ADR(1)%P%DIM1
843  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
844  dim1 = inst%CBOR%N
845  dim2 = inst%CBOR%ADR(1)%P%DIM1
846  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
847  dim1 = inst%EBOR%N
848  dim2 = inst%EBOR%ADR(1)%P%DIM1
849  ! <get_var_size>
850  ELSE
851  ierr = unknown_var_error
852  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
853  ENDIF
854 !
855  END SUBROUTINE get_var_size_sis_d
856 !
857  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
859  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
862  ! BOOLEAN, STRING)
874  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
875  SUBROUTINE get_var_type_sis_d
876  & (varname, vartype, readonly, ndim, ient, jent, kent,
877  & getpos, setpos, ierr)
878 !
879  CHARACTER(LEN=SIS_VAR_LEN), INTENT(IN) :: VARNAME
880  CHARACTER(LEN=SIS_TYPE_LEN), INTENT(OUT) :: VARTYPE
881  LOGICAL, INTENT(OUT) :: READONLY
882  INTEGER, INTENT(OUT) :: NDIM
883  INTEGER, INTENT(OUT) :: IERR
884  INTEGER, INTENT(OUT) :: IENT
885  INTEGER, INTENT(OUT) :: JENT
886  INTEGER, INTENT(OUT) :: KENT
887  INTEGER, INTENT(OUT) :: GETPOS
888  INTEGER, INTENT(OUT) :: SETPOS
889 !
890  ierr = 0
891  vartype = ''
892  readonly = .true.
893  ndim = 0
894  ient = 0
895  jent = 0
896  kent = 0
897  getpos = -1
898  setpos = -1
899 !
900  IF(trim(varname).EQ.'MODEL.FLOWRATEQ') THEN
901  vartype = 'DOUBLE'
902  readonly = .false.
903  ndim = 1
904  ELSE IF(trim(varname).EQ.'MODEL.D50') THEN
905  vartype = 'DOUBLE'
906  readonly = .false.
907  ndim = 1
908  ELSE IF(trim(varname).EQ.'MODEL.CBOR_CLASSE') THEN
909  vartype = 'DOUBLE'
910  readonly = .false.
911  ndim = 1
912  ELSE IF(trim(varname).EQ.'MODEL.SHIELDS') THEN
913  vartype = 'DOUBLE'
914  readonly = .false.
915  ndim = 1
916  ELSE IF(trim(varname).EQ.'MODEL.PARTHENIADES') THEN
917  vartype = 'DOUBLE'
918  readonly = .false.
919  ndim = 0
920  ELSE IF(trim(varname).EQ.'MODEL.XWC') THEN
921  vartype = 'DOUBLE'
922  readonly = .false.
923  ndim = 1
924  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
925  vartype = 'INTEGER'
926  readonly = .false.
927  ELSE IF(trim(varname).EQ.'MODEL.EVOLUTION') THEN
928  vartype = 'DOUBLE'
929  readonly = .false.
930  ndim = 1
931  ELSE IF(trim(varname).EQ.'MODEL.Z') THEN
932  ient = 1
933  vartype = 'DOUBLE'
934  readonly = .false.
935  ndim = 1
936  ELSE IF(trim(varname).EQ.'MODEL.BOTTOMELEVATION') THEN
937  ient = 1
938  vartype = 'DOUBLE'
939  readonly = .false.
940  ndim = 1
941  ELSE IF(trim(varname).EQ.'MODEL.ZF_C') THEN
942  ient = 1
943  vartype = 'DOUBLE'
944  readonly = .false.
945  ndim = 1
946  ELSE IF(trim(varname).EQ.'MODEL.QBOR') THEN
947  vartype = 'DOUBLE'
948  readonly = .false.
949  ndim = 1
950  ELSE IF(trim(varname).EQ.'MODEL.EBOR') THEN
951  vartype = 'DOUBLE'
952  readonly = .false.
953  ndim = 1
954  ELSE IF(trim(varname).EQ.'MODEL.CBOR') THEN
955  vartype = 'DOUBLE'
956  readonly = .false.
957  ndim = 1
958  ELSE IF(trim(varname).EQ.'MODEL.FLBOR') THEN
959  vartype = 'DOUBLE'
960  readonly = .false.
961  ndim = 1
962  ELSE IF(trim(varname).EQ.'MODEL.FLBOR_SIS') THEN
963  vartype = 'DOUBLE'
964  readonly = .false.
965  ndim = 1
966  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
967  ient = 1
968  vartype = 'DOUBLE'
969  readonly = .false.
970  ndim = 1
971  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
972  ient = 1
973  vartype = 'DOUBLE'
974  readonly = .false.
975  ndim = 1
976  ELSE IF(trim(varname).EQ.'MODEL.XNEBOR') THEN
977  vartype = 'DOUBLE'
978  readonly = .false.
979  ndim = 1
980  ELSE IF(trim(varname).EQ.'MODEL.YNEBOR') THEN
981  vartype = 'DOUBLE'
982  readonly = .false.
983  ndim = 1
984  ELSE IF(trim(varname).EQ.'MODEL.TIMESTEP') THEN
985  vartype = 'DOUBLE'
986  readonly = .false.
987  ndim = 1
988  ELSE IF(trim(varname).EQ.'MODEL.TOB') THEN
989  vartype = 'DOUBLE'
990  readonly = .false.
991  ndim = 1
992  ELSE IF(trim(varname).EQ.'MODEL.CHESTR') THEN
993  ient = 1
994  vartype = 'DOUBLE'
995  readonly = .false.
996  ndim = 1
997  ELSEIF(trim(varname).EQ.'MODEL.LIHBOR') THEN
998  vartype = 'INTEGER'
999  readonly = .false.
1000  ndim = 1
1001  ELSE IF(trim(varname).EQ.'MODEL.CLU') THEN
1002  vartype = 'INTEGER'
1003  readonly = .false.
1004  ndim = 1
1005  ELSE IF(trim(varname).EQ.'MODEL.CLV') THEN
1006  vartype = 'INTEGER'
1007  readonly = .false.
1008  ndim = 1
1009  ELSE IF(trim(varname).EQ.'MODEL.LIQBOR') THEN
1010  vartype = 'INTEGER'
1011  readonly = .false.
1012  ndim = 1
1013  ELSE IF(trim(varname).EQ.'MODEL.LICBOR') THEN
1014  vartype = 'INTEGER'
1015  readonly = .false.
1016  ndim = 1
1017  ELSE IF(trim(varname).EQ.'MODEL.LIEBOR') THEN
1018  vartype = 'INTEGER'
1019  readonly = .false.
1020  ndim = 1
1021  ELSE IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
1022  vartype = 'STRING'
1023  readonly = .false.
1024  ndim = 1
1025  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
1026  vartype = 'INTEGER'
1027  readonly = .false.
1028  ndim = 2
1029  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
1030  vartype = 'INTEGER'
1031  readonly = .true.
1032  ndim = 2
1033  getpos = run_allocation_pos
1034  setpos = run_allocation_pos
1035  ELSE IF(trim(varname).EQ.'MODEL.CONCENTRATION') THEN
1036  vartype = 'DOUBLE_BLOCK'
1037  readonly = .false.
1038  ndim = 2
1039  getpos = no_position
1040  setpos = no_position
1041  ELSE IF(trim(varname).EQ.'MODEL.NSICLA') THEN
1042  vartype = 'INTEGER'
1043  readonly = .false.
1044  ndim = 0
1045  getpos = no_position
1046  setpos = no_position
1047  ! <get_var_type>
1048  ELSE
1049  ierr = unknown_var_error
1050  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
1051  ENDIF
1052 !
1053  END SUBROUTINE get_var_type_sis_d
1054 !
1055  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1057  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1065  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1066  SUBROUTINE get_var_info_sis_d(I, VAR_LEN, INFO_LEN,
1067  & VARNAME, VARINFO, IERR)
1068 !
1069  INTEGER, INTENT(IN) :: I
1070  INTEGER, INTENT(IN) :: VAR_LEN
1071  INTEGER, INTENT(IN) :: INFO_LEN
1072  CHARACTER, INTENT(OUT) :: VARNAME(var_len)
1073  CHARACTER, INTENT(OUT) :: VARINFO(info_len)
1074  INTEGER, INTENT(OUT) :: IERR
1075 !
1076  INTEGER :: J
1077 !
1078  ierr = 0
1079 
1080  DO j=1,sis_var_len
1081  varname(j:j) = vname_sis(i)(j:j)
1082  ENDDO
1083  DO j=1,sis_info_len
1084  varinfo(j:j) = vinfo_sis(i)(j:j)
1085  ENDDO
1086 
1087  RETURN
1088  END SUBROUTINE get_var_info_sis_d
1089 !
1090  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1092  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1095  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1096  SUBROUTINE set_var_list_sis_d(IERR)
1097 !
1098  INTEGER, INTENT(OUT) :: IERR
1099 !
1100  INTEGER :: I
1101 !
1102  i=0
1103  ierr = 0
1104 !
1105  IF(.NOT.ALLOCATED(vname_sis)) THEN
1106  ALLOCATE(vname_sis(nb_var_sis),stat=ierr)
1107  IF(ierr.NE.0) RETURN
1108  ALLOCATE(vinfo_sis(nb_var_sis),stat=ierr)
1109  IF(ierr.NE.0) RETURN
1110  i = i + 1
1111  vname_sis(i) = 'MODEL.FLOWRATEQ'
1112  vinfo_sis(i) = 'SOLID TRANSPORT FLOWRATE'
1113  i = i + 1
1114  vname_sis(i) = 'MODEL.D50'
1115  vinfo_sis(i) = 'MEDIAN GRAIN SIZE'
1116  i = i + 1
1117  vname_sis(i) = 'MODEL.CBOR_CLASSE'
1118  vinfo_sis(i) = 'IMPOSED CONCENTRATION IN CASE FILE'
1119  i = i + 1
1120  vname_sis(i) = 'MODEL.SHIELDS'
1121  vinfo_sis(i) = 'SHIELDS PARAMETER'
1122  i = i + 1
1123  vname_sis(i) = 'MODEL.XWC'
1124  vinfo_sis(i) = 'SETTLING VELOCITY'
1125  i = i + 1
1126  vname_sis(i) = 'MODEL.EVOLUTION'
1127  vinfo_sis(i) = 'EVOLUTION OF BED'
1128  i = i + 1
1129  vname_sis(i) = 'MODEL.PARTHENIADES'
1130  vinfo_sis(i) = 'PARTHENIADES CONSTANT'
1131  i = i + 1
1132  vname_sis(i) = 'MODEL.Z'
1133  vinfo_sis(i) = 'FREE SURFACE ELEVATION'
1134  i = i + 1
1135  vname_sis(i) = 'MODEL.BOTTOMELEVATION'
1136  vinfo_sis(i) = 'LEVEL OF THE BOTTOM'
1137  i = i + 1
1138  vname_sis(i) = 'MODEL.ZF_C'
1139  vinfo_sis(i) = 'EVOLUTION DUE TO BEDLOAD'
1140  i = i + 1
1141  vname_sis(i) = 'MODEL.QBOR'
1142  vinfo_sis(i) = 'BOUNDARY VALUE ON Q FOR EACH BOUNDARY POINT'
1143  i = i + 1
1144  vname_sis(i) = 'MODEL.EBOR'
1145  vinfo_sis(i) = 'BOUNDARY VALUE ON E FOR EACH BOUNDARY POINT'
1146  i = i + 1
1147  vname_sis(i) = 'MODEL.CBOR'
1148  vinfo_sis(i) = 'BOUNDARY VALUE ON C FOR EACH BOUNDARY POINT'
1149  i = i + 1
1150  vname_sis(i) = 'MODEL.FLBOR'
1151  vinfo_sis(i) = 'BOUNDARY VALUE ON ZF FOR EACH BOUNDARY POINT'
1152  i = i + 1
1153  vname_sis(i) = 'MODEL.FLBOR_SIS'
1154  vinfo_sis(i) = ''
1155  i = i + 1
1156  vname_sis(i) = 'MODEL.X'
1157  vinfo_sis(i) = 'X COORDINATES FOR EACH POINT OF THE MESH'
1158  i = i + 1
1159  vname_sis(i) = 'MODEL.Y'
1160  vinfo_sis(i) = 'Y COORDINATES FOR EACH POINT OF THE MESH'
1161  i = i + 1
1162  vname_sis(i) = 'MODEL.XNEBOR'
1163  vinfo_sis(i) = ''
1164  i = i + 1
1165  vname_sis(i) = 'MODEL.YNEBOR'
1166  vinfo_sis(i) = ''
1167  i = i + 1
1168  vname_sis(i) = 'MODEL.TIMESTEP'
1169  vinfo_sis(i) = 'TIME STEP'
1170  i = i + 1
1171  vname_sis(i) = 'MODEL.TOB'
1172  vinfo_sis(i) = 'SHEAR STRESS'
1173  i = i + 1
1174  vname_sis(i) = 'MODEL.CHESTR'
1175  vinfo_sis(i) = 'STRIKLER ON POINT'
1176  i = i + 1
1177  vname_sis(i) = 'MODEL.LIHBOR'
1178  vinfo_sis(i) = 'BOUNDARY TYPE ON H FOR EACH BOUNDARY POINT'
1179  i = i + 1
1180  vname_sis(i) = 'MODEL.CLU'
1181  vinfo_sis(i) = 'BOUNDARY TYPE ON U FOR EACH BOUNDARY POINT'
1182  i = i + 1
1183  vname_sis(i) = 'MODEL.CLV'
1184  vinfo_sis(i) = 'BOUNDARY TYPE ON V FOR EACH BOUNDARY POINT'
1185  i = i + 1
1186  vname_sis(i) = 'MODEL.LIQBOR'
1187  vinfo_sis(i) = 'BOUNDARY TYPE ON Q FOR EACH BOUNDARY POINT'
1188  i = i + 1
1189  vname_sis(i) = 'MODEL.LICBOR'
1190  vinfo_sis(i) = 'BOUNDARY TYPE ON C FOR EACH BOUNDARY POINT'
1191  i = i + 1
1192  vname_sis(i) = 'MODEL.LIEBOR'
1193  vinfo_sis(i) = 'BOUNDARY TYPE ON E FOR EACH BOUNDARY POINT'
1194  i = i + 1
1195  vname_sis(i) = 'MODEL.NUMLIQ'
1196  vinfo_sis(i) = 'LIQUID BOUNDARY NUMBERING'
1197  i = i + 1
1198  vname_sis(i) = 'MODEL.NPOIN'
1199  vinfo_sis(i) = 'NUMBER OF POINT IN THE MESH'
1200  i = i + 1
1201  vname_sis(i) = 'MODEL.NELEM'
1202  vinfo_sis(i) = 'NUMBER OF ELEMENT IN THE MESH'
1203  i = i + 1
1204  vname_sis(i) = 'MODEL.NPFTR'
1205  vinfo_sis(i) = 'NUMBER OF BOUNDARY POINTS'
1206  i = i + 1
1207  vname_sis(i) = 'MODEL.NELMAX'
1208  vinfo_sis(i) = 'MAXIMUM NUMBER OF ELEMENTS IN THE MESH'
1209  i = i + 1
1210  vname_sis(i) = 'MODEL.IKLE'
1211  vinfo_sis(i) = 'CONNECTIVITY TABLE OF ELEMENTS AND NODES'
1212  i = i + 1
1213  vname_sis(i) = 'MODEL.NACHB'
1214  vinfo_sis(i) = 'NUMBERS OF PROC CONTAINING A GIVEN POINT'
1215  i = i + 1
1216  vname_sis(i) = 'MODEL.NTIMESTEPS'
1217  vinfo_sis(i) = 'NUMBER OF TIME STEPS'
1218  i = i + 1
1219  vname_sis(i) = 'MODEL.CURRENTSTEP'
1220  vinfo_sis(i) = 'CURRENT TIME STEP'
1221  i = i + 1
1222  vname_sis(i) = 'MODEL.RESULTFILE'
1223  vinfo_sis(i) = 'RESULTS FILE OF THE CASE'
1224  i = i + 1
1225  vname_sis(i) = 'MODEL.BCFILE'
1226  vinfo_sis(i) = 'BOUNDARY CONDITIONS FILE OF THE CASE'
1227  i = i + 1
1228  vname_sis(i) = 'MODEL.GEOMETRYFILE'
1229  vinfo_sis(i) = 'GEOMETRY FILE OF THE CASE'
1230  i = i + 1
1231  vname_sis(i) = 'MODEL.CONCENTRATION'
1232  vinfo_sis(i) = 'CONCENTRATION AT TIME N'
1233  i = i + 1
1234  vname_sis(i) = 'MODEL.NSICLA'
1235  vinfo_sis(i) = 'NUMBER OF SIZE-CLASSES OF BED MATERIAL'
1236  ! <set_var_list>
1237  IF(i.NE.nb_var_sis) THEN
1238  ierr = increase_nb_var_sis_error
1239  RETURN
1240  ENDIF
1241  ENDIF
1242 !
1243  END SUBROUTINE set_var_list_sis_d
1244 !
1245  END MODULE api_handle_var_sis
api_handle_var_sis::get_boolean_sis_d
subroutine get_boolean_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:699
api_handle_var_sis::get_integer_array_sis_d
subroutine get_integer_array_sis_d(INST, VARNAME, VALEUR, DIM1, IERR)
Definition: api_handle_var_sis.f:209
api_handle_var_sis::vname_sis
character(len=sis_var_len), dimension(:), allocatable vname_sis
List of variable names.
Definition: api_handle_var_sis.f:20
api_handle_var_sis::set_integer_array_sis_d
subroutine set_integer_array_sis_d(INST, VARNAME, VALEUR, DIM1, IERR)
Definition: api_handle_var_sis.f:256
api_handle_var_sis::set_string_sis_d
subroutine set_string_sis_d(INST, VARNAME, VALEUR, VALUELEN, INDEX1, INDEX2, IERR)
Definition: api_handle_var_sis.f:659
api_handle_error::run_allocation_pos
integer, parameter run_allocation_pos
Definition: api_handle_error.f:34
api_handle_var_sis::sis_var_len
integer, parameter sis_var_len
Size of the string containing the name of a variable.
Definition: api_handle_var_sis.f:12
api_handle_var_sis::sis_info_len
integer, parameter sis_info_len
Size of the string containing the information about a variable.
Definition: api_handle_var_sis.f:16
api_handle_var_sis::set_double_sis_d
subroutine set_double_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:397
api_handle_error
Definition: api_handle_error.f:5
api_handle_var_sis::set_boolean_sis_d
subroutine set_boolean_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:734
api_handle_var_sis::set_integer_sis_d
subroutine set_integer_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:561
api_instance_sis
Definition: api_instance_sis.f:6
api_handle_error::index_block_missing
integer, parameter index_block_missing
Definition: api_handle_error.f:27
api_handle_error::no_position
integer, parameter no_position
Definition: api_handle_error.f:31
api_handle_var_sis::get_double_sis_d
subroutine get_double_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:304
api_handle_var_sis::get_var_info_sis_d
subroutine get_var_info_sis_d(I, VAR_LEN, INFO_LEN, VARNAME, VARINFO, IERR)
Definition: api_handle_var_sis.f:1069
api_handle_var_sis::set_var_list_sis_d
subroutine set_var_list_sis_d(IERR)
Definition: api_handle_var_sis.f:1098
api_handle_var_sis::get_integer_sis_d
subroutine get_integer_sis_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_sis.f:491
api_handle_var_sis::get_var_size_sis_d
subroutine get_var_size_sis_d(INST, VARNAME, DIM1, DIM2, DIM3, IERR)
Definition: api_handle_var_sis.f:769
api_handle_var_sis::sis_type_len
integer, parameter sis_type_len
Size of the string containing the type of a variable.
Definition: api_handle_var_sis.f:14
api_handle_error::increase_nb_var_sis_error
integer, parameter increase_nb_var_sis_error
Definition: api_handle_error.f:26
api_handle_var_sis::get_string_sis_d
subroutine get_string_sis_d(INST, VARNAME, VALEUR, VALUELEN, INDEX1, INDEX2, IERR)
Definition: api_handle_var_sis.f:609
api_handle_error::unknown_var_error
integer, parameter unknown_var_error
Definition: api_handle_error.f:21
api_handle_var_sis::get_double_array_sis_d
subroutine get_double_array_sis_d(INST, VARNAME, VALEUR, DIM1, IERR, BLOCK_INDEX)
Definition: api_handle_var_sis.f:31
api_handle_error::err_mess
character(len=error_mess_len) err_mess
Error message.
Definition: api_handle_error.f:48
api_handle_var_sis::get_var_type_sis_d
subroutine get_var_type_sis_d(VARNAME, VARTYPE, READONLY, NDIM, IENT, JENT, KENT, GETPOS, SETPOS, IERR)
Definition: api_handle_var_sis.f:879
api_handle_var_sis
Definition: api_handle_var_sis.f:6
api_handle_var_sis::vinfo_sis
character(len=sis_info_len), dimension(:), allocatable vinfo_sis
List of variable info.
Definition: api_handle_var_sis.f:22
api_handle_var_sis::set_double_array_sis_d
subroutine set_double_array_sis_d(INST, VARNAME, VALEUR, DIM1, IERR, BLOCK_INDEX)
Definition: api_handle_var_sis.f:120
api_instance_sis::instance_sis
Definition: api_instance_sis.f:45
api_handle_var_sis::nb_var_sis
integer, parameter nb_var_sis
The maximum number of variable.
Definition: api_handle_var_sis.f:18
Generated on Tue Jan 5 2021 14:34:25 for The TELEMAC-MASCARET system by doxygen 1.8.13