1 : C ITINV SOURCE CHAT 05/01/13 00:45:00 5004
2 : SUBROUTINE ITINV (IPA,IPB,IPX,PROPRE,CONVRG,ITERMX,NUMACC,PRECI1
3 : & ,PRECI2,IPMX)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8 (A-H,O-Z)
6 : ************************************************************************
7 : *
8 : * I T I N V
9 : * ---------
10 : *
11 : * FONCTION:
12 : * ---------
13 : *
14 : * RESOUDRE, PAR ITERATIONS INVERSES, UN SYSTEME D'EQUATIONS:
15 : * |A|.(X) = V.|B|.(X)
16 : * |A| ET |B| ETANT 2 'RIGIDITE',
17 : * (X) UN 'CHPOINT' A DETERMINER ET
18 : * V UN 'FLOTTANT' EGALEMENT A DETERMINER.
19 : *
20 : * ("ITINV" VAUT POUR IT-ERATIONS INV-ERSES)
21 : *
22 : * MODE D'APPEL:
23 : * -------------
24 : *
24 : * CALL ITINV (IPA,IPB,IPX,PROPRE,CONVRG,ITERMX,NUMACC,PRECI1,PRECI2)
25 : *
26 : * PARAMETRES: (E)=ENTREE (S)=SORTIE
27 : * -----------
28 : *
29 : * IPA ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' |A|.
30 : * IPB ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' |B|.
31 : * IPX ENTIER (E) POINTEUR DE L'OBJET 'CHPOINT' DE DEPART.
32 : * (S) POINTEUR DE L'OBJET 'CHPOINT' SOLUTION.
33 : * PROPRE REEL DP (S) TABLEAU CONTENANT DES CARACTERISTIQUES DU
34 : * MODE PROPRE CALCULE. ACTUELLEMENT,
35 : * PROPRE(1) = "VALPP" ,
36 : * PROPRE(2) = (X)T.|B|.(X) , (X) 'CHPOINT'
37 : * SOLUTION,
38 : * PROPRE(3)ET(4) ET(5) DEPL.GEN. SELON X,Y,Z
39 : * CONVRG LOGIQUE (S) INDIQUE PAR .TRUE. OU .FALSE. SI LA
40 : * CONVERGENCE A EU LIEU OU NON.
41 : * ITERMX ENTIER (E) NOMBRE MAXIMUM D'ITERATIONS PERMIS.
42 : * NUMACC ENTIER (E) L'ACCELERATION DE CONVERGENCE A LIEU 1
43 : * FOIS TOUTES LES "NUMACC" ITERATIONS.
44 : * PRECI1 REEL SP (E) CONSTANTE DONNANT LA PRECISION DE
45 : * CONVERGENCE DES VALEURS DU 'CHPOINT' "X".
46 : * PRECI2 REEL SP (E) CONSTANTE DONNANT LA PRECISION DE
47 : * CONVERGENCE DU SCALAIRE "XT.B.X"
48 : *
49 : * LEXIQUE: (ORDRE ALPHABETIQUE)
50 : * --------
51 : *
52 : * DIFREL REEL SP VOIR LE S.P. "ITINV1".
53 : * IACCEL ENTIER NOMBRE D'ITERATIONS CONSECUTIVES EFFECTUEES
54 : * SANS ACCELERATION DE CONVERGENCE.
55 : * IPX0 ENTIER VOIR LE S.P. "ITINV1".
56 : * IPX1 ENTIER VOIR LE S.P. "ITINV1".
57 : * IPX2 ENTIER VOIR LE S.P. "ITINV1".
58 : * NBITER ENTIER NOMBRE D'ITERATIONS EFFECTUEES.
59 : * NUMXBX ENTIER NUMERO DE LA DERNIERE ITERATION OU L'ON A
60 : * CALCULE "XT.B.X" POUR 2 'CHPOINT' ITERES
61 : * CONSECUTIFS.
62 : * VALPP REEL DP VALEUR PROPRE ASSOCIEE AU 'CHPOINT' SOLUTION.
63 : *
64 : * MODE DE FONCTIONNEMENT:
65 : * -----------------------
66 : *
67 : * METHODE DES ITERATIONS INVERSES:
68 : *
69 : * LA SUITE "(X)I" TELLE QUE:
70 : * |A| . (X)I+1 = |B| . (X)I
71 : * TEND VERS LA (OU UNE DES) SOLUTION(S) DE:
72 : * |A| . (X) = V . |B| . (X)
73 : * CORRESPONDANT AU PLUS PETIT V SOLUTION (EN VALEUR ABSOLUE) SOUS
74 : * RESERVE QUE LE (X)1 DE DEPART N'EST PAS B-ORTHOGONAL AU (X)
75 : * SOLUTION.
76 : *
77 : * SOUS-PROGRAMMES APPELES:
78 : * ------------------------
79 : *
80 : * DTCHPO, ITINV1, XTMX, YTX1 (?), VRFMOD,DEPGEN ,DTCHPM
81 : *
82 : * AUTEUR, DATE DE CREATION:
83 : * -------------------------
84 : *
85 : * PASCAL MANIGOT 19 DECEMBRE 1984
86 : *
87 : * LANGAGE:
88 : * --------
89 : *
90 : * FORTRAN77
91 : *
92 : ************************************************************************
93 : *
94 : -INC CCOPTIO
95 : -INC SMLMOTS
96 : *
97 : REAL*8 PROPRE(*)
98 : *
99 : COMMON/CITINV/ NBITER,IACCEL,NUMAC,IPX2,IPX0,IPX1,IPBX1,
100 : C IBBX1,IBBX2,ITPRO,DIFREL
101 : *
102 : LOGICAL CONVRG
103 : *
104 : PARAMETER (INFINI = 9999)
105 : *
106 : IF (IIMPI .EQ. 747) THEN
106 : CALL GIBTEM(XKT)
107 : INTERR(1)=XKT
107 : CALL ERREUR(-259)
108 : ENDIF
109 : *
110 : * PREPARATION DES ITERATIONS:
111 : IBBX1=0
112 : IBBX2 = IPMX
113 : IPX2 = IPX
114 : NUMAC = NUMACC
115 : NBITER = 0
116 : IACCEL = 0
117 : NUMXBX = -10
118 : X1BX1 = 1.D10
119 : IPLMOX=0
120 : IPLMOY=0
121 : C
122 : C PREPARATION DES TABLEAUX DONNANT LA CORRESPONDANCE DES NOMS
123 : C D INCONNUE DANS X ET MX STOCKE DANS UN LIST MOT
124 : C
124 : CALL CORRSP(ipa,IPX,IPMX,IPLMOX,IPLMOY)
125 : C
126 : C
127 : C
128 : *
129 : * -- DEBUT DES ITERATIONS INVERSES --
130 : *
131 : DIFREL = 1.E10
132 : 205 IF (DIFREL .GT. PRECI1 .AND. NBITER .LT. ITERMX) THEN
132 : IF (IBBX1.NE.0) CALL DTCHPO(IBBX1)
133 : IBBX1 = IBBX2
133 : CALL ITINV1 (IPA,IPB)
134 : IF (IERR .NE. 0) RETURN
135 : GOTO 205
136 : END IF
137 : *
138 : DO 300 IB300=1,INFINI
139 : *
140 : * -- CALCUL DE "XT.B.X" POUR 2 ITERES --
141 : *
142 : IF (NBITER .LT. ITERMX) THEN
143 : IF (NBITER .EQ. (NUMXBX + 1) ) THEN
144 : X1BX1 = X2BX2
145 : ELSE
146 : * PRODUIT SCALAIRE X1.(M.X1) :
146 : C CALL XTMX (IPX1,IPB, X1BX1)
146 : CALL XTY1 (IPX1,IBBX1,IPLMOX,IPLMOY,X1BX1)
147 : IF (IERR .NE. 0) RETURN
148 : END IF
149 : END IF
150 : *
151 : * PRODUIT X2T.B.X2 :
151 : CALL XTY1(IPX2,IBBX2,IPLMOX,IPLMOY,X2BX2)
152 : IF (IERR .NE. 0) RETURN
153 : NUMXBX = NBITER
154 : *
155 : DIFXBX = ABS(1.D0 - ABS(X1BX1 / X2BX2) )
156 : *
157 : IF (DIFREL .LE. PRECI1 .AND. DIFXBX .LE. PRECI2) THEN
158 : CONVRG = .TRUE.
159 : * --> SORTIE DE BOUCLE N.300
160 : GOTO 302
161 : ELSE IF (NBITER .GE. ITERMX) THEN
162 : CONVRG = .FALSE.
163 : * --> SORTIE DE BOUCLE N.300
164 : GOTO 302
165 : ELSE
165 : CALL DTCHPO(IBBX1)
166 : IBBX1 = IBBX2
166 : CALL ITINV1 (IPA,IPB)
167 : IF (IERR .NE. 0) RETURN
168 : END IF
169 : *
170 : 300 CONTINUE
171 : * END DO
172 : 302 CONTINUE
173 : *
174 : IF (IIMPI.EQ.2) WRITE (IOIMP,2000) NBITER
175 : 2000 FORMAT (//,1X,I3,' ITERATIONS INVERSES ONT ETE EFFECTUEES.'///)
176 : *
177 : * -- RETOUR DU MODE PROPRE --
178 : *
178 : C CALL XTMX (IPX2,IPA, X2AX2)
178 : CALL MUCPRI(IPX2,IPA,IPAX2)
179 :
179 : CALL XTY1(IPX2,IPAX2,IPLMOX,IPLMOY,X2AX2)
180 : IF (IERR .NE. 0) RETURN
181 : VALPP = X2AX2 / X2BX2
182 : *
183 : PROPRE(1) = VALPP
184 : PROPRE(2) = X2BX2
185 : IPX = IPX2
186 : C
187 : C CALCUL DES MASSES GEN. INTRODUCTION DES COEF. PI OU 2PI
188 : C EVENTUELS
189 : C
189 : CALL MASGEN(IPX,PROPRE)
189 : CALL DEPGEN( IPB, IPX,PROPRE,IBBX2,IPLMOX,IPLMOY)
190 : *
191 : * IMPRESSIONS
192 : *
193 : IF (IIMPI.EQ.30) WRITE(IOIMP,1000) (PROPRE(I),I=1,5)
194 : 1000 FORMAT(/10X,'SBR ITINV',/10X,5(E12.5,1X))
195 : *
196 : *
197 : * SUPPRESSION DES 'CHPOINT' DE TRAVAIL:
198 : IF ( (IACCEL + 1) .EQ. NUMAC) THEN
198 : CALL DTCHPO (IPX0)
199 : END IF
199 : CALL DTCHPO (IPX1)
199 : CALL DTCHPO (IBBX2)
199 : CALL DTCHPO (IPAX2)
200 : MLMOTS =IPLMOX
201 : MLMOT1 =IPLMOY
202 : SEGSUP MLMOTS,MLMOT1
203 : *
204 : IF (IIMPI .EQ. 30) THEN
204 : CALL GIBTEM(XKT)
205 : INTERR(1)=XKT
205 : CALL ERREUR(-259)
206 : * VERIFICATION DU MODE:
206 : CALL VRFMOD (IPA,IPB,IPX,VALPP)
207 : IF (IERR .NE. 0) RETURN
207 : CALL GIBTEM(XKT)
208 : INTERR(1)=XKT
208 : CALL ERREUR(-259)
209 : END IF
210 : *
211 : END
212 :
213 :
214 :
© Cast3M 2003 - All rights reserved.
Disclaimer