The TELEMAC-MASCARET system  trunk
bief_allvec.f
Go to the documentation of this file.
1 ! **********************
2  SUBROUTINE bief_allvec
3 ! **********************
4 !
5  &( nat , vec , nom , ielm , dim2 , statut , mesh )
6 !
7 !***********************************************************************
8 ! BIEF V7P3
9 !***********************************************************************
10 !
11 !brief ALLOCATES MEMORY FOR A VECTOR STRUCTURE.
12 !
13 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
14 !+ 13/07/2010
15 !+ V6P0
16 !+ Translation of French comments within the FORTRAN sources into
17 !+ English comments
18 !
19 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
20 !+ 21/08/2010
21 !+ V6P0
22 !+ Creation of DOXYGEN tags for automated documentation and
23 !+ cross-referencing of the FORTRAN sources
24 
25 !history R.NHEILI (Universite de Perpignan, DALI)
26 !+ 24/02/2016
27 !+ V7P3
28 !+ ALLOCATE THE ELEMENT E IN THE VECTOR STUCTURE (BIEF_OBJ)
29 !
30 !history J-M HERVOUET (EDF LAB, LNHE)
31 !+ 21/01/2016
32 !+ V7P2
33 !+ Adding NAT = 3. With both integers and doube precision arrays
34 !+ allocated
35 !
36 !history J-M HERVOUET (jubilado)
37 !+ 07/09/2017
38 !+ V7P3
39 !+ Allowing several successive allocations of the same BIEF_OBJ.
40 !
41 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
42 !| DIM2 |-->| SECOND DIMENSION OF VECTOR
43 !| IELM |-->| TYPE OF ELEMENT, OR DIMENSION
44 !| | | (DEPENDING ON 'STATUT')
45 !| NAT |<--| 1: DOUBLE PRECISION 2:VECTOR OF INTEGERS
46 !| | | 3: DOUBLE PRECISION AND VECTOR OF INTEGERS
47 !| NOM |-->| FORTRAN NAME
48 !| REFINE |-->| NUMBER OF REFINEMENT LEVELS
49 !| STATUT |-->| VECTOR STATUS:
50 !| | | 0 : FREE VECTOR, IELM IS ITS DIMENSION
51 !| | | 1 : VECTOR DEFINED ON A MESH
52 !| | | IELM IS THEN THE ELEMENT TYPE
53 !| | | CHANGING DISCRETISATION FORBIDDEN
54 !| | | 2 : LIKE 1 BUT CHANGING DISCRETISATION ALLOWED
55 !| VEC |<--| VECTOR TO BE ALLOCATED
56 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 !
58  USE bief, ex_bief_allvec => bief_allvec
59  USE declarations_telemac, ONLY : modass
60 !
62  IMPLICIT NONE
63 !
64 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
65 !
66  TYPE(bief_obj) , INTENT(INOUT) :: VEC
67  INTEGER , INTENT(IN) :: NAT,IELM,DIM2,STATUT
68  CHARACTER(LEN=6), INTENT(IN) :: NOM
69  TYPE(bief_mesh) , INTENT(IN) :: MESH
70 !
71 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
72 !
73  INTEGER ERR,IMAX,I
74  LOGICAL INIT
75  DOUBLE PRECISION XMAX
76 !
77  INTRINSIC max
78 !
79  err = 0
80 !
81 !-----------------------------------------------------------------------
82 ! HEADER COMMON TO ALL OBJECTS
83 !-----------------------------------------------------------------------
84 !
85 ! KEY OF THE OBJECT - TO CHECK MEMORY CRASHES
86 !
87  vec%KEY = 123456
88 !
89 ! TYPE OF THE OBJECT (HERE VECTOR)
90 !
91  vec%TYPE = 2
92 !
93 ! Defines how the object was created
94 !
95  vec%FATHER = 'XXXXXX'
96 !
97 ! NAME OF THE OBJECT
98 !
99  vec%NAME = nom
100 !
101 !-----------------------------------------------------------------------
102 ! PART SPECIFIC TO VECTORS
103 !-----------------------------------------------------------------------
104 !
105 ! NATURE
106 !
107  vec%NAT = nat
108 !
109 ! MAXIMUM SIZE PER DIMENSION
110 !
111  IF(statut.EQ.1.OR.statut.EQ.2) THEN
112  vec%MAXDIM1 = bief_nbmpts(ielm,mesh)
113  ELSE
114  vec%MAXDIM1 = ielm
115  ENDIF
116 !
117 ! VEC%MAXDIM1 MUST BE AT LEAST 1
118 ! TO AVOID BOUND CHECKING ERRORS ON SOME COMPILERS
119 !
120  vec%MAXDIM1=max(vec%MAXDIM1,1)
121 !
122 ! DISCRETISES
123 !
124  IF(statut.EQ.1.OR.statut.EQ.2) THEN
125  vec%ELM = ielm
126  ELSE
127  vec%ELM = -1000
128  ENDIF
129 !
130 ! FIRST DIMENSION OF VECTOR
131 !
132  IF(statut.EQ.1.OR.statut.EQ.2) THEN
133  vec%DIM1 = bief_nbpts(ielm,mesh)
134  ELSE
135  vec%DIM1 = ielm
136  ENDIF
137 !
138 ! SECOND DIMENSION OF VECTOR (VEC%DIM2 MAY BE CHANGED)
139 !
140  vec%DIM2 = dim2
141  vec%MAXDIM2 = dim2
142 !
143 ! CASE OF DISCONTINUITY BETWEEN ELEMENTS
144 ! (SEE CORRSL, VC13AA, VC13BB)
145 !
146  vec%DIMDISC = 0
147 !
148 ! STATUS
149 !
150  vec%STATUS = statut
151 !
152 ! INFORMATION ON CONTENT
153 !
154  vec%TYPR = '?'
155  vec%TYPI = '?'
156 !
157 ! DYNAMICALLY ALLOCATES MEMORY (REAL AND/OR INTEGER, DEPENDING OF NAT)
158 !
159  IF(nat.EQ.1.OR.nat.EQ.3) THEN
160 !
161  init=.false.
162  IF(.NOT.ASSOCIATED(vec%R)) THEN
163  ALLOCATE(vec%R(vec%MAXDIM1*vec%DIM2),stat=err)
164  init=.true.
165  ELSEIF(SIZE(vec%R).LT.vec%MAXDIM1*vec%DIM2) THEN
166  WRITE(lu,*) 'DEALLOCATING AND REALLOCATING %R OF ',
167  & vec%NAME,vec%MAXDIM1,vec%DIM2,SIZE(vec%R)
168  DEALLOCATE(vec%R)
169  ALLOCATE(vec%R(vec%MAXDIM1*vec%DIM2),stat=err)
170  init=.true.
171  ENDIF
172  CALL check_allocate(err,'VECTOR '//vec%NAME//'%R')
173 !
174 ! FILLS ARRAY WITH BIG NUMBERS
175 ! TO RAISE QUESTIONS IF NOT INITIALISED
176 !
177  IF(init) THEN
178  xmax = huge(100.d0)
179  CALL ov('X=C ', x=vec%R, c=xmax,
180  & dim1=vec%MAXDIM1*vec%DIM2)
181  ENDIF
182 !
183  IF(modass .EQ.3) THEN
184  ALLOCATE(vec%E(vec%MAXDIM1*vec%DIM2),stat=err)
185  CALL ov('X=C ', x=vec%E, c=0.d0,
186  & dim1=vec%MAXDIM1*vec%DIM2)
187  ENDIF
188 !
189 !
190  ENDIF
191 !
192  IF(nat.EQ.2.OR.nat.EQ.3) THEN
193 !
194  init=.false.
195  IF(.NOT.ASSOCIATED(vec%I)) THEN
196  ALLOCATE(vec%I(vec%MAXDIM1*vec%DIM2),stat=err)
197  init=.true.
198  ELSEIF(SIZE(vec%I).LT.vec%MAXDIM1*vec%DIM2) THEN
199  WRITE(lu,*) 'REALLOCATING %I OF ',vec%NAME
200  WRITE(lu,*) 'OLD SIZE: ',SIZE(vec%I)
201  WRITE(lu,*) 'NEW SIZE: ',vec%MAXDIM1*vec%DIM2
202  DEALLOCATE(vec%I)
203  ALLOCATE(vec%I(vec%MAXDIM1*vec%DIM2),stat=err)
204  init=.true.
205  ENDIF
206  CALL check_allocate(err,'VECTOR '//vec%NAME//'%I')
207 !
208 ! FILLS ARRAY WITH BIG NUMBERS
209 ! TO RAISE QUESTIONS IF NOT INITIALISED
210 !
211  IF(init) THEN
212  imax = huge(100)
213  DO i=1,vec%MAXDIM1*vec%DIM2
214  vec%I(i) = imax
215  ENDDO
216  ENDIF
217 !
218  ENDIF
219 !
220  IF(nat.EQ.1) THEN
221  NULLIFY(vec%I)
222  ELSEIF(nat.EQ.2) THEN
223  NULLIFY(vec%R)
224  ELSEIF(nat.NE.3) THEN
225  WRITE(lu,*) 'UNKNOWN NAT IN ALLVEC:',nat
226  CALL plante(1)
227  stop
228  ENDIF
229 !
230 !-----------------------------------------------------------------------
231 !
232  RETURN
233  END
234 
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
integer function bief_nbpts(IELM, MESH)
Definition: bief_nbpts.f:7
subroutine bief_allvec(NAT, VEC, NOM, IELM, DIM2, STATUT, MESH)
Definition: bief_allvec.f:7
integer function bief_nbmpts(IELM, MESH)
Definition: bief_nbmpts.f:7
Definition: bief.f:3