1 : C RESOCK SOURCE CHAT 05/01/13 02:53:01 5004 2 : SUBROUTINE RESOCK(IZB,IZL,IZR) 3 : C************************************************************************ 4 : C 5 : C 1/ KTYPI = 1 OU 5 6 : C 7 : C RESOLUTION (MONTEE DESCENTE) D'UNE MATRICE SYMETRIQUE LIGNE A LIGNE 8 : C PRECEDEMMENT TRIANGULEE PAR TRIAWS 9 : C 10 : C POINTEUR : EN ENTREE IZL CONTIENT LA MATRICE TRIANGULEE 11 : C IZB CONTIENT LE SECOND MEMBRE 12 : C EN SORTIE IZB CONTIENT LA SOLUTION 13 : C 14 : C VERSION OPTIMISEE EN GESTION MEMOIRE POUR LES TRES GROSSES 15 : C MATRICES. ON UTILISE L'ALGORITHME MRU (AVEC LA MODIFICATION 16 : C DANS OOOMWD) POUR LES BLOCS DE LA MATRICE. CECI EVITE DE TRANSFERER 17 : C SUR DISQUE LE RESTE DU CONTENU DE LA MEMOIRE, I.E. LES TABLEAUX 18 : C VITESSE, TEMPERATURE, ETC... QUI AURAIENT A ETRE RAPPELES DES 19 : C LA RESOLUTION TERMINEE. 20 : C 21 : C************************************************************************ 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : REAL*8 AUX,BJ 25 : C-INC SMMATRAKANC 26 : C************************************************************************* 27 : C 28 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 29 : C 30 : 31 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 32 : * (points CENTRE ) pour chaque operateur de contrainte 33 : * KGEOC SPG pour la totalite des points CENTRE. 34 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 35 : * KLEMC Connectivites de l'ensemble des contraintes 36 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 37 : 38 : SEGMENT MATRAK 39 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 40 : INTEGER LIZAFM(NBSOUS) 41 : INTEGER IKAM0 (NBSOUS) 42 : INTEGER IMEM (NBELC) 43 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 44 : ENDSEGMENT 45 : 46 : SEGMENT IZAFM 47 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 48 : ENDSEGMENT 49 : 50 : POINTEUR IPMJ.IZAFM,IPMK.IZAFM 51 : 52 : C******************************************************************* 53 : -INC SMMATRK1 54 : -INC SMCHPOI 55 : SEGMENT/IZA/(A(1)*D) 56 : SEGMENT/IZD/(D(1)*D) 57 : 58 : KTYPI = 1 59 : MPOVAL=IZB 60 : SEGACT MPOVAL,IZL*MOD 61 : IDMAT=KZA1 62 : SEGACT IDMAT 63 : NBLK=IDESCR(/1) 64 : C 65 : C---------------------METHODE DIRECTE-----------------------* 66 : C 67 : NL=VPOCHA(/1) 68 : N1=B(/1) 69 : 70 : C--- LE SECOND MEMBRE EST R{ORDONN{ DANS LA NUM{ROTATION OPTIMIS{E 71 : 72 : DO 30 I=1,NL 73 : B(I)=VPOCHA(NUNA(I),1) 74 : 30 CONTINUE 75 : 76 : C WRITE(6,*)' RESOCK BB: NL=',NL 77 : C WRITE(6,1002)(VPOCHA(I,1),I=1,NL) 78 : C WRITE(6,*)' NUNA' 79 : C WRITE(6,1001)(NUNA(I),I=1,NL) 80 : C1001 FORMAT(20(1X,I5)) 81 : 82 : SEGDES MPOVAL 83 : N1=KZA(/1) 84 : IF(KTYPI.EQ.5)GOTO 50 84 : IF(N1.NE.NL)CALL ARRET(0) 85 : C 86 : C DESCENTE 87 : C 88 : 88 : CALL OOOMRU(1) 89 : DO 100 IBLK=1,NBLK 90 : IJD=NLDBLK(IBLK) 91 : IJF=NLDBLK(IBLK+1)-1 92 : IDBLK=IDESCR(IBLK) 93 : SEGACT IDBLK 94 : IZA=IMAT 95 : SEGACT IZA 96 : DO 1 I=IJD,IJF 97 : AUX=0.D0 98 : C LA=LONGUEUR DE LA LIGNE I 99 : LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1) 100 : C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I 101 : C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1 102 : IDECI=IDEBLK(I-IJD+1)-1 103 : IF(LA.EQ.0)GO TO 3 104 : JMIN=I-LA 105 : AUX=SDOT(LA,A(IDECI+1),1,B(JMIN),1) 106 : 3 CONTINUE 107 : B(I)=B(I)-AUX 108 : 1 CONTINUE 109 : SEGDES IZA*(NOMOD,MRU) 110 : SEGDES IDBLK*(NOMOD,MRU) 111 : 100 CONTINUE 112 : C 113 : IZD=IDIAG 114 : SEGACT IZD 115 : C write(6,*)' DIAGONALE' 116 : C NDI=D(/1) 117 : C write(6,1002)(D(I),I=1,NDI) 118 : C write(6,*)' B= ' 119 : C NBI=B(/1) 120 : C write(6,1002)(B(I),I=1,NBI) 121 : 121 : CALL DIVISE(NL,B,B,D) 122 : SEGDES IZD*(NOMOD,MRU) 123 : C 124 : C REMONTEE 125 : C 126 : DO 200 KBLK=1,NBLK 127 : IBLK=NBLK-KBLK+1 128 : IJD=NLDBLK(IBLK) 129 : IJF=NLDBLK(IBLK+1)-1 130 : IDBLK=IDESCR(IBLK) 131 : SEGACT IDBLK 132 : IZA=IMAT 133 : SEGACT IZA 134 : DO 9 K=IJD,IJF 135 : I=IJF-K+IJD 136 : C LA=LONGUEUR DE LA LIGNE I 137 : LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1) 138 : C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I 139 : C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1 140 : IDECI=IDEBLK(I-IJD+1)-1 141 : IF(LA.EQ.0)GO TO 9 142 : JMIN=I-LA 143 : J2=I-1 144 : BJ=-B(I) 144 : CALL SAXPY(LA,BJ,A(IDECI+1),1,B(JMIN),1) 145 : 9 CONTINUE 146 : SEGDES IZA*(NOMOD,MRU) 147 : SEGDES IDBLK*(NOMOD,MRU) 148 : 200 CONTINUE 148 : CALL OOOMRU(0) 149 : 150 : C--- LE R{SULTAT EST R{ORDONN{ DANS LA NUM{ROTATION NATURELLE 151 : 152 : MPOVAL=IZR 153 : SEGACT MPOVAL*MOD 154 : DO 31 I=1,NL 155 : VPOCHA(I,1)=B(NUAN(I)) 156 : 31 CONTINUE 157 : 158 : C WRITE(6,*)' RESOCK BB:EN SORTIE NL=',NL 159 : C WRITE(6,1002)(VPOCHA(I,1),I=1,NL) 160 : C WRITE(6,1002)(B(I) ,I=1,NL) 161 : C WRITE(6,*)' NUAN' 162 : C WRITE(6,1001)(NUAN(I),I=1,NL) 163 : 164 : SEGDES MPOVAL,IZL 165 : SEGDES IDMAT 166 : RETURN 167 : C 168 : C KTYPI=5 LES SEGMENTS ONT ETE ACTIVES 169 : C 170 : 50 CONTINUE 170 : IF(N1.NE.NL)CALL ARRET(0) 171 : C 172 : C DESCENTE 173 : C 174 : DO 51 I=2,NL 175 : IZA=KZA(I) 176 : AUX=0.D0 177 : LA=A(/1) 178 : IF(LA.EQ.0)GO TO 53 179 : JMIN=I-LA 180 : AUX=SDOT(LA,A(1),1,B(JMIN),1) 181 : 53 CONTINUE 182 : B(I)=B(I)-AUX 183 : 51 CONTINUE 184 : C 185 : IZD=KZA(1) 185 : CALL DIVISE(NL,B,B,D) 186 : C 187 : C REMONTEE 188 : C 189 : DO 59 K=2,NL 190 : J=NL-K+2 191 : IZA=KZA(J) 192 : LA=A(/1) 193 : IF(LA.EQ.0)GO TO 59 194 : JMIN=J-LA 195 : J2=J-1 196 : BJ=-B(J) 196 : CALL SAXPY(LA,BJ,A,1,B(JMIN),1) 197 : 59 CONTINUE 198 : C 199 : C------- FIN RESOLUTION DIRECTE -------* 200 : C 201 : RETURN 202 : 1002 FORMAT(10(1X,1PE11.4)) 203 : END 204 : 205 : 206 :
© Cast3M 2003 - All rights reserved.
Disclaimer