The TELEMAC-MASCARET system  trunk
api_handle_var_wac.f
Go to the documentation of this file.
1 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4 !
5  MODULE api_handle_var_wac
6 
7  USE api_handle_error
8  USE api_instance_wac
9  IMPLICIT NONE
11  INTEGER, PARAMETER :: wac_var_len=40
13  INTEGER, PARAMETER :: wac_type_len=12
15  INTEGER, PARAMETER :: wac_info_len=200
17  INTEGER, PARAMETER :: nb_var_wac=16
19  CHARACTER(LEN=WAC_VAR_LEN),ALLOCATABLE :: vname_wac(:)
21  CHARACTER(LEN=WAC_INFO_LEN),ALLOCATABLE :: vinfo_wac(:)
22 !
23  CONTAINS
24 !
25  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
28  SUBROUTINE get_double_array_wac_d
29  & (inst, varname, valeur, dim1, ierr, block_index)
30 !
31  TYPE(instance_wac), INTENT(IN) :: INST
32  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
33  INTEGER, INTENT(IN) :: DIM1
34  DOUBLE PRECISION, INTENT(OUT):: VALEUR(dim1)
35  INTEGER, INTENT(OUT):: IERR
36  INTEGER, OPTIONAL, INTENT(IN) :: BLOCK_INDEX
37 !
38  ierr = 0
39 !
40  IF(trim(varname).EQ.'MODEL.X') THEN
41  valeur(1:inst%MESH%X%DIM1) = inst%MESH%X%R(1:inst%MESH%X%DIM1)
42  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
43  valeur(1:inst%MESH%Y%DIM1) = inst%MESH%Y%R(1:inst%MESH%Y%DIM1)
44  ELSE IF(trim(varname).EQ.'MODEL.BOTTOM') THEN
45  valeur(1:SIZE(inst%ZF)) =
46  & inst%ZF(1:SIZE(inst%ZF))
47  ! <get_double_array>
48  ELSE
49  ierr = unknown_var_error
50  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
51  ENDIF
52 !
53  END SUBROUTINE get_double_array_wac_d
54 !
55  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58  SUBROUTINE set_double_array_wac_d
59  & (inst, varname, valeur, dim1, ierr, block_index)
60 !
61  TYPE(instance_wac), INTENT(INOUT) :: INST
62  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
63  INTEGER, INTENT(IN) :: DIM1
64  DOUBLE PRECISION, INTENT(IN) :: VALEUR(dim1)
65  INTEGER, INTENT(OUT) :: IERR
66  INTEGER, OPTIONAL, INTENT(IN) :: BLOCK_INDEX
67 !
68  ierr = 0
69  IF(trim(varname).EQ.'MODEL.X') THEN
70  inst%MESH%X%R(1:inst%MESH%X%DIM1) = valeur(1:inst%MESH%X%DIM1)
71  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
72  inst%MESH%Y%R(1:inst%MESH%Y%DIM1) = valeur(1:inst%MESH%Y%DIM1)
73  ! <set_double_array>
74  ELSE
75  ierr = unknown_var_error
76  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
77  ENDIF
78 !
79  END SUBROUTINE set_double_array_wac_d
80 !
81  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
83  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
84  SUBROUTINE get_integer_array_wac_d
85  & (inst, varname, valeur, dim1, ierr)
86 !
87  TYPE(instance_wac), INTENT(IN) :: INST
88  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
89  INTEGER, INTENT(IN) :: DIM1
90  INTEGER, INTENT(OUT) :: VALEUR(dim1)
91  INTEGER, INTENT(OUT) :: IERR
92 !
93  ierr = 0
94  IF(trim(varname).EQ.'MODEL.IKLE') THEN
95  valeur(1:SIZE(inst%MESH%IKLE%I)) =
96  & inst%MESH%IKLE%I(1:SIZE(inst%MESH%IKLE%I))
97  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
98  valeur(1:SIZE(inst%MESH%NACHB%I)) =
99  & inst%MESH%NACHB%I(1:SIZE(inst%MESH%NACHB%I))
100  ELSE IF(trim(varname).EQ.'MODEL.KNOLG') THEN
101  valeur(1:inst%MESH%KNOLG%DIM1) =
102  & inst%MESH%KNOLG%I(1:inst%MESH%KNOLG%DIM1)
103  ! <get_integer_array>
104  ELSE
105  ierr = unknown_var_error
106  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
107  ENDIF
108 !
109  END SUBROUTINE get_integer_array_wac_d
110 !
111  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
113  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
114  SUBROUTINE set_integer_array_wac_d
115  & (inst, varname, valeur, dim1, ierr)
116 !
117  TYPE(instance_wac), INTENT(INOUT) :: INST
118  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
119  INTEGER, INTENT(IN) :: DIM1
120  INTEGER, INTENT(IN) :: VALEUR(dim1)
121  INTEGER, INTENT(OUT) :: IERR
122 !
123  ierr = 0
124  IF(trim(varname).EQ.'MODEL.IKLE') THEN
125  inst%MESH%IKLE%I(1:SIZE(inst%MESH%IKLE%I))
126  & = valeur(1:SIZE(inst%MESH%IKLE%I))
127  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
128  inst%MESH%NACHB%I(1:SIZE(inst%MESH%NACHB%I)) =
129  & valeur(1:SIZE(inst%MESH%NACHB%I))
130  ELSE IF(trim(varname).EQ.'MODEL.KNOLG') THEN
131  inst%MESH%KNOLG%I(1:inst%MESH%KNOLG%DIM1) =
132  & valeur(1:inst%MESH%KNOLG%DIM1)
133  ! <set_integer_array>
134  ELSE
135  ierr = unknown_var_error
136  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
137  ENDIF
138 !
139  END SUBROUTINE set_integer_array_wac_d
140 !
141  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
143  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
152  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153  SUBROUTINE get_double_wac_d
154  & (inst, varname, valeur, index1, index2, index3, ierr)
155 !
156  TYPE(instance_wac), INTENT(IN) :: INST
157  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
158  DOUBLE PRECISION, INTENT(OUT):: VALEUR
159  INTEGER, INTENT(IN) :: INDEX1
160  INTEGER, INTENT(IN) :: INDEX2
161  INTEGER, INTENT(IN) :: INDEX3
162  INTEGER, INTENT(OUT):: IERR
163 !
164  ierr = 0
165  valeur = 0.0
166 !
167  IF(trim(varname).EQ.'MODEL.X') THEN
168  valeur = inst%MESH%X%R(index1)
169  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
170  valeur = inst%MESH%Y%R(index1)
171  ELSE IF(trim(varname).EQ.'MODEL.BOTTOM') THEN
172  valeur = inst%ZF(index1)
173  ! <get_double>
174  ELSE
175  ierr = unknown_var_error
176  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
177  ENDIF
178 !
179  END SUBROUTINE get_double_wac_d
180 !
181  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
183  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
192  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
193  SUBROUTINE set_double_wac_d
194  & (inst, varname, valeur, index1, index2, index3, ierr)
195 !
196  TYPE(instance_wac), INTENT(INOUT) :: INST
197  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
198  DOUBLE PRECISION, INTENT(IN) :: VALEUR
199  INTEGER, INTENT(IN) :: INDEX1
200  INTEGER, INTENT(IN) :: INDEX2
201  INTEGER, INTENT(IN) :: INDEX3
202  INTEGER, INTENT(OUT) :: IERR
203 !
204  ierr = 0
205  IF(trim(varname).EQ.'xxx') THEN
206  CONTINUE
207  ELSE IF(trim(varname).EQ.'MODEL.BOTTOM') THEN
208  inst%ZF(index1) = valeur
209  ! <set_double>
210  ELSE
211  ierr = unknown_var_error
212  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
213  ENDIF
214 !
215  END SUBROUTINE set_double_wac_d
216 !
217  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
219  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
228  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229  SUBROUTINE get_integer_wac_d
230  & (inst, varname, valeur, index1, index2, index3, ierr)
231 !
232  TYPE(instance_wac), INTENT(IN) :: INST
233  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
234  INTEGER, INTENT(OUT) :: VALEUR
235  INTEGER, INTENT(IN) :: INDEX1
236  INTEGER, INTENT(IN) :: INDEX2
237  INTEGER, INTENT(IN) :: INDEX3
238  INTEGER, INTENT(OUT) :: IERR
239 !
240  ierr = 0
241  valeur = -1
242  IF(trim(varname).EQ.'MODEL.NPOIN') THEN
243  valeur = inst%MESH%NPOIN
244  ELSE IF(trim(varname).EQ.'MODEL.NELEM') THEN
245  valeur = inst%MESH%NELEM
246  ELSE IF(trim(varname).EQ.'MODEL.NPTFR') THEN
247  valeur = inst%MESH%NPTFR
248  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
249  valeur = inst%NIT
250  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
251  valeur = inst%MESH%IKLE%I((index2-1)*inst%MESH%IKLE%DIM1
252  & + index1)
253  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
254  valeur = inst%MESH%NACHB%I((index2-1)*inst%NBMAXNSHARE
255  & + index1)
256  ELSE IF(trim(varname).EQ.'MODEL.KNOLG') THEN
257  valeur = inst%MESH%KNOLG%I(index1)
258  ! <get_integer>
259  ELSE
260  ierr = unknown_var_error
261  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
262  ENDIF
263 !
264  END SUBROUTINE get_integer_wac_d
265 !
266  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
268  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
277  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278  SUBROUTINE set_integer_wac_d
279  & (inst, varname, valeur, index1, index2, index3, ierr)
280 !
281  TYPE(instance_wac), INTENT(INOUT) :: INST
282  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
283  INTEGER, INTENT(IN) :: VALEUR
284  INTEGER, INTENT(IN) :: INDEX1
285  INTEGER, INTENT(IN) :: INDEX2
286  INTEGER, INTENT(IN) :: INDEX3
287  INTEGER, INTENT(OUT) :: IERR
288 !
289  ierr = 0
290  IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
291  inst%NIT = valeur
292  ! <set_integer>
293  ELSE
294  ierr = unknown_var_error
295  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
296  ENDIF
297 !
298  END SUBROUTINE set_integer_wac_d
299 !
300  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
302  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
311  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
312  SUBROUTINE get_string_wac_d
313  & (inst, varname, valeur, valuelen, index1, index2, ierr)
314 !
315  TYPE(instance_wac), INTENT(IN) :: INST
316  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
317  INTEGER, INTENT(IN) :: VALUELEN
318  INTEGER, INTENT(IN) :: INDEX1
319  INTEGER, INTENT(IN) :: INDEX2
320  CHARACTER, INTENT(OUT) :: VALEUR(valuelen)
321  INTEGER, INTENT(OUT) :: IERR
322 !
323  INTEGER I,J
324 !
325  ierr = 0
326  valeur = ""
327  IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
328  i = inst%WACRES
329  DO j = 1,valuelen
330  valeur(j:j) = inst%WAC_FILES(i)%NAME(j:j)
331  ENDDO
332  ELSE IF(trim(varname).EQ.'MODEL.BCFILE') THEN
333  i = inst%WACCLI
334  DO j = 1,valuelen
335  valeur(j:j) = inst%WAC_FILES(i)%NAME(j:j)
336  ENDDO
337  ELSE IF(trim(varname).EQ.'MODEL.GEOMETRYFILE') THEN
338  i = inst%WACGEO
339  DO j = 1,valuelen
340  valeur(j:j) = inst%WAC_FILES(i)%NAME(j:j)
341  ENDDO
342  ! <get_string>
343  ELSE
344  ierr = unknown_var_error
345  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
346  ENDIF
347 !
348  END SUBROUTINE get_string_wac_d
349 !
350  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
352  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
361  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
362  SUBROUTINE set_string_wac_d
363  & (inst, varname, valeur, valuelen, index1, index2, ierr)
364 !
365  TYPE(instance_wac), INTENT(INOUT) :: INST
366  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
367  INTEGER, INTENT(IN) :: VALUELEN
368  INTEGER, INTENT(IN) :: INDEX1
369  INTEGER, INTENT(IN) :: INDEX2
370  CHARACTER, INTENT(IN) :: VALEUR(valuelen)
371  INTEGER, INTENT(OUT) :: IERR
372 !
373  INTEGER I,J
374 !
375  ierr = 0
376  IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
377  i = inst%WACRES
378  DO j=1,valuelen
379  inst%WAC_FILES(i)%NAME(j:j) = valeur(j)
380  ENDDO
381  ! <set_string>
382  ELSE
383  ierr = unknown_var_error
384  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
385  ENDIF
386 !
387  END SUBROUTINE set_string_wac_d
388 !
389  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
391  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
400  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
401  SUBROUTINE get_boolean_wac_d
402  & (inst, varname, valeur, index1, index2, index3, ierr)
403 !
404  TYPE(instance_wac), INTENT(IN) :: INST
405  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
406  INTEGER, INTENT(OUT) :: VALEUR
407  INTEGER, INTENT(IN) :: INDEX1
408  INTEGER, INTENT(IN) :: INDEX2
409  INTEGER, INTENT(IN) :: INDEX3
410  INTEGER, INTENT(OUT) :: IERR
411 !
412  ierr = 0
413  valeur = 0
414  IF(trim(varname).EQ.'MODEL.DEBUG') THEN
415  valeur = inst%DEBUG
416  ! <get_boolean>
417  ELSE
418  ierr = unknown_var_error
419  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
420  ENDIF
421 !
422  END SUBROUTINE get_boolean_wac_d
423 !
424  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
426  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
435  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
436  SUBROUTINE set_boolean_wac_d
437  & (inst, varname, valeur, index1, index2, index3, ierr)
438 !
439  TYPE(instance_wac), INTENT(INOUT) :: INST
440  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
441  INTEGER, INTENT(IN) :: VALEUR
442  INTEGER, INTENT(IN) :: INDEX1
443  INTEGER, INTENT(IN) :: INDEX2
444  INTEGER, INTENT(IN) :: INDEX3
445  INTEGER, INTENT(OUT) :: IERR
446 !
447  ierr = 0
448  IF(trim(varname).EQ.'MODEL.DEBUG') THEN
449  inst%DEBUG = valeur
450  ! <set_boolean>
451  ELSE
452  ierr = unknown_var_error
453  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
454  ENDIF
455 !
456  END SUBROUTINE set_boolean_wac_d
457 !
458  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
460  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
468  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
469  SUBROUTINE get_var_size_wac_d
470  & (inst, varname, dim1, dim2, dim3, ierr)
471 !
472  TYPE(instance_wac), INTENT(IN) :: INST
473  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
474  INTEGER, INTENT(OUT) :: DIM1
475  INTEGER, INTENT(OUT) :: DIM2
476  INTEGER, INTENT(OUT) :: DIM3
477  INTEGER, INTENT(OUT) :: IERR
478 !
479  ierr = 0
480  dim1 = 0
481  dim2 = 0
482  dim3 = 0
483 !
484  IF(trim(varname).EQ.'MODEL.X') THEN
485  dim1 = inst%MESH%X%DIM1
486  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
487  dim1 = inst%MESH%Y%DIM1
488  ELSE IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
489  dim1 = 250
490  ELSE IF(trim(varname).EQ.'MODEL.EQUATION') THEN
491  dim1 = 20
492  ELSE IF(trim(varname).EQ.'MODEL.GEOMETRYFILE') THEN
493  dim1 = 250
494  ELSE IF(trim(varname).EQ.'MODEL.IKLE')THEN
495  dim1 = inst%MESH%IKLE%DIM2
496  dim2 = inst%MESH%IKLE%DIM1
497  ELSE IF(trim(varname).EQ.'MODEL.NACHB')THEN
498  dim1 = inst%NPTIR
499  dim2 = inst%NBMAXNSHARE
500  ELSE IF(trim(varname).EQ.'MODEL.KNOLG') THEN
501  dim1 = inst%MESH%KNOLG%DIM1
502  ELSE IF(trim(varname).EQ.'MODEL.BOTTOM') THEN
503  dim1 = SIZE(inst%ZF)
504  ! <get_var_size>
505  ENDIF
506 !
507  END SUBROUTINE get_var_size_wac_d
508 !
509  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
511  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
514  ! BOOLEAN, STRING)
526  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
527  SUBROUTINE get_var_type_wac_d
528  & (varname, vartype, readonly, ndim,ient,jent,kent,
529  & getpos,setpos,ierr)
530 !
531  CHARACTER(LEN=WAC_VAR_LEN), INTENT(IN) :: VARNAME
532  CHARACTER(LEN=WAC_TYPE_LEN), INTENT(OUT) :: VARTYPE
533  LOGICAL, INTENT(OUT) :: READONLY
534  INTEGER, INTENT(OUT) :: NDIM
535  INTEGER, INTENT(OUT) :: IERR
536  INTEGER, INTENT(OUT) :: IENT
537  INTEGER, INTENT(OUT) :: JENT
538  INTEGER, INTENT(OUT) :: KENT
539  INTEGER, INTENT(OUT) :: GETPOS
540  INTEGER, INTENT(OUT) :: SETPOS
541 !
542  ierr = 0
543  vartype = ''
544  readonly = .true.
545  ndim = 0
546  ient = 0
547  jent = 0
548  kent = 0
549  getpos = no_position
550  setpos = no_position
551 !
552  IF(trim(varname).EQ.'MODEL.BCFILE') THEN
553  vartype = 'STRING'
554  readonly = .false.
555  ndim = 0
556  getpos = run_read_case_pos
557  setpos = run_read_case_pos
558  ELSE IF(trim(varname).EQ.'MODEL.DEBUG') THEN
559  vartype = 'INTEGER'
560  readonly = .false.
561  ndim = 0
562  getpos = run_set_config_pos
563  setpos = run_set_config_pos
564  ELSE IF(trim(varname).EQ.'MODEL.IKLE') THEN
565  vartype = 'INTEGER'
566  readonly = .true.
567  ndim = 2
568  getpos = run_allocation_pos
569  setpos = run_allocation_pos
570  ELSE IF(trim(varname).EQ.'MODEL.NACHB') THEN
571  vartype = 'INTEGER'
572  readonly = .true.
573  ndim = 2
574  getpos = run_allocation_pos
575  setpos = run_allocation_pos
576  ELSE IF(trim(varname).EQ.'MODEL.KNOLG') THEN
577  vartype = 'INTEGER'
578  readonly = .true.
579  ndim = 1
580  getpos = run_allocation_pos
581  setpos = run_allocation_pos
582  ELSE IF(trim(varname).EQ.'MODEL.X') THEN
583  vartype = 'DOUBLE'
584  readonly = .false.
585  ndim = 1
586  ient = 1
587  getpos = run_allocation_pos
588  setpos = run_allocation_pos
589  ELSE IF(trim(varname).EQ.'MODEL.Y') THEN
590  vartype = 'DOUBLE'
591  readonly = .false.
592  ndim = 1
593  ient = 1
594  getpos = run_allocation_pos
595  setpos = run_allocation_pos
596  ELSE IF(trim(varname).EQ.'MODEL.RESULTFILE') THEN
597  vartype = 'STRING'
598  readonly = .false.
599  ndim = 1
600  getpos = run_allocation_pos
601  setpos = run_allocation_pos
602  ELSE IF(trim(varname).EQ.'MODEL.GEOMETRYFILE') THEN
603  vartype = 'STRING'
604  readonly = .false.
605  ndim = 1
606  getpos = run_allocation_pos
607  setpos = run_allocation_pos
608  ELSE IF(trim(varname).EQ.'MODEL.NPOIN') THEN
609  vartype = 'INTEGER'
610  readonly = .false.
611  getpos = run_allocation_pos
612  setpos = run_allocation_pos
613  ELSE IF(trim(varname).EQ.'MODEL.NELEM') THEN
614  vartype = 'INTEGER'
615  readonly = .false.
616  getpos = run_allocation_pos
617  setpos = run_allocation_pos
618  ELSE IF(trim(varname).EQ.'MODEL.NELMAX') THEN
619  vartype = 'INTEGER'
620  readonly = .false.
621  getpos = run_allocation_pos
622  setpos = run_allocation_pos
623  ELSE IF(trim(varname).EQ.'MODEL.NPTFR') THEN
624  vartype = 'INTEGER'
625  readonly = .false.
626  getpos = run_allocation_pos
627  setpos = run_allocation_pos
628  ELSE IF(trim(varname).EQ.'MODEL.NTIMESTEPS') THEN
629  vartype = 'INTEGER'
630  readonly = .false.
631  ndim = 0
632  getpos = run_read_case_pos
633  setpos = run_read_case_pos
634  ELSE IF(trim(varname).EQ.'MODEL.BOTTOM') THEN
635  vartype = 'DOUBLE'
636  readonly = .false.
637  ndim = 1
638  getpos = no_position
639  setpos = no_position
640  ! <get_var_type>
641  ELSE
642  ierr = unknown_var_error
643  err_mess = 'UNKNOWN VARIABLE NAME : '//trim(varname)
644  ENDIF
645 !
646  END SUBROUTINE get_var_type_wac_d
647 !
648  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
650  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
658  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
659  SUBROUTINE get_var_info_wac_d(I, VAR_LEN, INFO_LEN,
660  & VARNAME, VARINFO, IERR)
661 !
662  INTEGER, INTENT(IN) :: I
663  INTEGER, INTENT(IN) :: VAR_LEN
664  INTEGER, INTENT(IN) :: INFO_LEN
665  CHARACTER, INTENT(OUT) :: VARNAME(var_len)
666  CHARACTER, INTENT(OUT) :: VARINFO(info_len)
667  INTEGER, INTENT(OUT) :: IERR
668 !
669  INTEGER :: J
670 !
671  ierr = 0
672 
673  DO j=1,wac_var_len
674  varname(j:j) = vname_wac(i)(j:j)
675  ENDDO
676  DO j=1,wac_info_len
677  varinfo(j:j) = vinfo_wac(i)(j:j)
678  ENDDO
679 
680  RETURN
681  END SUBROUTINE get_var_info_wac_d
682 !
683  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
685  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
688  !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
689  SUBROUTINE set_var_list_wac_d(IERR)
690 !
691  INTEGER, INTENT(OUT) :: IERR
692 !
693  INTEGER :: I
694 !
695  i=0
696  ierr = 0
697  IF(.NOT.ALLOCATED(vname_wac)) THEN
698  ALLOCATE(vname_wac(nb_var_wac),stat=ierr)
699  IF(ierr.NE.0) RETURN
700  ALLOCATE(vinfo_wac(nb_var_wac),stat=ierr)
701  IF(ierr.NE.0) RETURN
702 !
703  i = i + 1
704  vname_wac(i) = 'MODEL.BCFILE'
705  vinfo_wac(i) = 'BOUNDARY CONDITION FILE NAME'
706  i = i + 1
707  vname_wac(i) = 'MODEL.DEBUG'
708  vinfo_wac(i) = 'ACTIVATING DEBUG MODE'
709  i = i + 1
710  vname_wac(i) = 'MODEL.GEOMETRYFILE'
711  vinfo_wac(i) = 'NAME OF THE GEOMERY FILE'
712  i = i + 1
713  vname_wac(i) = 'MODEL.IKLE'
714  vinfo_wac(i) = 'CONNECTIVITY TABLE BETWEEN ELEMENT AND NODES'
715  i = i + 1
716  vname_wac(i) = 'MODEL.NACHB'
717  vinfo_wac(i) = 'NUMBERS OF PROC CONTAINING A GIVEN POINT'
718  i = i + 1
719  vname_wac(i) = 'MODEL.KNOLG'
720  vinfo_wac(i) =
721  & 'GIVES THE INITIAL GLOBAL NUMBER OF A LOCAL POINT'
722  i = i + 1
723  vname_wac(i) = 'MODEL.NELEM'
724  vinfo_wac(i) = 'NUMBER OF ELEMENT IN THE MESH'
725  i = i + 1
726  vname_wac(i) = 'MODEL.NELMAX'
727  vinfo_wac(i) = 'MAXIMUM NUMBER OF ELEMENTS ENVISAGED'
728  i = i + 1
729  vname_wac(i) = 'MODEL.NPOIN'
730  vinfo_wac(i) = 'NUMBER OF POINT IN THE MESH'
731  i = i + 1
732  vname_wac(i) = 'MODEL.NPTFR'
733  vinfo_wac(i) = 'NUMBER OF BOUNDARY POINTS'
734  i = i + 1
735  vname_wac(i) = 'MODEL.NTIMESTEPS'
736  vinfo_wac(i) = 'NUMBER OF TIME STEPS'
737  i = i + 1
738  vname_wac(i) = 'MODEL.RESULTFILE'
739  vinfo_wac(i) = 'NAME OF THE RESULT FILE'
740  i = i + 1
741  vname_wac(i) = 'MODEL.X'
742  vinfo_wac(i) = 'X COORDINATES FOR EACH POINT OF THE MESH'
743  i = i + 1
744  vname_wac(i) = 'MODEL.Y'
745  vinfo_wac(i) = 'Y COORDINATES FOR EACH POINT OF THE MESH'
746  i = i + 1
747  vname_wac(i) = 'MODEL.BOTTOM'
748  vinfo_wac(i) = 'BOTTOM'
749  i = i + 1
750  vname_wac(i) = 'MODEL.EQUATION'
751  vinfo_wac(i) = 'NAME OF THE EQUATION USED IN THE CODE'
752  ! <set_var_list>
753  IF(i.NE.nb_var_wac) THEN
754  ierr = increase_nb_var_wac_error
755  RETURN
756  ENDIF
757  ENDIF
758 !
759  END SUBROUTINE set_var_list_wac_d
760 !
761  END MODULE api_handle_var_wac
api_handle_var_wac::set_integer_wac_d
subroutine set_integer_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:281
api_handle_error::run_set_config_pos
integer, parameter run_set_config_pos
Definition: api_handle_error.f:32
api_handle_error::run_allocation_pos
integer, parameter run_allocation_pos
Definition: api_handle_error.f:34
api_handle_error::run_read_case_pos
integer, parameter run_read_case_pos
Definition: api_handle_error.f:33
api_handle_var_wac::get_boolean_wac_d
subroutine get_boolean_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:404
api_handle_var_wac
Definition: api_handle_var_wac.f:6
api_handle_var_wac::set_integer_array_wac_d
subroutine set_integer_array_wac_d(INST, VARNAME, VALEUR, DIM1, IERR)
Definition: api_handle_var_wac.f:117
api_handle_var_wac::get_double_wac_d
subroutine get_double_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:156
api_handle_var_wac::set_double_wac_d
subroutine set_double_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:196
api_handle_var_wac::set_boolean_wac_d
subroutine set_boolean_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:439
api_handle_var_wac::wac_var_len
integer, parameter wac_var_len
Size of the string containing the name of a variable.
Definition: api_handle_var_wac.f:12
api_instance_wac
Definition: api_instance_wac.f:6
api_handle_var_wac::get_var_size_wac_d
subroutine get_var_size_wac_d(INST, VARNAME, DIM1, DIM2, DIM3, IERR)
Definition: api_handle_var_wac.f:472
api_handle_var_wac::get_double_array_wac_d
subroutine get_double_array_wac_d(INST, VARNAME, VALEUR, DIM1, IERR, BLOCK_INDEX)
Definition: api_handle_var_wac.f:31
api_handle_error
Definition: api_handle_error.f:5
api_handle_error::increase_nb_var_wac_error
integer, parameter increase_nb_var_wac_error
Definition: api_handle_error.f:25
api_handle_var_wac::set_double_array_wac_d
subroutine set_double_array_wac_d(INST, VARNAME, VALEUR, DIM1, IERR, BLOCK_INDEX)
Definition: api_handle_var_wac.f:61
api_handle_var_wac::get_var_type_wac_d
subroutine get_var_type_wac_d(VARNAME, VARTYPE, READONLY, NDIM, IENT, JENT, KENT, GETPOS, SETPOS, IERR)
Definition: api_handle_var_wac.f:531
api_handle_var_wac::vinfo_wac
character(len=wac_info_len), dimension(:), allocatable vinfo_wac
List of variable info.
Definition: api_handle_var_wac.f:22
api_handle_var_wac::get_integer_array_wac_d
subroutine get_integer_array_wac_d(INST, VARNAME, VALEUR, DIM1, IERR)
Definition: api_handle_var_wac.f:87
api_handle_var_wac::get_string_wac_d
subroutine get_string_wac_d(INST, VARNAME, VALEUR, VALUELEN, INDEX1, INDEX2, IERR)
Definition: api_handle_var_wac.f:315
api_handle_error::no_position
integer, parameter no_position
Definition: api_handle_error.f:31
api_handle_var_wac::nb_var_wac
integer, parameter nb_var_wac
The maximum number of variable.
Definition: api_handle_var_wac.f:18
api_handle_var_wac::wac_info_len
integer, parameter wac_info_len
Size of the string containing the information about a variable.
Definition: api_handle_var_wac.f:16
api_handle_var_wac::set_var_list_wac_d
subroutine set_var_list_wac_d(IERR)
Definition: api_handle_var_wac.f:691
api_handle_var_wac::wac_type_len
integer, parameter wac_type_len
Size of the string containing the type of a variable.
Definition: api_handle_var_wac.f:14
api_instance_wac::instance_wac
Definition: api_instance_wac.f:24
api_handle_var_wac::get_var_info_wac_d
subroutine get_var_info_wac_d(I, VAR_LEN, INFO_LEN, VARNAME, VARINFO, IERR)
Definition: api_handle_var_wac.f:662
api_handle_error::unknown_var_error
integer, parameter unknown_var_error
Definition: api_handle_error.f:21
api_handle_error::err_mess
character(len=error_mess_len) err_mess
Error message.
Definition: api_handle_error.f:48
api_handle_var_wac::get_integer_wac_d
subroutine get_integer_wac_d(INST, VARNAME, VALEUR, INDEX1, INDEX2, INDEX3, IERR)
Definition: api_handle_var_wac.f:232
api_handle_var_wac::vname_wac
character(len=wac_var_len), dimension(:), allocatable vname_wac
List of variable names.
Definition: api_handle_var_wac.f:20
api_handle_var_wac::set_string_wac_d
subroutine set_string_wac_d(INST, VARNAME, VALEUR, VALUELEN, INDEX1, INDEX2, IERR)
Definition: api_handle_var_wac.f:365
Generated on Tue Jan 5 2021 14:34:27 for The TELEMAC-MASCARET system by doxygen 1.8.13