1 : C GRACO0 SOURCE PV 13/10/14 21:17:45 7838 2 : SUBROUTINE GRACO0(KRIGI,IDAMEM,NOID,NOEN) 3 : C 4 : C **** SUBROUTINE QUI EXECUTE L OPERATION RESOU PAR GRADIENT CONJUGUE 5 : C **** APPELEE PAR GRACO 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : REAL*8 XKT 9 : INTEGER OOOVAL 10 : SEGMENT IDEMEM(0) 11 : -INC SMRIGID 12 : -INC SMVECTD 13 : -INC CCOPTIO 14 : -INC SMMATRI 15 : C 16 : MRIGID=KRIGI 17 : SEGACT MRIGID 18 : ICHOLX=ICHOLE 19 : SEGDES MRIGID 20 : IF(ICHOLX.NE.0) THEN 21 : MMATRI=ICHOLX 22 : SEGACT MMATRI 23 : MILIGN=IILIGN 24 : MILIG1=IASLIG 25 : SEGACT MILIGN,MILIG1 26 : DO 110 I=1,ILIGN(/1) 27 : LIGN=ILIGN(I) 28 : SEGACT LIGN 29 : LIGN=MILIG1.ILIGN(I) 30 : SEGACT LIGN 31 : 110 CONTINUE 32 : ELSE 32 : CALL GRACO1(KRIGI) 33 : IF(IERR.NE.0) GO TO 5000 34 : MRIGID=KRIGI 35 : SEGACT MRIGID 36 : ICHOLX=ICHOLE 37 : SEGDES MRIGID 38 : C 39 : C **** SUBROUTINE CHV2 : TRANSFORME LE CHPOIN ISECO EN VECTEUR 40 : C 41 : ENDIF 42 : IDEMEM=IDAMEM 43 : SEGACT IDEMEM*MOD 44 : NNTOT=IDEMEM(/1) 45 : MMATRI=ICHOLX 46 : SEGACT MMATRI 47 : MILIGN=IILIGN 48 : SEGACT,MILIGN 49 : INK=IPNO(/1) 50 : SEGDES MILIGN,MMATRI 50 : CALL INTPDO(LENB) 51 : NNPA= MAX(1,((OOOVAL(1,1)-NGMAXY)/(2*LENB))/INK+1) 52 : C 53 : C ON TRAVAILLE AVEC AUTANT DE VECTEUR SIMULTANEE QU'IL EN RENTRE DANS 54 : C LA MOITIE DE LA MEMOIRE CENTRALE 55 : C 56 : NN=NNPA 57 : DO 201 KGEN = 1,NNTOT,NNPA 58 : IF(KGEN+NNPA-1.GT.NNTOT) NN= NNTOT-KGEN+1 59 : KGEN1=KGEN-1 60 : DO 2 K=1,NN 61 : ISECO=IDEMEM(K+KGEN1) 61 : CALL CHV2(ICHOLX,ISECO,MVECTX,NOID) 62 : IF(IERR.NE.0) GO TO 5000 63 : IDEMEM(K+KGEN1)=MVECTX 64 : 2 CONTINUE 65 : IF(NN.NE.1) THEN 66 : INC = INK * NN 67 : SEGINI MVECTD 68 : DO 3 LL=1,NN 69 : LD=INK*(LL-1) 70 : MVECT1=IDEMEM(LL+KGEN1) 71 : SEGACT MVECT1 72 : DO 4 L=1,INK 73 : 4 VECTBB(L+LD)=MVECT1.VECTBB(L) 74 : SEGSUP MVECT1 75 : 3 CONTINUE 76 : MVECTX=MVECTD 77 : SEGDES MVECTD 78 : ENDIF 79 : C 80 : C **** SUBROUTINE GRACO6 : 81 : C 82 : IF(IIMPI.EQ.1) THEN 83 : WRITE(IOIMP,499) 84 : 499 FORMAT(' TEMPS SUIVANT AVANT APPEL GRACO6') 84 : CALL GIBTEM(XKT) 85 : INTERR(1)=XKT 85 : CALL ERREUR(-259) 86 : ENDIF 86 : CALL GRACO6(ICHOLX,MVECTX,NOEN,MSOL,lenb) 87 : IF(IIMPI.EQ.1) THEN 88 : WRITE(IOIMP,498) 89 : 498 FORMAT(' TEMPS SUIVANT APRES APPEL GRACO6') 89 : CALL GIBTEM(XKT) 90 : INTERR(1)=XKT 90 : CALL ERREUR(-259) 91 : ENDIF 92 : C 93 : C desactivation de LLIGN 94 : C 95 : SEGACT MMATRI 96 : MILIGN = IASLIG 97 : SEGACT MILIGN 98 : DO 763 N=1,ILIGN(/1) 99 : LLIGN=ILIGN(N) 100 : SEGDES LLIGN 101 : 763 CONTINUE 102 : SEGDES MILIGN 103 : MILIGN = IILIGN 104 : SEGACT MILIGN 105 : DO 764 N=1,ILIGN(/1) 106 : LLIGN=ILIGN(N) 107 : SEGDES LLIGN 108 : 764 CONTINUE 109 : MDIAG = IASDIA 110 : SEGDES MILIGN,MDIAG,MMATRI 111 : IF(IERR.NE.0) GO TO 5000 112 : C 113 : C **** SUBROUTINE VCH1 : REMET LE VECTEUR SOUS FORME D UN CHPOINT 114 : C **** LE CHPOINT EST DE TYPE PREMIER MEMBRE 115 : C 116 : MVECTA=MSOL 117 : DO 5 K=1,NN 118 : IF(NN.EQ.1) GO TO 10 119 : IF(K.EQ.1) THEN 120 : INC=INK 121 : MVECT1=MSOL 122 : SEGACT MVECT1 123 : SEGINI MVECTD 124 : ENDIF 125 : SEGACT MVECTD 126 : LD=(K-1)*INK 127 : DO 6 L=1,INK 128 : VECTBB(L)=MVECT1.VECTBB(L+LD) 129 : 6 CONTINUE 130 : MVECTA=MVECTD 131 : SEGDES MVECTD 132 : IF(K.EQ.NN) SEGSUP MVECT1 133 : 10 CONTINUE 133 : CALL VCH1(ICHOLX,MVECTA,ISOLU,KRIGI) 134 : IF(IERR.NE.0) RETURN 135 : C 136 : IDEMEM(K+KGEN1)=ISOLU 137 : 5 CONTINUE 138 : MVECTD=MVECTA 139 : SEGSUP MVECTD 140 : 201 CONTINUE 141 : IDAMEM = IDEMEM 142 : SEGDES IDEMEM 143 : C 144 : 5000 CONTINUE 145 : RETURN 146 : END 147 : 148 : 149 : 150 : 151 : 152 : 153 : 154 : 155 : 156 : 157 :
© Cast3M 2003 - All rights reserved.
Disclaimer