Télécharger itinv.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales