1 : C ELFTR2 SOURCE CHAT 05/01/12 23:32:48 5004 2 : SUBROUTINE ELFTR2(MATTAC,KNREFE) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ==================================================================== 7 : C = APPELE PAR ELFE = 8 : C = REGROUPEMENT DES JONCTIONS RELIEES PAR DES ELEMENTS RIGIDES EN = 9 : C = UNE SEULE = 10 : C = CREATION : 22/07/87 = 11 : C = PROGRAMMEUR : GUILBAUD = 12 : C ==================================================================== 13 : C 14 : -INC CCOPTIO 15 : -INC SMATTAC 16 : C 17 : SEGMENT MNREFE 18 : INTEGER NREFE(8,NSTR) 19 : INTEGER NTANBN 20 : INTEGER NIDNCN 21 : INTEGER NTVN 22 : POINTEUR NREPA.MPASS 23 : POINTEUR NRECA.MCARA 24 : POINTEUR NRENO.MNORM 25 : POINTEUR NRECPR.ICPR 26 : POINTEUR NREMEL.MELEME 27 : POINTEUR NREDEN.MDEN 28 : ENDSEGMENT 29 : C 30 : C NSTR : NOMBRE D'ELEMENTS 31 : C NREFE(1,I) : MELEME 32 : C NREFE(2,I) : MSOSTU 33 : C NREFE(3,I) : TYPE DE L'ELEMENT 34 : C NREFE(4,I) : NOMBRE DE POINTS DU MELEME 35 : C NREFE(5,I) : NOMBRE DE DDL PAR POINT 36 : C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN 37 : C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN 38 : C NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0 39 : C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS 40 : C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN 41 : C NTVN : LONGUEUR DU TABLEAU VN 42 : C 43 : SEGMENT /JTRAI/(ITRAI(NN)) 44 : SEGMENT /JTRAL/(ITRAL(NSOUMA)) 45 : SEGMENT /JDEJL/(IDEJL(NSOUMA)) 46 : SEGMENT /JDEJA/(IDEJA(NN)) 47 : SEGMENT /JTRAV/(ITRAV(NN)) 48 : C 49 : WRITE(IOIMP,*) ' DEBUT DE ELFTR2 ' 50 : C 51 : MNREFE=KNREFE 52 : NSTR=NREFE(/2) 53 : NN=NSTR 54 : SEGINI JTRAV 55 : NN=0 56 : DO 10 N=1,NSTR 57 : IF(NREFE(8,N).EQ.1) THEN 58 : NN=NN+1 59 : ITRAV(NN)=NREFE(2,N) 60 : ENDIF 61 : 10 CONTINUE 62 : IF(NN.EQ.0) THEN 63 : SEGSUP JTRAV 64 : RETURN 65 : ENDIF 66 : SEGADJ JTRAV 67 : SEGINI JDEJA 68 : SEGINI JTRAI 69 : DO 9 I=1,NN 70 : IDEJA(I)=0 71 : 9 CONTINUE 72 : SEGACT MATTAC 73 : NSOUMA=LISATT(/1) 74 : SEGINI JDEJL,JTRAL 75 : DO 11 I=1,NSOUMA 76 : IDEJL(I)=0 77 : 11 CONTINUE 78 : N=NSOUMA 79 : SEGINI MATTA1 80 : C 81 : C BOUCLE SUR LES ELEMENTS RIGIDES 82 : C 83 : NKK=0 84 : DO 130 NE=1,NN 85 : IF(IDEJA(NE).EQ.0) THEN 86 : WRITE(IOIMP,*) ' ELEMENT RIGIDE NE = ',NE 87 : NI1=1 88 : NI2=1 89 : ITRAI(NI1)=NE 90 : NLL=0 91 : NL1=1 92 : IDEJA(NE)=1 93 : 15 CONTINUE 94 : C 95 : C 1 - RECHERCHE DE TOUTES LES NOUVELLES LIAISONS QUI S'APPUIENT SUR 96 : C LES DERNIERS ELEMENTS RIGIDES TROUVES 97 : C 98 : DO 60 NI=NI1,NI2 99 : NK=ITRAI(NI) 100 : MSOST1=ITRAV(NK) 101 : IDEJA(NK)=1 102 : DO 40 NSOU=1,NSOUMA 103 : IF(IDEJL(NSOU).EQ.0) THEN 104 : MSOUMA=LISATT(NSOU) 105 : SEGACT MSOUMA 106 : NJON=IATREL(/1) 107 : DO 30 NJ=1,NJON 108 : MJONCT=IATREL(NJ) 109 : SEGACT MJONCT 110 : NTJ=ISTRJO(/1) 111 : DO 20 J=1,NTJ 112 : MSOSTU=ISTRJO(J) 113 : IF(MSOSTU.EQ.MSOST1) THEN 114 : NLL=NLL+1 115 : ITRAL(NLL)=NSOU 116 : SEGDES MJONCT,MSOUMA 117 : IDEJL(NSOU)=1 118 : GOTO 40 119 : ENDIF 120 : 20 CONTINUE 121 : SEGDES MJONCT 122 : 30 CONTINUE 123 : SEGDES MSOUMA 124 : ENDIF 125 : 40 CONTINUE 126 : 60 CONTINUE 127 : WRITE(IOIMP,*) ' NI1 NI2 ',NI1,NI2 128 : WRITE(IOIMP,*) ' ITRAL ',(ITRAL(NLLL),NLLL=1,NLL) 129 : WRITE(IOIMP,*) ' IDEJA ',(IDEJA(NLLL),NLLL=1,NN) 130 : C 131 : C 2 - RECHERCHE DE TOUS LES NOUVEAUX ELEMENTS RIGIDES SUR LESQUELS 132 : C S'APPUIENT LES DERNIERES LIAISONS TROUVEES 133 : C 134 : NI=NI2 135 : DO 100 NL=NL1,NLL 136 : NSOU=ITRAL(NL) 137 : MSOUMA=LISATT(NSOU) 138 : SEGACT MSOUMA 139 : NJON=IATREL(/1) 140 : DO 90 NJ=1,NJON 141 : MJONCT=IATREL(NJ) 142 : SEGACT MJONCT 143 : NTJ=ISTRJO(/1) 144 : DO 80 J=1,NTJ 145 : MSOSTU=ISTRJO(J) 146 : DO 70 KK=1,NN 147 : IF(IDEJA(KK).EQ.0.AND.MSOSTU.EQ.ITRAV(KK)) THEN 148 : NI=NI+1 149 : ITRAI(NI)=KK 150 : IDEJA(KK)=1 151 : GOTO 80 152 : ENDIF 153 : 70 CONTINUE 154 : 80 CONTINUE 155 : SEGDES MJONCT 156 : 90 CONTINUE 157 : SEGDES MSOUMA 158 : C IDEJL(NSOU)=1 159 : 100 CONTINUE 160 : WRITE(IOIMP,*) ' NL1 NLL ',NL1,NLL 161 : WRITE(IOIMP,*) ' ITRAI ',(ITRAI(NLLL),NLLL=1,NI) 162 : WRITE(IOIMP,*) ' IDEJL ',(IDEJL(NLLL),NLLL=1,NSOUMA) 163 : NL1=NLL+1 164 : NI1=NI2+1 165 : NI2=NI 166 : IF(NI2.GE.NI1) GOTO 15 167 : M=0 168 : N=0 169 : SEGINI MSOUM1 170 : MSOUM1.IGEOCH=0 171 : MSOUM1.IPHYCH=0 172 : MSOUM1.ITYATT='MECA' 173 : NJJ=0 174 : DO 120 NL=1,NLL 175 : NSOU=ITRAL(NL) 176 : MSOUMA=LISATT(NSOU) 177 : SEGACT MSOUMA 178 : NJON=IATREL(/1) 179 : N=NJJ+NJON 180 : SEGADJ MSOUM1 181 : DO 110 NJ=1,NJON 182 : NJJ=NJJ+1 183 : MSOUM1.IATREL(NJJ)=IATREL(NJ) 184 : 110 CONTINUE 185 : SEGSUP MSOUMA 186 : 120 CONTINUE 187 : SEGDES MSOUM1 188 : NKK=NKK+1 189 : MATTA1.LISATT(NKK)=MSOUM1 190 : ENDIF 191 : 130 CONTINUE 192 : DO 140 NSOU=1,NSOUMA 193 : IF(IDEJL(NSOU).EQ.0) THEN 194 : NKK=NKK+1 195 : MATTA1.LISATT(NKK)=LISATT(NSOU) 196 : ENDIF 197 : 140 CONTINUE 198 : N=NKK 199 : SEGADJ MATTA1 200 : SEGSUP MATTAC,JTRAL,JDEJL,JDEJA,JTRAV,JTRAI 201 : MATTAC=MATTA1 202 : C 203 : IF(IIMPI.EQ.1) THEN 204 : WRITE(IOIMP,105) MATTAC 205 : 105 FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///) 206 : NATTA=LISATT(/1) 207 : WRITE(IOIMP,101) 208 : 101 FORMAT(10X,28('*')) 209 : WRITE(IOIMP,102) 210 : 102 FORMAT(10X,'* MSOUMA * ITYATT * IATREL *') 211 : WRITE(IOIMP,101) 212 : DO 160 IL=1,NATTA 213 : MSOUMA=LISATT(IL) 214 : SEGACT MSOUMA 215 : WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1) 216 : 103 FORMAT(10X,'* ',I4,' * ',A4,' * ',I4,' * ') 217 : NRELA=IATREL(/1) 218 : DO 150 IN=2,NRELA 219 : WRITE(IOIMP,104) IATREL(IN) 220 : 104 FORMAT(10X,2('* '),'* ',I4,' *') 221 : 150 CONTINUE 222 : SEGDES MSOUMA 223 : WRITE(IOIMP,101) 224 : 160 CONTINUE 225 : ENDIF 226 : SEGDES MATTAC 227 : WRITE(IOIMP,*) ' FIN DE ELFTR2 ' 228 : RETURN 229 : END 230 :
© Cast3M 2003 - All rights reserved.
Disclaimer