1 : C CRECH3 SOURCE PV 13/04/16 21:15:14 7765 2 : SUBROUTINE CRECH3(KTRAV,KCHPOI,NND,MRIGID) 3 : C 4 : C 5 : C 6 : C ******** CE SUBROUTINE SERT A CREER UN CHAMP POINT A PARTIR 7 : C ******** D'UN SEGMENT MTRAV. 8 : C 9 : C ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES. 10 : C 11 : C ******** BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR 12 : C ******** LE JEME NOEUD DU TABLEAU IGEO. 13 : C 14 : C ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP 15 : C ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO. 16 : C 17 : C ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR 18 : C ******** REFERENCER LE IEME NOEUD 19 : C 20 : C ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU 21 : C ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN 22 : C 23 : C ******** ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE 24 : C ******** POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT 25 : C ******** PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE. 26 : C 27 : C 28 : C *** POUR PLUS DE RENSEIGNEMENTS VOIR CHARRAS. 29 : C 30 : C 31 : C 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : -INC CCOPTIO 35 : -INC SMCHPOI 36 : -INC SMELEME 37 : -INC TMTRAV 38 : -INC SMRIGID 39 : -INC TMVECRIG 40 : -INC SMMATRI 41 : SEGMENT NTRAV 42 : INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN) 43 : INTEGER ICO(NNNOE),ipoinc(nnin) 44 : ENDSEGMENT 45 : SEGMENT,ILO(0) 46 : SEGMENT,IPE(0) 47 : segact,mrigid*mod 48 : MMATRI=ICHOLE 49 : SEGACT MMATRI 50 : mimik=iimik 51 : midua=iidua 52 : NN25=25 53 : MTRAV=KTRAV 54 : SEGACT,MTRAV 55 : NNIN=INCO(/2) 56 : NNNOE=IBIN(/2) 57 : N25=(NNIN+NN25-1)/NN25 58 : SEGINI,NTRAV 59 : * on recherche dans quelle position est inco par rapport à mimik 60 : itrouv=0 61 : do ia=1,imik(/2) 62 : do ib=1,nnin 63 : if( inco( ib).eq.imik(ia) )then 64 : itrouv=1 65 : ipoinc(ib)=ia 66 : endif 67 : enddo 68 : enddo 69 : C 70 : C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER 71 : C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT 72 : C **** SI 2 NOEUDS ONT LES MEMES INCONNUES. 73 : C 74 : J=0 75 : K=1 76 : IO=1 77 : DO 49 I=1,NNIN 78 : J=J+1 79 : IVA(I)=IO 80 : IO=IO*2 81 : IF(J.LT.NN25) GO TO 49 82 : IO=1 83 : J=0 84 : 49 CONTINUE 85 : maxinc=0 86 : DO 51 I=1,NNNOE 87 : K=0 88 : maxinl=0 89 : DO 510 L=1,N25 90 : L1=1+(L-1)*NN25 91 : L2=L*NN25 92 : L2=MIN(L2,NNIN) 93 : IAFS=0 94 : DO 52 J=L1,L2 95 : IF(IBIN(J,I).EQ.0) GO TO 52 96 : K=L 97 : maxinl=maxinl+1 98 : JJ=J-(L-1)*NN25 99 : IAFS=IAFS+IVA(JJ) 100 : 52 CONTINUE 101 : IBINN(I,L)=IAFS 102 : 510 CONTINUE 103 : ICO(I)=K 104 : maxinc=max(maxinc,maxinl) 105 : 51 CONTINUE 106 : C 107 : C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO. 108 : C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES. 109 : C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J. 110 : C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS. 111 : C 112 : N=0 113 : SEGINI,ILO,IPE 114 : NTROUV=0 115 : DO 53 IDEB=1,NNNOE 116 : IF(ICO(IDEB).NE.0) GO TO 54 117 : 53 CONTINUE 118 : GO TO 540 119 : 54 CONTINUE 120 : 3 CONTINUE 121 : N=N+1 122 : IPE(**)=IDEB 123 : ITES=IDEB 124 : KK=0 125 : DO 1 I=IDEB,NNNOE 126 : DO 2 J=1,N25 127 : IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1 128 : 2 CONTINUE 129 : KK=KK+1 130 : INO(I)=N 131 : ICO(I)=0 132 : 1 CONTINUE 133 : ILO(**)=KK 134 : NTROUV=NTROUV+KK 135 : IF(NTROUV.NE.NNNOE) THEN 136 : DO 4 IDEB=1,NNNOE 137 : IF(ICO(IDEB).NE.0) GO TO 3 138 : 4 CONTINUE 139 : ENDIF 140 : C 141 : C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS 142 : C **** ON INITIALISE LE SEGMENT MCHPOIN 143 : C 144 : C 145 : 540 CONTINUE 146 : 147 : NSOUPO=N 148 : idimve=nnd 149 : segini mvecri 150 : NAT=1 151 : SEGINI,MCHPOI 152 : IFOPOI=IFOMOD 153 : JATTRI(1) = 0 154 : MTYPOI=' ' 155 : MOCHDE=' CHPOINT CREE PAR CRECH3' 156 : C 157 : C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT 158 : C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE 159 : C **** SUPPORT 160 : C 161 : IF(NSOUPO.EQ.0) THEN 162 : KCHPOI=MCHPOI 163 : SEGDES,MCHPOI 164 : SEGSUP,NTRAV 165 : SEGDES,MTRAV 166 : SEGSUP ILO,IPE 167 : RETURN 168 : ENDIF 169 : DO 100 I=1,NSOUPO 170 : C 171 : C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA 172 : C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP 173 : C 174 : IHK=IPE(I) 175 : NC=0 176 : DO 20 JK=1,NNIN 177 : IF(IBIN(JK,IHK).EQ.0) GO TO 20 178 : NC=NC+1 179 : IDEJ(NC)=JK 180 : 20 CONTINUE 181 : SEGINI,MSOUPO 182 : IPCHP(I)=MSOUPO 183 : IB=0 184 : DO 14 J=1,NC 185 : NOHARM(J)=NHAR(IDEJ(J)) 186 : naminc(i,j)=imik(IPOINC(idej(j))) 187 : namdua(i,j)=idua(ipoinc(idej(j))) 188 : NUMHAR(i,j)=NOHARM(J) 189 : 14 NOCOMP(J)=INCO(IDEJ(J)) 190 : C 191 : C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE 192 : C 193 : NBSOUS=0 194 : NBREF=0 195 : NBNN=1 196 : NBELEM=ILO(I) 197 : N=NBELEM 198 : SEGINI,MPOVAL 199 : SEGINI,MELEME 200 : numnom(I)=nc 201 : numnoe(i)=n 202 : ITYPEL=1 203 : IC=0 204 : DO 16 J=1,NNNOE 205 : IF(INO(J).NE.I) GO TO 16 206 : IC=IC+1 207 : NUM(1,IC)=IGEO(J) 208 : DO 18 K=1,NC 209 : IO=IDEJ(K) 210 : VPOCHA(IC,K)=BB(IO,J) 211 : ikk=ibin(io,j) 212 : numzon(ikk)=i 213 : nunolo(ikk)=ic 214 : nuinlo(ikk)=k 215 : 18 CONTINUE 216 : 16 CONTINUE 216 : call crech1(meleme,1) 217 : melzon(i)=meleme 218 : IGEOC=MELEME 219 : IPOVAL=MPOVAL 220 : SEGDES,MPOVAL 221 : SEGDES,MSOUPO 222 : SEGDES,MELEME 223 : 100 CONTINUE 224 : SEGSUP,ILO,IPE 225 : KCHPOI=MCHPOI 226 : ivecri=mvecri 227 : segdes mvecri 228 : SEGDES,MCHPOI 229 : SEGSUP,NTRAV 230 : RETURN 231 : END 232 : 233 : 234 : 235 : 236 :
© Cast3M 2003 - All rights reserved.
Disclaimer