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