1 : C PRRIGI SOURCE BP208322 13/04/08 21:15:16 7749 2 : c imprime les matrices de rigidite pointeur de l objet=iret 3 : c 4 : SUBROUTINE PRRIGI(IRET,JENTET) 5 : IMPLICIT INTEGER(I-N) 6 : -INC SMRIGID 7 : -INC CCOPTIO 8 : -INC SMELEME 9 : CHARACTER*24 TITI,TOTO,TOTO2 10 : c nombre de matrices elementaires a afficher (anciennement =10 en dur) 11 : PARAMETER(NRESU=2) 12 : c 13 : C eventuellement, on lit le nombre de valeurs de REL a afficher avant de 14 : C revenir a la ligne 15 : NMAX=39 15 : CALL LIRENT(IMAX,0,IRETOU) 16 : if(IRETOU.NE.0) NMAX=IMAX 17 : 18 : MRIGID=IRET 19 : if (mrigid.le.0) then 19 : call erreur(26) 20 : return 21 : endif 22 : SEGACT MRIGID 23 : NRI=IRIGEL(/1) 24 : NR=IRIGEL(/2) 25 : c ERREUR(-26): Matrice de %m1:8 formée de %i1 matrice(s) élémentaire(s) 26 : MOTERR(1:8)=MTYMAT 27 : INTERR(1)=NR 27 : CALL ERREUR(-26) 28 : 29 : c --- boucle sur les sous-rigidites ------------------------------------ 30 : DO 191 I=1,NR 31 : IGEO=IRIGEL(1,I) 32 : xMATRI=IRIGEL(4,I) 33 : SEGACT xMATRI 34 : NMA=re(/3) 35 : DESCR=IRIGEL(3,I) 36 : NNHA=IRIGEL(5,I) 37 : NEGALI=IRIGEL(6,I) 38 : SEGACT DESCR 39 : NINC=LISINC(/2) 40 : NINCD=LISDUA(/2) 41 : 42 : c ERREUR(-27): Sous matrice %i1 : %i2 éléments : %i3 x %i4 inconnue(s) par matrice 43 : c Coefficient multiplicateur %r1 : Harmonique %i5 44 : INTERR(1)=I 45 : INTERR(2)=NMA 46 : INTERR(3)=NINC 47 : INTERR(4)=NINCD 48 : REAERR(1)=COERIG(I) 49 : INTERR(5)=NNHA 49 : CALL ERREUR(-27) 50 : IF (NRI.GE.7) THEN 51 : IANTI=IRIGEL(7,I) 52 : IF (IANTI.EQ.0) THEN 52 : CALL ERREUR(-274) 53 : ELSE IF (IANTI.EQ.1) THEN 53 : CALL ERREUR(-275) 54 : ELSE IF (IANTI.EQ.2) THEN 54 : CALL ERREUR(-307) 55 : ELSE IF (IANTI.EQ.3) THEN 55 : CALL ERREUR(-320) 56 : ENDIF 57 : ELSE 57 : CALL ERREUR(-274) 58 : ENDIF 59 : 60 : c ... désormais inutile ... interr(1)=negali 61 : c ERREUR(-28): Nature des matrices : "%m1:1" 62 : c Noeuds Inconnue : (les %i2 premières sont primales) 63 : IF(NEGALI.EQ.0) THEN 64 : MOTERR(1:1)='=' 65 : ELSE IF(NEGALI.EQ.-1) THEN 66 : MOTERR(1:1)='>' 67 : ELSE IF(NEGALI.EQ. 1) THEN 68 : MOTERR(1:1)='<' 69 : ELSE 70 : MOTERR(1:1)='?' 71 : ENDIF 72 : INTERR(2)=NINC 72 : CALL ERREUR(-28) 73 : c ecriture du DESCR 74 : WRITE(IOIMP,194)(NOELEP(J),LISINC(J),J=1,NINC) 75 : WRITE(IOIMP,194)(NOELED(J),LISDUA(J),J=1,NINCD) 76 : 194 FORMAT( I6,9X,A4) 77 : SEGDES DESCR 78 : MELEME=IGEO 79 : SEGACT MELEME 80 : C ERREUR (-29): Liste des points associés aux matrices 80 : CALL ERREUR (-29) 81 : NBNN=NUM(/1) 82 : NBELEM=NUM(/2) 83 : c option 'RESUM' : on n'affiche que les NRESU premiers elements 84 : nbi=nbelem 85 : if(jentet.eq.1) nbi=min (NRESU,nbi) 86 : NBNN2=min(NBNN,NMAX) 87 : WRITE(TITI,FMT='("( A,",I3,"( A,I3))")') NBNN2 88 : WRITE(IOIMP,TITI) ' element :',(' pt',IKK,IKK=1,NBNN) 89 : WRITE(TITI,FMT='("(I8,A,",I3,"(1X,I8))")') NBNN2 90 : DO 1000 INNN=1,NBi 91 : c WRITE(IOIMP,1001)(NUM(IKK,INNN),IKK=1,NBNN) 92 : WRITE(IOIMP,TITI) INNN,' :',(NUM(IKK,INNN),IKK=1,NBNN) 93 : 1000 CONTINUE 94 : c 1001 FORMAT(15I8) 95 : 96 : IF(ITYPEL.NE.22) GOTO 199 97 : c - Cas des multiplicateurs de Lagrange - 98 : C ERREUR(-30): Maillage %i1 associé à la condition 99 : INTERR(1)=IGEO 99 : CALL ERREUR(-30) 100 : NBPOIN=NUM(/2) 101 : NBNN=NUM(/1) 102 : c option 'RESUM' : on n'affiche que les NRESU premiere elements 103 : nbi=nbpoin 104 : if( jentet.eq.1) nbi=min (NRESU,nbi) 105 : NBNN2=min(NBNN,NMAX) 106 : c WRITE(TITI,FMT='("(27X,",I3,"(1X,I8))")') NBNN2 107 : WRITE(TITI,FMT='("(1X,A,1X,",I3,"(1X,I8))")') NBNN2 108 : DO 198 J=1,nbi 109 : IF (IERR.NE.0) RETURN 110 : c C ERREUR(-31): Noeuds soumis à la condition : 110 : c CALL ERREUR(-31) 111 : c ecriture des noeuds hors LX (suppose etre en position 1) 112 : c WRITE (IOIMP,203) (NUM(K,J),K=2,NBNN) 113 : c WRITE (IOIMP,TITI) (NUM(K,J),K=2,NBNN) 114 : WRITE (IOIMP,TITI) 'Noeuds soumis à la condition :', 115 : & (NUM(K,J),K=2,NBNN) 116 : c 203 FORMAT(30X,10I8) 117 : c ecriture du noeud LX (suppose etre en position 1) 118 : c ERREUR(-32): Multiplicateurs de Lagrange : %i1 119 : INTERR(1)=NUM(1,J) 119 : CALL ERREUR(-32) 120 : 198 CONTINUE 121 : 199 CONTINUE 122 : c - Fin du Cas des multiplicateurs de Lagrange - 123 : SEGDES MELEME 124 : 125 : c --- boucle sur le matrices elementaires --- 126 : if(jentet.eq.1) nma=min(nma,NRESU) 127 : DO 196 IA=1,NMA 128 : IF (IERR.NE.0) RETURN 129 : * XMATRI=IMATTT(IA) 130 : ** SEGACT XMATRI 131 : NVA=RE(/1) 132 : NVB=RE(/2) 133 : C ERREUR(-33): Matrice élémentaire numéro : %i1 ( ligne1,ligne2,ligne3...) 134 : INTERR(1)= IA 134 : CALL ERREUR(-33) 135 : C ecriture des matrices elementaires REL 136 : c WRITE(IOIMP,195) ((RE(L,K,ia),K=1,NVB),L=1,NVA) 137 : c 195 FORMAT(1X,6E12.5) 138 : c ecriture ligne par ligne 139 : c NMAX= nbre de valeurs max = (nbre caracteres max -1espace -3points) 140 : c = (512)/13 = 39 par exemple 141 : if(NVB.le.NMAX) then 142 : WRITE(TOTO,FMT='("(",I3,"(1X,E12.5),1X,A)")') NVB 143 : do L=1,NVA 144 : WRITE(IOIMP,FMT=TOTO) (RE(L,jou,IA),jou=1,NVB),';' 145 : enddo 146 : else 147 : nbloc=NVB/NMAX 148 : WRITE(TOTO,FMT='("(",I3,"(1X,E12.5),1X,A)")') NMAX 149 : nrest = NVB-(NMAX*nbloc) 150 : c on s assure que : NMAX >= nrest > 0 151 : if(nrest.eq.0) then 152 : nbloc=nbloc-1 153 : nrest=NMAX 154 : endif 155 : WRITE(TOTO2,FMT='("(",I3,"(1X,E12.5),1X,A)")') nrest 156 : do L=1,NVA 157 : jdeb=1 158 : if(nbloc.gt.0) then 159 : do jbloc=1,nbloc 160 : WRITE(IOIMP,FMT=TOTO) (RE(L,jou,IA),jou=jdeb,(jdeb+NMAX-1)),'...' 161 : jdeb=jdeb+NMAX 162 : enddo 163 : endif 164 : WRITE(IOIMP,FMT=TOTO2) (RE(L,jou,IA),jou=jdeb,NVB),';' 165 : enddo 166 : endif 167 : * SEGDES XMATRI 168 : 196 CONTINUE 169 : c --- fin de boucle sur le matrices elementaires --- 170 : SEGDES MELEME 171 : SEGDES xMATRI 172 : 173 : 191 CONTINUE 174 : c --- fin de boucle sur les sous-rigidites ----------------------------- 175 : SEGDES MRIGID 176 : RETURN 177 : END 178 : c 179 : 180 : 181 : 182 :
© Cast3M 2003 - All rights reserved.
Disclaimer