The TELEMAC-MASCARET system  trunk
remont.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE remont
3 ! *****************
4 !
5  &(x, xa,typexa,b,ikle,nelem,nelmax,npoin,ielm,ditr,copy,lv)
6 !
7 !***********************************************************************
8 ! BIEF V6P1 21/08/2010
9 !***********************************************************************
10 !
11 !brief SOLVES THE SYSTEM U X = B (ELEMENT BY ELEMENT).
12 !code
13 !+ THE MATRIX U IS HERE THE RESULT OF A DECOMPOSITION
14 !+ DONE IN SUBROUTINE DECLDU
15 !+
16 !+ EACH ELEMENTARY MATRIX WAS FACTORISED IN THE FORM:
17 !+
18 !+ LE X DE X UE
19 !+
20 !+ LE : LOWER TRIANGULAR WITH 1S ON THE DIAGONAL
21 !+ DE : DIAGONAL
22 !+ UE : UPPER TRIANGULAR WITH 1S ON THE DIAGONAL
23 !+
24 !+ T
25 !+ IF THE MATRIX IS SYMMETRICAL : LE = UE
26 !
27 !code
28 !+-----------------------------------------------------------------------
29 !+ MEANING OF IELM :
30 !+
31 !+ TYPE OF ELEMENT NUMBER OF POINTS CODED IN THIS SUBROUTINE
32 !+
33 !+ 11 : TRIANGLE P1 3 YES
34 !+ 12 : TRIANGLE P2 6
35 !+ 13 : TRIANGLE P1-ISO P1 6
36 !+ 14 : TRIANGLE P2 7
37 !+ 21 : QUADRILATERAL Q1 4 YES
38 !+ 22 : QUADRILATERAL Q2 8
39 !+ 24 : QUADRILATERAL Q2 9
40 !+ 31 : TETRAHEDRON P1 4
41 !+ 32 : TETRAHEDRON P2 10
42 !+ 41 : TELEMAC-3D PRISMS 6 YES
43 !+ 51 : PRISMS SPLIT IN TETRAHEDRONS 4 YES
44 !+-----------------------------------------------------------------------
45 !
46 !history J-M HERVOUET (LNH) ; F LEPEINTRE (LNH)
47 !+ 05/02/91
48 !+ V5P3
49 !+
50 !
51 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
52 !+ 13/07/2010
53 !+ V6P0
54 !+ Translation of French comments within the FORTRAN sources into
55 !+ English comments
56 !
57 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
58 !+ 21/08/2010
59 !+ V6P0
60 !+ Creation of DOXYGEN tags for automated documentation and
61 !+ cross-referencing of the FORTRAN sources
62 !
63 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
64 !| B |<--| RIGHT-HAND SIDE OF THE LINEAR SYSTEM TO BE SOLVED
65 !| COPY |-->| IF .TRUE. B IS COPIED INTO X TO START WITH
66 !| DITR |-->| CHARACTER, IF 'D' : DIRECT MATRIX A CONSIDERED
67 !| | | 'T' : TRANSPOSED MATRIX A CONSIDERED
68 !| IELM |-->| TYPE OF ELEMENT (SEE ABOVE)
69 !| IKLE |-->| CONNECTIVITY TABLE.
70 !| LV |-->| VECTOR LENGTH OF THE MACHINE
71 !| NELEM |-->| NUMBER OF ELEMENTS
72 !| NELMAX |-->| MAXIMUM NUMBER OF ELEMENTS
73 !| NPOIN |-->| NUMBER OF POINTS
74 !| TYPEXA |-->| TYPE OF OFF-DIAGONAL TERMS IN THE MATRIX
75 !| X |<--| SOLUTION OF THE SYSTEM AX = B
76 !| XA |<--| OFF-DIAGONAL TERMS OF THE MATRIX
77 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
78 !
79  USE bief, ex_remont => remont
80 !
82  IMPLICIT NONE
83 !
84 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
85 !
86  INTEGER, INTENT(IN) :: IELM,NPOIN,NELEM,NELMAX,LV
87  INTEGER, INTENT(IN) :: IKLE(nelmax,*)
88 !
89  DOUBLE PRECISION, INTENT(INOUT) :: X(npoin)
90  DOUBLE PRECISION, INTENT(IN) :: B(npoin),XA(nelmax,*)
91 !
92  CHARACTER(LEN=*), INTENT(IN) :: TYPEXA,DITR
93 !
94  LOGICAL, INTENT(IN) :: COPY
95 !
96 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
97 !
98 !
99 !-----------------------------------------------------------------------
100 !
101 ! 1) INITIALISES : X = SECOND MEMBER
102 !
103  IF(copy) CALL ov('X=Y ', x=x, y=b, dim1=npoin)
104 !
105 !-----------------------------------------------------------------------
106 !
107 ! 2) INVERTS THE UPPER TRIANGULAR MATRICES (TRACEBACK)
108 !
109 ! 2.1) TRANSPOSE CASE
110 !
111  IF(typexa(1:1).EQ.'S' .OR.
112  & (typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'D')) THEN
113 !
114  IF(ielm.EQ.11) THEN
115 !
116  CALL rem11(x,xa(1,1),xa(1,2),xa(1,3),
117  & ikle(1,1),ikle(1,2),ikle(1,3),nelem,nelmax,npoin,lv)
118 !
119  ELSEIF(ielm.EQ.21.OR.ielm.EQ.12.OR.ielm.EQ.31.OR.ielm.EQ.51) THEN
120 !
121  CALL rem21(x,xa(1,1),xa(1,2),xa(1,3),xa(1,4),xa(1,5),xa(1,6),
122  & ikle(1,1),ikle(1,2),ikle(1,3),ikle(1,4),
123  & nelem,nelmax,npoin,lv)
124 !
125  ELSEIF(ielm.EQ.41) THEN
126 !
127  CALL rem41(x,xa(1,1),xa(1,2),xa(1,3),xa(1,4) ,xa(1,5) ,xa(1,6),
128  & xa(1,7),xa(1,8),xa(1,9),xa(1,10),xa(1,11),xa(1,12),
129  & xa(1,13),xa(1,14),xa(1,15),
130  & ikle(1,1),ikle(1,2),ikle(1,3),
131  & ikle(1,4),ikle(1,5),ikle(1,6),nelem,nelmax,npoin,lv)
132 !
133 ! VALUE FOR IELM NOT PERMITTED : ERROR
134 !
135  ELSE
136 !
137  WRITE(lu,101) ielm
138 101 FORMAT(1x,'REMONT (BIEF) : IELM = ',1i6,' ELEMENT NOT AVAILABLE')
139  CALL plante(1)
140  stop
141 !
142  ENDIF
143 !
144 ! 2.2) TRANSPOSE CASE
145 !
146  ELSEIF(typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'T') THEN
147 !
148  IF(ielm.EQ.11) THEN
149 !
150  CALL rem11(x,xa(1,4),xa(1,5),xa(1,6),
151  & ikle(1,1),ikle(1,2),ikle(1,3),nelem,nelmax,npoin,lv)
152 !
153  ELSEIF(ielm.EQ.21.OR.ielm.EQ.12.OR.ielm.EQ.31.OR.ielm.EQ.51) THEN
154 !
155  CALL rem21(x,xa(1,7),xa(1,8),xa(1,9),xa(1,10),xa(1,11),xa(1,12),
156  & ikle(1,1),ikle(1,2),ikle(1,3),ikle(1,4),
157  & nelem,nelmax,npoin,lv)
158 !
159  ELSEIF(ielm.EQ.41) THEN
160 !
161  CALL rem41(x,
162  & xa(1,16),xa(1,17),xa(1,18),xa(1,19),xa(1,20),xa(1,21),
163  & xa(1,22),xa(1,23),xa(1,24),xa(1,25),xa(1,26),xa(1,27),
164  & xa(1,28),xa(1,29),xa(1,30),
165  & ikle(1,1),ikle(1,2),ikle(1,3),
166  & ikle(1,4),ikle(1,5),ikle(1,6),nelem,nelmax,npoin,lv)
167 !
168 ! VALUE FOR IELM NOT PERMITTED : ERROR
169 !
170  ELSE
171 !
172  WRITE(lu,101) ielm
173  CALL plante(1)
174  stop
175 !
176  ENDIF
177 !
178 ! 2.3) CASE NOT IMPLEMENTED
179 !
180  ELSE
181  WRITE(lu,201) typexa(1:1)
182 201 FORMAT(1x,'REMONT (BIEF) : UNEXPECTED TYPE OF MATRIX :',a1)
183  CALL plante(1)
184  stop
185  ENDIF
186 !
187 !-----------------------------------------------------------------------
188 !
189  RETURN
190  END
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
subroutine remont(X, XA, TYPEXA, B, IKLE, NELEM, NELMAX, NPOIN, IELM, DITR, COPY, LV)
Definition: remont.f:7
subroutine rem11(X, XA1, XA2, XA3, IKLE1, IKLE2, IKLE3, NELEM, NELMAX, NPOIN, LV)
Definition: rem11.f:7
subroutine rem21(X, XA1, XA2, XA3, XA4, XA5, XA6, IKLE1, IKLE2, IKLE3, IKLE4, NELEM, NELMAX, NPOIN, LV)
Definition: rem21.f:8
subroutine rem41(X, XA1, XA2, XA3, XA4, XA5, XA6, XA7, XA8, XA9, XA10, XA11, XA12, XA13, XA14, XA15, IKLE1, IKLE2, IKLE3, IKLE4, IKLE5, IKLE6, NELEM, NELMAX, NPOIN, LV)
Definition: rem41.f:11
Definition: bief.f:3