Sources Esope | Cast3M

graco0
C GRACO0    SOURCE    PV        22/01/31    21:15:02     8699           
      SUBROUTINE GRACO0(KRIGI,IDAMEM,NOID,NOEN)
C
C **** SUBROUTINE QUI EXECUTE L OPERATION RESOU PAR GRADIENT CONJUGUE
C **** APPELEE PAR GRACO
C
      IMPLICIT INTEGER(I-N)
      REAL*8 XKT
      INTEGER OOOVAL
      SEGMENT IDEMEM(0)
-INC SMRIGID
-INC SMVECTD
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRI
C
      MRIGID=KRIGI
      SEGACT MRIGID
      ICHOLX=ICHOLE
      SEGDES MRIGID
      IF(ICHOLX.NE.0) THEN
      MMATRI=ICHOLX
      SEGACT MMATRI
      MILIGN=IILIGN
      MILIG1=IASLIG
      SEGACT MILIGN,MILIG1
      DO 110 I=1,ILIGN(/1)
       LIGN=ILIGN(I)
       SEGACT LIGN
       LIGN=MILIG1.ILIGN(I)
       SEGACT LIGN
  110 CONTINUE
      ELSE
      CALL GRACO1(KRIGI)
      IF(IERR.NE.0) GO TO 5000
      MRIGID=KRIGI
      SEGACT MRIGID
      ICHOLX=ICHOLE
      SEGDES MRIGID
C
C **** SUBROUTINE CHV2 : TRANSFORME LE CHPOIN ISECO EN VECTEUR
C
      ENDIF
      IDEMEM=IDAMEM
      SEGACT IDEMEM*MOD
      NNTOT=IDEMEM(/1)
      MMATRI=ICHOLX
      SEGACT MMATRI
      MILIGN=IILIGN
      SEGACT,MILIGN
      INK=IPNO(/1)
      SEGDES MILIGN,MMATRI
      CALL INTPDO(LENB)
      NNPA= MAX(1,((OOOVAL(1,1)-NGMAXY)/(2*LENB))/INK+1)
C
C  ON TRAVAILLE AVEC AUTANT DE VECTEUR SIMULTANEE QU'IL EN RENTRE DANS
C  LA MOITIE DE LA MEMOIRE CENTRALE
C
      NN=NNPA
      DO 201 KGEN = 1,NNTOT,NNPA
      IF(KGEN+NNPA-1.GT.NNTOT)  NN= NNTOT-KGEN+1
      KGEN1=KGEN-1
      DO 2 K=1,NN
      ISECO=IDEMEM(K+KGEN1)
      CALL CHV2(ICHOLX,ISECO,MVECTX,NOID)
      IF(IERR.NE.0) GO TO 5000
      IDEMEM(K+KGEN1)=MVECTX
   2  CONTINUE
      IF(NN.NE.1) THEN
         INC = INK * NN
         SEGINI MVECTD
         DO 3 LL=1,NN
         LD=INK*(LL-1)
         MVECT1=IDEMEM(LL+KGEN1)
         SEGACT MVECT1
         DO   L=1,INK
         VECTBB(L+LD)=MVECT1.VECTBB(L)
         ENDDO
         SEGSUP MVECT1
    3    CONTINUE
         MVECTX=MVECTD
         SEGDES MVECTD
      ENDIF
C
C **** SUBROUTINE GRACO6 :
C
      IF(IIMPI.EQ.1) THEN
         WRITE(IOIMP,499)
 499     FORMAT('  TEMPS SUIVANT  AVANT APPEL GRACO6')
         CALL GIBTEM(XKT)
         INTERR(1)=XKT
         CALL ERREUR(-259)
      ENDIF
      CALL GRACO6(ICHOLX,MVECTX,NOEN,MSOL,lenb)
      IF(IIMPI.EQ.1) THEN
         WRITE(IOIMP,498)
 498     FORMAT('  TEMPS SUIVANT  APRES APPEL GRACO6')
         CALL GIBTEM(XKT)
         INTERR(1)=XKT
         CALL ERREUR(-259)
      ENDIF
      if(ierr.ne.0) return
C
C  desactivation de LLIGN
C
      SEGACT MMATRI
      MILIGN = IASLIG
      SEGACT MILIGN
      DO 763 N=1,ILIGN(/1)
      LLIGN=ILIGN(N)
      SEGDES LLIGN
  763 CONTINUE
      SEGDES MILIGN
      MILIGN = IILIGN
      SEGACT MILIGN
      DO 764 N=1,ILIGN(/1)
      LLIGN=ILIGN(N)
      SEGDES LLIGN
  764 CONTINUE
      MDIAG = IASDIA
      SEGDES MILIGN,MDIAG,MMATRI
      IF(IERR.NE.0) GO TO 5000
C
C **** SUBROUTINE VCH1 : REMET LE VECTEUR SOUS FORME D UN CHPOINT
C **** LE CHPOINT EST DE TYPE PREMIER MEMBRE
C
      MVECTA=MSOL
      DO 5 K=1,NN
      IF(NN.EQ.1) GO TO 10
      IF(K.EQ.1) THEN
         INC=INK
         MVECT1=MSOL
         SEGACT MVECT1
         SEGINI MVECTD
      ENDIF
      SEGACT MVECTD
      LD=(K-1)*INK
      DO 6 L=1,INK
      VECTBB(L)=MVECT1.VECTBB(L+LD)
    6 CONTINUE
      MVECTA=MVECTD
      SEGDES MVECTD
      IF(K.EQ.NN) SEGSUP MVECT1
   10 CONTINUE
      CALL VCH1(ICHOLX,MVECTA,ISOLU,KRIGI)
      IF(IERR.NE.0) RETURN
C
      IDEMEM(K+KGEN1)=ISOLU
   5  CONTINUE
      MVECTD=MVECTA
      SEGSUP  MVECTD
  201 CONTINUE
      IDAMEM = IDEMEM
      SEGDES IDEMEM
C
 5000 CONTINUE
      RETURN
      END