Sources Esope | Cast3M

itinv1
C ITINV1    SOURCE    PV        22/04/15    13:20:09     11344          
      SUBROUTINE ITINV1 (IPA,IPB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
************************************************************************
*
*                             I T I N V 1
*                             -----------
*
* FONCTION:
* ---------
*
*     1) EFFECTUER (EVENTUELLEMENT) UNE ACCELERATION DE CONVERGENCE,
*     2) EFFECTUER UNE ITERATION:  |A|.X(I+1) = |B|.X(I), |A| ET |B|
*        ETANT 2 'RIGIDITE' ET X(J) LE 'CHPOINT' DE L'ITERATION "J".
*     3) CALCULER DES ELEMENTS DE COMPARAISON ENTRE X(I) ET X(I+1).
*
* MODE D'APPEL:
* -------------
*
*     CALL ITINV1 (IPA,IPB)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*    +DIFREL  REEL SP   (S)  "DIFFERENCE RELATIVE".
*                            EGAL A  ABS(DIFMAX/VALMAX).
*    +IACCEL  ENTIER    (E)  NOMBRE D'ITERATIONS CONSECUTIVES EFFECTUEES
*                            SANS ACCELERATION DE CONVERGENCE.
*                       (S)  MEME DEFINITION. VALEUR INCREMENTEE OU
*                            REMISE A 0.
*     IPA     ENTIER    (E)  POINTEUR DE L'OBJET 'RIGIDITE' |A|.
*     IPB     ENTIER    (E)  POINTEUR DE L'OBJET 'RIGIDITE' |B|.
*    +IPBX1   ENTIER    (S)  POINTEUR DU 'CHPOINT' PRODUIT DE |B| PAR
*                            "X1".
*    +IPX0    ENTIER    (S)  POINTEUR DU 'CHPOINT' ITERE PRECEDANT "X1"
*                            (FOURNI QUAND  "IACCEL" VAUT "NUMAC - 1").
*    +IPX1    ENTIER    (E)  POINTEUR DU 'CHPOINT' ITERE "X1" D'INDICE
*                            "NBITER".
*                       (S)  MEME DEFINITION, "NBITER" AYANT ETE
*                            INCREMENTE.
*    +IPX2    ENTIER    (E)  POINTEUR DU 'CHPOINT' ITERE "X1".
*                       (S)  POINTEUR DU 'CHPOINT' ITERE SUIVANT "X1".
*    +NBITER  ENTIER    (E)  NOMBRE D'ITERATIONS EFFECTUEES.
*                       (S)  MEME DEFINITION, VALEUR INCREMENTEE.
*    +NUMAC   ENTIER    (E)  L'ACCELERATION DE CONVERGENCE A LIEU 1
*                            FOIS TOUTES LES "NUMAC" ITERATIONS.
*
*     + = PARAMETRE PASSE DANS LE COMMUN "CITINV".
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     DIFMAX  REEL DP   DIFFERENCE MAXIMALE ENTRE LES VALEURS
*                       CORRESPONDANTES DE DEUX 'CHPOINT' ITERES
*                       CONSECUTIFS.
*     IPDIFF  ENTIER    POINTEUR SUR LA DIFFERENCE DES 'CHPOINT' DE
*                       POINTEURS "IPX2" ET "IPX1".
*     VALMAX  REEL DP   VALEUR MAXIMALE DANS UN 'CHPOINT' ITERE.
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     ACCEL1, COMBI2, DTCHPO, ANCHPO, MAXIM1, MUCPRI, NORMA1, RESOU1,
*     DTCHPM .
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     19 DECEMBRE 1984
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
 
-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
-INC SMRIGID
-INC CCREEL
      SEGMENT IDEMEN(0)
*
      CHARACTER*(LOCOMP) MOTCLE
*
      COMMON/CITINV/ NBITER,IACCEL,NUMAC,IPX2,IPX0,IPX1,IPBX1,
     C IBBX1,IBBX2,ITPRO,DIFREL
*
      PARAMETER (IPLACE = 0)
      PARAMETER (UN = 1.D0)
      PARAMETER (XMOIN1 = -1.D0)
*
*
*
      xspetl = xspeti
*
*     -- PREPARATION POUR LES SOUS-PROGRAMMES "MAXIM1" ET "NORMA1" --
*
*     ON EXCLUT LES COMPOSANTES DE TYPE "LX":
         CALL MOTS1 (IPLMOT,MOTCLE)
*
      NBITER = NBITER + 1
      IACCEL = IACCEL + 1
