1 : C GEOLI3 SOURCE GOUNAND 05/12/21 21:27:17 5281
2 : SUBROUTINE GEOLI3(IESREL,IESREF,NDPOGO,NDELEM,JMAJAC,
3 : $ JDTJAC,
4 : $ IMPR,IRET)
5 : IMPLICIT REAL*8 (A-H,O-Z)
6 : IMPLICIT INTEGER (I-N)
7 : C***********************************************************************
8 : C NOM : GEOLI3
9 : C PROJET : Noyau linéaire NLIN
10 : C DESCRIPTION : Calcul du jacobien dans le cas où la matrice
11 : C jacobienne A n'est pas carrée. A(n,m)
12 : C On calcule sqrt (det (transpose(A) * A))
13 : C Ceci est effectué pour chaque point de Gauss d'un
14 : C élément.
15 : C
16 : C Pour calculer det (tA A), on utilise la formule suivante
17 : C déduite de celle de Binet-Cauchy :
18 : C
19 : C det(tAA) = SUM (det(A_I))^2
20 : C I
21 : C
22 : C où I parcourt tous les sous-ensembles {i_1<...CCOPTIO
62 : INTEGER IESREF,IESREL,NDPOGO,NDELEM
63 : REAL*8 JMAJAC(IESREL,IESREF,NDPOGO,NDELEM)
64 : REAL*8 JDTJAC(NDPOGO,NDELEM)
65 : *
66 : INTEGER IMPR,IRET
67 : *
68 : REAL*8 ZERO
69 : PARAMETER (ZERO=0.D0)
70 : *
71 : INTEGER IELEM,IPOGO,IREEL,JREEL
72 : REAL*8 DETCAR,DET
73 : *
74 : * Executable statements
75 : *
76 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geoli3'
77 : IF (IESREF.EQ.1) THEN
78 : DO 1 IELEM=1,NDELEM
79 : DO 12 IPOGO=1,NDPOGO
80 : DETCAR=ZERO
81 : DO 122 IREEL=1,IESREL
82 : DETCAR=DETCAR+
83 : $ (JMAJAC(IREEL,1,IPOGO,IELEM)
84 : $ *JMAJAC(IREEL,1,IPOGO,IELEM))
85 : 122 CONTINUE
86 : IF (DETCAR.GT.ZERO) THEN
87 : JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
88 : ELSE
89 : GOTO 9998
90 : ENDIF
91 : 12 CONTINUE
92 : 1 CONTINUE
93 : ELSEIF (IESREF.EQ.2) THEN
94 : DO 3 IELEM=1,NDELEM
95 : DO 32 IPOGO=1,NDPOGO
96 : DETCAR=ZERO
97 : DO 322 IREEL=1,IESREL-1
98 : DO 3222 JREEL=IREEL+1,IESREL
99 : DET=(JMAJAC(IREEL,1,IPOGO,IELEM)
100 : $ *JMAJAC(JREEL,2,IPOGO,IELEM))
101 : $ -(JMAJAC(JREEL,1,IPOGO,IELEM)
102 : $ *JMAJAC(IREEL,2,IPOGO,IELEM))
103 : DETCAR=DETCAR+(DET*DET)
104 : 3222 CONTINUE
105 : 322 CONTINUE
106 : IF (DETCAR.GT.ZERO) THEN
107 : JDTJAC(IPOGO,IELEM)=SQRT(DETCAR)
108 : ELSE
109 : GOTO 9998
110 : ENDIF
111 : 32 CONTINUE
112 : 3 CONTINUE
113 : ELSE
114 : WRITE(IOIMP,*) 'Je ne sais pas calculer la racine'
115 : WRITE(IOIMP,*) 'du det. de la matrice tAA de dimension '
116 : WRITE(IOIMP,*) 'IESREF=',IESREF
117 : ENDIF
118 : *
119 : * Normal termination
120 : *
121 : IRET=0
122 : RETURN
123 : *
124 : * Format handling
125 : *
126 : *
127 : * Error handling
128 : *
129 : 9998 CONTINUE
130 : WRITE(IOIMP,*) 'Déterminant de la matrice tAA nul ou négatif'
131 : WRITE(IOIMP,*) 'IELEM=',IELEM,' IPOGO=',IPOGO
132 : GOTO 9999
133 : 9999 CONTINUE
134 : IRET=1
135 : WRITE(IOIMP,*) 'An error was detected in subroutine geoli3'
136 : RETURN
137 : *
138 : * End of subroutine GEOLI3
139 : *
140 : END
141 :
142 :
© Cast3M 2003 - All rights reserved.
Disclaimer