Télécharger itinv1.eso

Retour à la liste

Numérotation des lignes :

  1. C ITINV1 SOURCE PV 20/05/14 21:15:07 10615
  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.  
  80. -INC PPARAM
  81. -INC CCOPTIO
  82. -INC CCHAMP
  83. -INC SMRIGID
  84. SEGMENT IDEMEN(0)
  85. *
  86. CHARACTER*4 MOTCLE
  87. *
  88. COMMON/CITINV/ NBITER,IACCEL,NUMAC,IPX2,IPX0,IPX1,IPBX1,
  89. C IBBX1,IBBX2,ITPRO,DIFREL
  90. *
  91. PARAMETER (IPLACE = 0)
  92. PARAMETER (UN = 1.D0)
  93. PARAMETER (XMOIN1 = -1.D0)
  94. *
  95. *
  96. * -- PREPARATION POUR LES SOUS-PROGRAMMES "MAXIM1" ET "NORMA1" --
  97. *
  98. * ON EXCLUT LES COMPOSANTES DE TYPE "LX":
  99. CALL MOTS1 (IPLMOT,MOTCLE)
  100. *
  101. NBITER = NBITER + 1
  102. IACCEL = IACCEL + 1
  103. *
  104. *
  105. IF (IACCEL .EQ. NUMAC) THEN
  106. *
  107. * HYP: "NUMAC" >= 3 (NON TESTE DANS LE SOUS-PROGRAMME)
  108. *
  109. IACCEL = 0
  110. * ACCELERATION DE CONVERGENCE:
  111. * CALL ACCEL1 (IPX0,IPX1,IPX2, IPOINT)
  112. CALL ACTIPO (1.D0,1,IPX0,IPX1,IPX2,0)
  113. IF (IERR .NE. 0) RETURN
  114. CALL LIROBJ('CHPOINT',IPOINT,1,IRRR)
  115. CALL DTCHPO (IPX0)
  116. CALL DTCHPO (IPX1)
  117. IF (IPOINT .NE. IPX2) CALL DTCHPO (IPX2)
  118. IPX1 = IPOINT
  119. CALL MUCPRI(IPX1,IPB,IBBX1)
  120. IF(IERR.NE.0) RETURN
  121. *
  122. ELSE
  123. *
  124. IF ( (IACCEL + 1) .EQ. NUMAC) THEN
  125. IPX0 = IPX1
  126. ELSE IF (NBITER .GT. 1) THEN
  127. CALL DTCHPO (IPX1)
  128. END IF
  129. IPX1 = IPX2
  130. *
  131. END IF
  132. *
  133. * -- RESOLUTION DE: A.X2 = B.X1 --
  134. *
  135. * MISE A ZERO DES TERMES EN PI POUR LES ELTS LIQUIDES
  136. *
  137. IPTBX1 = IBBX1
  138. CALL ANCHPO(IPTBX1,NOMDU(15),IBBX1)
  139. CALL DTCHPO(IPTBX1)
  140. *
  141. * determination symetrique ou non
  142. *
  143. INSYM=0
  144. MRIGID = IPA
  145. SEGACT,MRIGID
  146. NRG = IRIGEL(/1)
  147. NBR = IRIGEL(/2)
  148. IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN
  149. INSYM = 1
  150. ENDIF
  151. IF (NRG.GE.7) THEN
  152. DO 9 IN = 1,NBR
  153. IANTI=IRIGEL(7,IN)
  154. IF(IANTI.GT.0) THEN
  155. INSYM = 1
  156. ENDIF
  157. 9 CONTINUE
  158. ENDIF
  159. SEGDES,MRIGID
  160. *
  161. SEGINI IDEMEN
  162. IDEMEN(**)=IBBX1
  163. NOID=0
  164. NOEN=1
  165. IF (INSYM.EQ.0) THEN
  166. CALL RESOU1 (IPA,IDEMEN,NOID,NOEN,1D-18,0,0)
  167. ELSE
  168. CALL LDMT (IPA,IDEMEN,NOID,NOEN,1D-18,0)
  169. ENDIF
  170. SEGACT IDEMEN
  171. IPX20=IDEMEN(1)
  172. SEGSUP IDEMEN
  173. IF (IERR .NE. 0) RETURN
  174. *
  175. * -- NORMALISATION A 1 DE "X2" --
  176. *
  177. CALL NORMA1 (IPX20,IPLMOT,MOTCLE, IPX2)
  178. IF (IERR .NE. 0) RETURN
  179. CALL DTCHPO (IPX20)
  180. IF (NBITER .GT. 1) THEN
  181. * ON TUE AUSSI LE SUPPORT DES POINTS CREE PAR MUCPRI
  182. * CALL DTCHPM (IPBX1)
  183. * CALL DTCHPM (IBBX1)
  184. END IF
  185. * PRODUIT RIGIDITE.CHPOINT:
  186. CALL MUCPRI (IPX2,IPB, IBBX2)
  187. IF (IERR .NE. 0) RETURN
  188. *
  189. *
  190. * -- CREATION DU MAXIMUM DE (X2-X1) --
  191. *
  192. CALL COMBI2 (IPX2,UN,IPX1,XMOIN1, IPDIFF)
  193. IF (IERR .NE. 0) RETURN
  194. CALL MAXIM1 (IPDIFF,IPLMOT,MOTCLE,IPLACE, DIFMAX)
  195. IF (IERR .NE. 0) RETURN
  196. CALL DTCHPO (IPDIFF)
  197. *
  198. * RQ: GRACE A L'APPEL A "NORMA1", "VALMAX" EST CONSTANT ET
  199. * EGAL A 1 --> (DIFMAX/VALMAX = DIFMAX)
  200. *
  201. DIFREL = ABS(DIFMAX)
  202. IF (NBITER.EQ.30.AND.ITPRO.EQ.1) THEN
  203. IF (IIMPI.EQ.2) WRITE(IOIMP,11111) NBITER,DIFREL
  204. 11111 FORMAT(/1X,'ITERATION',1X,I4,1X,'CRITERE DE CONVERGENCE',1X,E12.5)
  205. ENDIF
  206. *
  207. END
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  

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