Télécharger itinv1.eso

Retour à la liste

Numérotation des lignes :

  1. C ITINV1 SOURCE PV 15/11/26 00:51:34 8708
  2. SUBROUTINE ITINV1 (IPA,IPB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * I T I N V 1
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * 1) EFFECTUER (EVENTUELLEMENT) UNE ACCELERATION DE CONVERGENCE,
  14. * 2) EFFECTUER UNE ITERATION: |A|.X(I+1) = |B|.X(I), |A| ET |B|
  15. * ETANT 2 'RIGIDITE' ET X(J) LE 'CHPOINT' DE L'ITERATION "J".
  16. * 3) CALCULER DES ELEMENTS DE COMPARAISON ENTRE X(I) ET X(I+1).
  17. *
  18. * MODE D'APPEL:
  19. * -------------
  20. *
  21. * CALL ITINV1 (IPA,IPB)
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  24. * -----------
  25. *
  26. * +DIFREL REEL SP (S) "DIFFERENCE RELATIVE".
  27. * EGAL A ABS(DIFMAX/VALMAX).
  28. * +IACCEL ENTIER (E) NOMBRE D'ITERATIONS CONSECUTIVES EFFECTUEES
  29. * SANS ACCELERATION DE CONVERGENCE.
  30. * (S) MEME DEFINITION. VALEUR INCREMENTEE OU
  31. * REMISE A 0.
  32. * IPA ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' |A|.
  33. * IPB ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' |B|.
  34. * +IPBX1 ENTIER (S) POINTEUR DU 'CHPOINT' PRODUIT DE |B| PAR
  35. * "X1".
  36. * +IPX0 ENTIER (S) POINTEUR DU 'CHPOINT' ITERE PRECEDANT "X1"
  37. * (FOURNI QUAND "IACCEL" VAUT "NUMAC - 1").
  38. * +IPX1 ENTIER (E) POINTEUR DU 'CHPOINT' ITERE "X1" D'INDICE
  39. * "NBITER".
  40. * (S) MEME DEFINITION, "NBITER" AYANT ETE
  41. * INCREMENTE.
  42. * +IPX2 ENTIER (E) POINTEUR DU 'CHPOINT' ITERE "X1".
  43. * (S) POINTEUR DU 'CHPOINT' ITERE SUIVANT "X1".
  44. * +NBITER ENTIER (E) NOMBRE D'ITERATIONS EFFECTUEES.
  45. * (S) MEME DEFINITION, VALEUR INCREMENTEE.
  46. * +NUMAC ENTIER (E) L'ACCELERATION DE CONVERGENCE A LIEU 1
  47. * FOIS TOUTES LES "NUMAC" ITERATIONS.
  48. *
  49. * + = PARAMETRE PASSE DANS LE COMMUN "CITINV".
  50. *
  51. * LEXIQUE: (ORDRE ALPHABETIQUE)
  52. * --------
  53. *
  54. * DIFMAX REEL DP DIFFERENCE MAXIMALE ENTRE LES VALEURS
  55. * CORRESPONDANTES DE DEUX 'CHPOINT' ITERES
  56. * CONSECUTIFS.
  57. * IPDIFF ENTIER POINTEUR SUR LA DIFFERENCE DES 'CHPOINT' DE
  58. * POINTEURS "IPX2" ET "IPX1".
  59. * VALMAX REEL DP VALEUR MAXIMALE DANS UN 'CHPOINT' ITERE.
  60. *
  61. * SOUS-PROGRAMMES APPELES:
  62. * ------------------------
  63. *
  64. * ACCEL1, COMBI2, DTCHPO, ANCHPO, MAXIM1, MUCPRI, NORMA1, RESOU1,
  65. * DTCHPM .
  66. *
  67. * AUTEUR, DATE DE CREATION:
  68. * -------------------------
  69. *
  70. * PASCAL MANIGOT 19 DECEMBRE 1984
  71. *
  72. * LANGAGE:
  73. * --------
  74. *
  75. * FORTRAN77
  76. *
  77. ************************************************************************
  78. *
  79. -INC CCOPTIO
  80. -INC CCHAMP
  81. -INC SMRIGID
  82. SEGMENT IDEMEN(0)
  83. *
  84. CHARACTER*4 MOTCLE
  85. *
  86. COMMON/CITINV/ NBITER,IACCEL,NUMAC,IPX2,IPX0,IPX1,IPBX1,
  87. C IBBX1,IBBX2,ITPRO,DIFREL
  88. *
  89. PARAMETER (IPLACE = 0)
  90. PARAMETER (UN = 1.D0)
  91. PARAMETER (XMOIN1 = -1.D0)
  92. *
  93. *
  94. * -- PREPARATION POUR LES SOUS-PROGRAMMES "MAXIM1" ET "NORMA1" --
  95. *
  96. * ON EXCLUT LES COMPOSANTES DE TYPE "LX":
  97. CALL MOTS1 (IPLMOT,MOTCLE)
  98. *
  99. NBITER = NBITER + 1
  100. IACCEL = IACCEL + 1
  101. *
  102. *
  103. IF (IACCEL .EQ. NUMAC) THEN
  104. *
  105. * HYP: "NUMAC" >= 3 (NON TESTE DANS LE SOUS-PROGRAMME)
  106. *
  107. IACCEL = 0
  108. * ACCELERATION DE CONVERGENCE:
  109. * CALL ACCEL1 (IPX0,IPX1,IPX2, IPOINT)
  110. CALL ACTIPO (1.D0,1,IPX0,IPX1,IPX2,0)
  111. IF (IERR .NE. 0) RETURN
  112. CALL LIROBJ('CHPOINT',IPOINT,1,IRRR)
  113. CALL DTCHPO (IPX0)
  114. CALL DTCHPO (IPX1)
  115. IF (IPOINT .NE. IPX2) CALL DTCHPO (IPX2)
  116. IPX1 = IPOINT
  117. CALL MUCPRI(IPX1,IPB,IBBX1)
  118. IF(IERR.NE.0) RETURN
  119. *
  120. ELSE
  121. *
  122. IF ( (IACCEL + 1) .EQ. NUMAC) THEN
  123. IPX0 = IPX1
  124. ELSE IF (NBITER .GT. 1) THEN
  125. CALL DTCHPO (IPX1)
  126. END IF
  127. IPX1 = IPX2
  128. *
  129. END IF
  130. *
  131. * -- RESOLUTION DE: A.X2 = B.X1 --
  132. *
  133. * MISE A ZERO DES TERMES EN PI POUR LES ELTS LIQUIDES
  134. *
  135. IPTBX1 = IBBX1
  136. CALL ANCHPO(IPTBX1,NOMDU(15),IBBX1)
  137. CALL DTCHPO(IPTBX1)
  138. *
  139. * determination symetrique ou non
  140. *
  141. INSYM=0
  142. MRIGID = IPA
  143. SEGACT,MRIGID
  144. NRG = IRIGEL(/1)
  145. NBR = IRIGEL(/2)
  146. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  147. INSYM = 1
  148. ENDIF
  149. IF (NRG.GE.7) THEN
  150. DO 9 IN = 1,NBR
  151. IANTI=IRIGEL(7,IN)
  152. IF(IANTI.GT.0) THEN
  153. INSYM = 1
  154. ENDIF
  155. 9 CONTINUE
  156. ENDIF
  157. SEGDES,MRIGID
  158. *
  159. SEGINI IDEMEN
  160. IDEMEN(**)=IBBX1
  161. NOID=0
  162. NOEN=1
  163. IF (INSYM.EQ.0) THEN
  164. CALL RESOU1 (IPA,IDEMEN,NOID,NOEN,1D-18,0)
  165. ELSE
  166. CALL LDMT (IPA,IDEMEN,NOID,NOEN,1D-18)
  167. ENDIF
  168. SEGACT IDEMEN
  169. IPX20=IDEMEN(1)
  170. SEGSUP IDEMEN
  171. IF (IERR .NE. 0) RETURN
  172. *
  173. * -- NORMALISATION A 1 DE "X2" --
  174. *
  175. CALL NORMA1 (IPX20,IPLMOT,MOTCLE, IPX2)
  176. IF (IERR .NE. 0) RETURN
  177. CALL DTCHPO (IPX20)
  178. IF (NBITER .GT. 1) THEN
  179. * ON TUE AUSSI LE SUPPORT DES POINTS CREE PAR MUCPRI
  180. * CALL DTCHPM (IPBX1)
  181. * CALL DTCHPM (IBBX1)
  182. END IF
  183. * PRODUIT RIGIDITE.CHPOINT:
  184. CALL MUCPRI (IPX2,IPB, IBBX2)
  185. IF (IERR .NE. 0) RETURN
  186. *
  187. *
  188. * -- CREATION DU MAXIMUM DE (X2-X1) --
  189. *
  190. CALL COMBI2 (IPX2,UN,IPX1,XMOIN1, IPDIFF)
  191. IF (IERR .NE. 0) RETURN
  192. CALL MAXIM1 (IPDIFF,IPLMOT,MOTCLE,IPLACE, DIFMAX)
  193. IF (IERR .NE. 0) RETURN
  194. CALL DTCHPO (IPDIFF)
  195. *
  196. * RQ: GRACE A L'APPEL A "NORMA1", "VALMAX" EST CONSTANT ET
  197. * EGAL A 1 --> (DIFMAX/VALMAX = DIFMAX)
  198. *
  199. DIFREL = ABS(DIFMAX)
  200. IF (NBITER.EQ.30.AND.ITPRO.EQ.1) THEN
  201. IF (IIMPI.EQ.2) WRITE(IOIMP,11111) NBITER,DIFREL
  202. 11111 FORMAT(/1X,'ITERATION',1X,I4,1X,'CRITERE DE CONVERGENCE',1X,E12.5)
  203. ENDIF
  204. *
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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