*
*
      IF (IACCEL .EQ. NUMAC) THEN
*
*        HYP: "NUMAC" >= 3  (NON TESTE DANS LE SOUS-PROGRAMME)
*
         IACCEL = 0
*        ACCELERATION DE CONVERGENCE:
*        CALL ACCEL1 (IPX0,IPX1,IPX2,  IPOINT)
         CALL ACTIPO (1.D0,1,IPX0,IPX1,IPX2,0)
         IF (IERR .NE. 0) RETURN
         CALL LIROBJ('CHPOINT',IPOINT,1,IRRR)
         CALL DTCHPO (IPX0)
         CALL DTCHPO (IPX1)
         IF (IPOINT .NE. IPX2) CALL DTCHPO (IPX2)
         IPX1 = IPOINT
         CALL MUCPRI(IPX1,IPB,IBBX1)
         IF(IERR.NE.0) RETURN
*
      ELSE
*
         IF ( (IACCEL + 1) .EQ. NUMAC) THEN
            IPX0 = IPX1
         ELSE IF (NBITER .GT. 1) THEN
            CALL DTCHPO (IPX1)
         END IF
         IPX1 = IPX2
*
      END IF
*
*     -- RESOLUTION DE: A.X2 = B.X1 --
*
*        MISE A ZERO DES TERMES EN PI POUR LES ELTS LIQUIDES
*
         IPTBX1 = IBBX1
         CALL ANCHPO(IPTBX1,NOMDU(15),IBBX1)
         CALL DTCHPO(IPTBX1)
*
*  determination symetrique ou non
*
      INSYM=0
      MRIGID = IPA
      SEGACT,MRIGID
      NRG = IRIGEL(/1)
      NBR = IRIGEL(/2)
      IF(NORINC.GT.0  .AND. NORIND.GT.0) THEN
         INSYM = 1
      ENDIF
      IF (NRG.GE.7) THEN
         DO  9 IN = 1,NBR
            IANTI=IRIGEL(7,IN)
            IF(IANTI.GT.0) THEN
               INSYM = 1
            ENDIF
  9      CONTINUE
      ENDIF
      SEGDES,MRIGID
*
      SEGINI IDEMEN
      IDEMEN(**)=IBBX1
      NOID=0
      NOEN=1
      IF (INSYM.EQ.0) THEN
         CALL RESOU1 (IPA,IDEMEN,NOID,NOEN,xspetl,0,0)
      ELSE
         CALL LDMT   (IPA,IDEMEN,NOID,NOEN,xspetl,0)
      ENDIF
      SEGACT IDEMEN
      IPX20=IDEMEN(1)
      SEGSUP IDEMEN
      IF (IERR .NE. 0) RETURN
*
*     -- NORMALISATION A 1 DE "X2" --
*
      CALL NORMA1 (IPX20,IPLMOT,MOTCLE,  IPX2)
      IF (IERR .NE. 0) RETURN
      CALL DTCHPO (IPX20)
      IF (NBITER .GT. 1) THEN
*        ON TUE AUSSI LE SUPPORT DES POINTS CREE PAR MUCPRI
*        CALL DTCHPM (IPBX1)
*        CALL DTCHPM (IBBX1)
      END IF
*     PRODUIT RIGIDITE.CHPOINT:
      CALL MUCPRI (IPX2,IPB,  IBBX2)
      IF (IERR .NE. 0) RETURN
*
*
*     -- CREATION DU MAXIMUM DE (X2-X1) --
*
      CALL COMBI2 (IPX2,UN,IPX1,XMOIN1,  IPDIFF)
      IF (IERR .NE. 0) RETURN
      CALL MAXIM1 (IPDIFF,IPLMOT,MOTCLE,IPLACE,  DIFMAX)
      IF (IERR .NE. 0) RETURN
      CALL DTCHPO (IPDIFF)
*
*     RQ: GRACE A L'APPEL A "NORMA1", "VALMAX" EST CONSTANT ET
*         EGAL A 1 --> (DIFMAX/VALMAX = DIFMAX)
*
      DIFREL = ABS(DIFMAX)
      IF (NBITER.EQ.30.AND.ITPRO.EQ.1) THEN
      IF (IIMPI.EQ.2) WRITE(IOIMP,11111) NBITER,DIFREL
11111 FORMAT(/1X,'ITERATION',1X,I4,1X,'CRITERE DE CONVERGENCE',1X,E12.5)
      ENDIF
*
      END