1 : C ELFTRI SOURCE CHAT 05/01/12 23:32:53 5004 2 : SUBROUTINE ELFTRI(MATTAC,KNREFE,MATTA1) 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 LIAISONS ELEMENTAIRES CONSTITUANT UNE JONCTION = 9 : C = CREATION : 22/07/87 = 10 : C = PROGRAMMEUR : GUILBAUD = 11 : C ==================================================================== 12 : C 13 : -INC CCOPTIO 14 : -INC SMATTAC 15 : -INC SMELEME 16 : -INC SMCHPOI 17 : -INC SMCOORD 18 : C 19 : SEGMENT MNREFE 20 : INTEGER NREFE(7,NSTR) 21 : INTEGER NTANBN 22 : INTEGER NIDNCN 23 : INTEGER NTVN 24 : POINTEUR NREPA.MPASS 25 : POINTEUR NRECA.MCARA 26 : POINTEUR NRENO.MNORM 27 : POINTEUR NRECPR.ICPR 28 : POINTEUR NREMEL.MELEME 29 : POINTEUR NREMAT.MATGRE 30 : ENDSEGMENT 31 : C 32 : C NSTR : NOMBRE D'ELEMENTS 33 : C NREFE(1,I) : MELEME 34 : C NREFE(2,I) : MSOSTU 35 : C NREFE(3,I) : TYPE DE L'ELEMENT 36 : C NREFE(4,I) : NOMBRE DE POINTS DU MELEME 37 : C NREFE(5,I) : NOMBRE DE DDL PAR POINT 38 : C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN 39 : C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN 40 : C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS 41 : C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN 42 : C NTVN : LONGUEUR DU TABLEAU VN 43 : C 44 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 45 : SEGMENT /JTRAK/(ITRAK(NJONT)) 46 : SEGMENT /JTRAJ/(ITRAJ(NJONT)) 47 : SEGMENT /JDEJA/(IDEJA(NBPTOT)) 48 : SEGMENT /JTRAS/(ITRAS(NBPTOT)) 49 : C 50 : WRITE(IOIMP,*) ' DEBUT DE ELFTRI ' 51 : C 52 : SEGACT MCOORD 53 : SEGINI ICPR 54 : MNREFE=KNREFE 55 : MELEME=NREMEL 56 : SEGACT MELEME 57 : NBPTOT=NUM(/2) 58 : SEGINI JDEJA,JTRAS 59 : DO 5 NBP=1,NBPTOT 60 : ICPR(NUM(1,NBP))=NBP 61 : IDEJA(NBP)=0 62 : ITRAS(NBP)=0 63 : 5 CONTINUE 64 : C 65 : SEGACT MATTAC 66 : NSOUMA=LISATT(/1) 67 : NJONT=0 68 : NJONP=0 69 : SEGINI JTRAJ,JTRAK 70 : DO 20 NSOU=1,NSOUMA 71 : MSOUMA=LISATT(NSOU) 72 : SEGACT MSOUMA 73 : NJON=IATREL(/1) 74 : NJONT=NJONT+NJON 75 : SEGADJ JTRAJ 76 : SEGADJ JTRAK 77 : DO 10 NJ=1,NJON 78 : ITRAJ(NJONP+NJ)=IATREL(NJ) 79 : ITRAK(NJONP+NJ)=0 80 : 10 CONTINUE 81 : SEGDES MSOUMA 82 : NJONP=NJONT 83 : 20 CONTINUE 84 : SEGDES MATTAC 85 : C 86 : N=NJONT 87 : M=0 88 : SEGINI MATTA1 89 : NSOU=0 90 : DO 70 NBP=1,NBPTOT 91 : C RECHERCHE SUR LES POINTS DONT L'APPARTENANCE AUX LIAISONS N'EST PAS 92 : C ENCORE ETABLIE 93 : IF(IDEJA(NBP).EQ.0) THEN 94 : NI=0 95 : NSOU=NSOU+1 96 : N=NJONT 97 : SEGINI MSOUMA 98 : MATTA1.LISATT(NSOU)=MSOUMA 99 : NV=1 100 : NVV=1 101 : ITRAS(1)=NUM(1,NBP) 102 : IDEJA(NBP)=1 103 : C RECHERCHE SUR LES POINTS DEJA CONNUS D'UNE JONCTION POUR TROUVER 104 : C TOUTES LES LIAISONS ELEMENTAIRES DE CETTE JONCTION 105 : 100 CONTINUE 106 : IKI=ITRAS(NV) 107 : C 108 : DO 60 NJ=1,NJONT 109 : C RECHERCHE SUR LES LIAISONS ELEMENTAIRES NON DEJA TROUVEES 110 : IF(ITRAK(NJ).EQ.0) THEN 111 : MJONCT=ITRAJ(NJ) 112 : SEGACT MJONCT 113 : NCHP=IPCHJO(/1) 114 : DO 55 NFOIS=1,2 115 : DO 50 NST=1,NCHP 116 : MCHPOI=IPCHJO(NST) 117 : SEGACT MCHPOI 118 : NSOUPO=IPCHP(/1) 119 : DO 40 NS=1,NSOUPO 120 : MSOUPO=IPCHP(NS) 121 : SEGACT MSOUPO 122 : IPT1=IGEOC 123 : SEGACT IPT1 124 : NBELEM=IPT1.NUM(/2) 125 : IF(NFOIS.EQ.1) THEN 126 : C NFOIS=1 ON RECHERCHE SI LA LIAISON ELEMENTAIRE PORTE SUR LE POINT 127 : DO 30 NB=1,NBELEM 128 : IKI1=IPT1.NUM(1,NB) 129 : IF(IKI1.EQ.IKI) GOTO 55 130 : 30 CONTINUE 131 : ELSE 132 : C NFOIS=2 ON RASSEMBLE TOUS LES POINTS CONCERNES PAR CETTE LIAISON 133 : DO 35 NBB=1,NBELEM 134 : IKI2=IPT1.NUM(1,NBB) 135 : IPP=ICPR(IKI2) 136 : IF(IDEJA(IPP).EQ.0) THEN 137 : NVV=NVV+1 138 : ITRAS(NVV)=IKI2 139 : IDEJA(IPP)=1 140 : ENDIF 141 : 35 CONTINUE 142 : ENDIF 143 : SEGDES MSOUPO,IPT1 144 : 40 CONTINUE 145 : SEGDES MCHPOI 146 : 50 CONTINUE 147 : IF(NFOIS.EQ.1) GOTO 57 148 : ITRAK(NJ)=NSOU 149 : NI=NI+1 150 : IATREL(NI)=ITRAJ(NJ) 151 : 55 CONTINUE 152 : 57 CONTINUE 153 : SEGDES MJONCT 154 : ENDIF 155 : 60 CONTINUE 156 : C 157 : NV=NV+1 158 : IF(NV.LE.NVV) GOTO 100 159 : C 160 : IF(NI.EQ.0) THEN 161 : C *** LE POINT N'APPARTIENT PAS AUX LIAISONS 162 : INTERR(1)=NUM(1,NBP) 162 : CALL ERREUR(383) 163 : SEGSUP JTRAK,JTRAJ,JDEJA,JTRAS,ICPR 164 : NSOU1=NSOU-1 165 : DO 65 NS=1,NSOU1 166 : MSOUMA=MATTA1.LISATT(NS) 167 : IF(MSOUMA.NE.0) SEGSUP MSOUMA 168 : 65 CONTINUE 169 : SEGSUP MATTA1 170 : MATTA1=0 171 : RETURN 172 : ELSE 173 : N=NI 174 : SEGADJ MSOUMA 175 : IGEOCH=0 176 : IPHYCH=0 177 : ITYATT='MECA' 178 : SEGDES MSOUMA 179 : ENDIF 180 : ENDIF 181 : 70 CONTINUE 182 : C 183 : N=NSOU 184 : SEGADJ MATTA1 185 : C 186 : IF(IIMPI.EQ.1) THEN 187 : WRITE(IOIMP,105) MATTA1 188 : 105 FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///) 189 : NATTA=MATTA1.LISATT(/1) 190 : WRITE(IOIMP,101) 191 : 101 FORMAT(10X,28('*')) 192 : WRITE(IOIMP,102) 193 : 102 FORMAT(10X,'* MSOUMA * ITYATT * IATREL *') 194 : WRITE(IOIMP,101) 195 : DO 90 IL=1,NATTA 196 : MSOUMA=MATTA1.LISATT(IL) 197 : SEGACT MSOUMA 198 : WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1) 199 : 103 FORMAT(10X,'* ',I4,' * ',A4,' * ',I4,' * ') 200 : NRELA=IATREL(/1) 201 : DO 80 IN=2,NRELA 202 : WRITE(IOIMP,104) IATREL(IN) 203 : 104 FORMAT(10X,2('* '),'* ',I4,' *') 204 : 80 CONTINUE 205 : SEGDES MSOUMA 206 : WRITE(IOIMP,101) 207 : 90 CONTINUE 208 : ENDIF 209 : SEGDES MATTA1 210 : SEGSUP JTRAJ,JDEJA,ICPR,JTRAS,JTRAK 211 : WRITE(IOIMP,*) ' FIN DE ELFTRI ' 212 : RETURN 213 : END 214 :
© Cast3M 2003 - All rights reserved.
Disclaimer