Télécharger la plaquette Cast3M


fr en

Télécharger itinv.eso

Retour à la liste

Numérotation des lignes : 

itinv

  1. C ITINV     SOURCE    PV        17/12/19    21:15:06     9673           
  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.  
  96. -INC PPARAM
  97. -INC CCOPTIO
  98. -INC SMLMOTS
  99. *
  100.       REAL*8 PROPRE(*)
  101. *
  102.       COMMON/CITINV/ NBITER,IACCEL,NUMAC,IPX2,IPX0,IPX1,IPBX1,
  103.      C IBBX1,IBBX2,ITPRO,DIFREL
  104. *
  105.       LOGICAL CONVRG
  106. *
  107.       PARAMETER (INFINI = 9999)
  108. *
  109.       IF (IIMPI .EQ. 747) THEN
  110.          CALL GIBTEM(XKT)
  111.          INTERR(1)=XKT
  112.          CALL ERREUR(-259)
  113.       ENDIF
  114. *
  115. *     PREPARATION DES ITERATIONS:
  116.       IBBX1=0
  117.       IBBX2 = IPMX
  118.       IPX2 = IPX
  119.       NUMAC = NUMACC
  120.       NBITER = 0
  121.       IACCEL = 0
  122.       NUMXBX = -10
  123.       X1BX1 = 1.D10
  124.       IPLMOX=0
  125.       IPLMOY=0
  126. C
  127. C     PREPARATION DES TABLEAUX DONNANT LA CORRESPONDANCE DES NOMS
  128. C     D INCONNUE DANS X ET MX  STOCKE DANS UN LIST MOT
  129. C
  130.       CALL CORRSP(ipa,IPX,IPMX,IPLMOX,IPLMOY)
  131. C
  132. C
  133. C
  134. *
  135. *     -- DEBUT DES ITERATIONS INVERSES --
  136. *
  137.       DIFREL = 1.E10
  138.   205 IF (DIFREL .GT. PRECI1 .AND. NBITER .LT. ITERMX) THEN
  139.          IF (IBBX1.NE.0) CALL DTCHPO(IBBX1)
  140.          IBBX1 = IBBX2
  141.          CALL ITINV1 (IPA,IPB)
  142.          IF (IERR .NE. 0) RETURN
  143.          GOTO 205
  144.       END IF
  145. *
  146.       convrg=.false.
  147.       DO 300 IB300=1,INFINI
  148. *
  149. *        -- CALCUL DE "XT.B.X" POUR 2 ITERES --
  150. *
  151.          IF (NBITER .LT. ITERMX) THEN
  152.             IF (NBITER .EQ. (NUMXBX + 1) ) THEN
  153.                X1BX1 = X2BX2
  154.             ELSE
  155. *              PRODUIT SCALAIRE X1.(M.X1) :
  156. C              CALL XTMX (IPX1,IPB,  X1BX1)
  157.                CALL XTY1 (IPX1,IBBX1,IPLMOX,IPLMOY,X1BX1)
  158.                IF (IERR .NE. 0) RETURN
  159.             END IF
  160.          END IF
  161. *
  162. *        PRODUIT X2T.B.X2 :
  163.          CALL XTY1(IPX2,IBBX2,IPLMOX,IPLMOY,X2BX2)
  164.          IF (IERR .NE. 0) RETURN
  165.          NUMXBX = NBITER
  166. *
  167.          DIFXBX = ABS(1.D0 - ABS(X1BX1 / X2BX2) )
  168. *
  169.          if (convrg) goto 302
  170.          IF (DIFREL .LE. PRECI1 .AND. DIFXBX .LE. PRECI2) THEN
  171.             CONVRG = .TRUE.
  172. *           --> SORTIE DE BOUCLE N.300 apres l'iteration suivante
  173.          ELSE IF (NBITER .GE. ITERMX) THEN
  174.             CONVRG = .FALSE.
  175. *           --> SORTIE DE BOUCLE N.300
  176.             GOTO 302
  177.          ENDIF
  178.             CALL DTCHPO(IBBX1)
  179.             IBBX1 = IBBX2
  180.             CALL ITINV1 (IPA,IPB)
  181.             IF (IERR .NE. 0) RETURN
  182. *
  183.   300    CONTINUE
  184. *     END DO
  185.   302 CONTINUE
  186. *
  187.       IF (IIMPI.EQ.2) WRITE (IOIMP,2000) NBITER
  188.  2000 FORMAT (//,1X,I3,' ITERATIONS INVERSES ONT ETE EFFECTUEES.'///)
  189. *
  190. *     -- RETOUR DU MODE PROPRE --
  191. *
  192. C     CALL XTMX (IPX2,IPA,  X2AX2)
  193.       CALL MUCPRI(IPX2,IPA,IPAX2)
  194.  
  195.       CALL XTY1(IPX2,IPAX2,IPLMOX,IPLMOY,X2AX2)
  196.       IF (IERR .NE. 0) RETURN
  197.       VALPP = X2AX2 / X2BX2
  198. *
  199.       PROPRE(1) = VALPP
  200.       PROPRE(2) = X2BX2
  201.       IPX = IPX2
  202. C
  203. C     CALCUL DES MASSES GEN. INTRODUCTION DES COEF. PI OU 2PI
  204. C     EVENTUELS
  205. C
  206.       CALL MASGEN(IPX,PROPRE)
  207.       CALL DEPGEN( IPB, IPX,PROPRE,IBBX2,IPLMOX,IPLMOY)
  208. *
  209. *     IMPRESSIONS
  210. *
  211.       IF (IIMPI.EQ.30) WRITE(IOIMP,1000) (PROPRE(I),I=1,5)
  212. 1000  FORMAT(/10X,'SBR  ITINV',/10X,5(E12.5,1X))
  213. *
  214. *
  215. *     SUPPRESSION DES 'CHPOINT' DE TRAVAIL:
  216.       IF ( (IACCEL + 1) .EQ. NUMAC) THEN
  217.          CALL DTCHPO (IPX0)
  218.       END IF
  219.       CALL DTCHPO (IPX1)
  220.       CALL DTCHPO (IBBX2)
  221.       CALL DTCHPO (IPAX2)
  222.       MLMOTS =IPLMOX
  223.       MLMOT1 =IPLMOY
  224.       SEGSUP MLMOTS,MLMOT1
  225. *
  226.       IF (IIMPI .EQ. 30) THEN
  227.          CALL GIBTEM(XKT)
  228.          INTERR(1)=XKT
  229.          CALL ERREUR(-259)
  230. *        VERIFICATION DU MODE:
  231.          CALL VRFMOD (IPA,IPB,IPX,VALPP)
  232.          IF (IERR .NE. 0) RETURN
  233.          CALL GIBTEM(XKT)
  234.          INTERR(1)=XKT
  235.          CALL ERREUR(-259)
  236.       END IF
  237. *
  238.       END
  239.  
  240.  
  241.  
  242.  
  243.  

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