1 : C CRECHP SOURCE PV 13/04/16 21:15:15 7765 2 : SUBROUTINE CRECHP(KTRAV,KCHPOI) 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 : -INC CCOPTIO 34 : -INC SMCHPOI 35 : -INC SMELEME 36 : -INC TMTRAV 37 : SEGMENT/NTRAV/(IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN), 38 : 1 ICO(NNNOE)) 39 : SEGMENT,ILO(0) 40 : SEGMENT,IPE(0) 41 : NN25=25 42 : MTRAV=KTRAV 43 : SEGACT,MTRAV 44 : NNIN=INCO(/2) 45 : NNNOE=IBIN(/2) 46 : N25=(NNIN+NN25-1)/NN25 47 : SEGINI,NTRAV 48 : C 49 : C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER 50 : C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT 51 : C **** SI 2 NOEUDS ONT LES MEMES INCONNUES. 52 : C 53 : J=0 54 : K=1 55 : IO=1 56 : DO 49 I=1,NNIN 57 : J=J+1 58 : IVA(I)=IO 59 : IO=IO*2 60 : IF(J.LT.NN25) GO TO 49 61 : IO=1 62 : J=0 63 : 49 CONTINUE 64 : DO 51 I=1,NNNOE 65 : K=0 66 : DO 510 L=1,N25 67 : L1=1+(L-1)*NN25 68 : L2=L*NN25 69 : L2=MIN(L2,NNIN) 70 : IAFS=0 71 : DO 52 J=L1,L2 72 : IF(IBIN(J,I).EQ.0) GO TO 52 73 : K=L 74 : JJ=J-(L-1)*NN25 75 : IAFS=IAFS+IVA(JJ) 76 : 52 CONTINUE 77 : IBINN(I,L)=IAFS 78 : 510 CONTINUE 79 : ICO(I)=K 80 : 51 CONTINUE 81 : C 82 : C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO. 83 : C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES. 84 : C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J. 85 : C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS. 86 : C 87 : N=0 88 : SEGINI,ILO,IPE 89 : NTROUV=0 90 : DO 53 IDEB=1,NNNOE 91 : IF(ICO(IDEB).NE.0) GO TO 54 92 : 53 CONTINUE 93 : GO TO 540 94 : 54 CONTINUE 95 : 3 CONTINUE 96 : N=N+1 97 : IPE(**)=IDEB 98 : ITES=IDEB 99 : KK=0 100 : DO 1 I=IDEB,NNNOE 101 : DO 2 J=1,N25 102 : IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1 103 : 2 CONTINUE 104 : KK=KK+1 105 : INO(I)=N 106 : ICO(I)=0 107 : 1 CONTINUE 108 : ILO(**)=KK 109 : NTROUV=NTROUV+KK 110 : IF(NTROUV.NE.NNNOE) THEN 111 : DO 4 IDEB=1,NNNOE 112 : IF(ICO(IDEB).NE.0) GO TO 3 113 : 4 CONTINUE 114 : ENDIF 115 : C 116 : C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS 117 : C **** ON INITIALISE LE SEGMENT MCHPOIN 118 : C 119 : C 120 : 540 CONTINUE 121 : NSOUPO=N 122 : NAT=1 123 : SEGINI,MCHPOI 124 : IFOPOI=IFOMOD 125 : JATTRI(1) = 0 126 : MTYPOI=' ' 127 : MOCHDE=' CHPOINT CREE PAR CRECHP' 128 : C 129 : C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT 130 : C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE 131 : C **** SUPPORT 132 : C 133 : IF(NSOUPO.EQ.0) THEN 134 : KCHPOI=MCHPOI 135 : SEGDES,MCHPOI 136 : SEGSUP,NTRAV 137 : SEGDES,MTRAV 138 : SEGSUP ILO,IPE 139 : RETURN 140 : ENDIF 141 : DO 100 I=1,NSOUPO 142 : C 143 : C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA 144 : C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP 145 : C 146 : IHK=IPE(I) 147 : NC=0 148 : DO 20 JK=1,NNIN 149 : IF(IBIN(JK,IHK).EQ.0) GO TO 20 150 : NC=NC+1 151 : IDEJ(NC)=JK 152 : 20 CONTINUE 153 : SEGINI,MSOUPO 154 : IPCHP(I)=MSOUPO 155 : IB=0 156 : DO 14 J=1,NC 157 : NOHARM(J)=NHAR(IDEJ(J)) 158 : 14 NOCOMP(J)=INCO(IDEJ(J)) 159 : C 160 : C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE 161 : C 162 : NBSOUS=0 163 : NBREF=0 164 : NBNN=1 165 : NBELEM=ILO(I) 166 : N=NBELEM 167 : SEGINI,MPOVAL 168 : SEGINI,MELEME 169 : ITYPEL=1 170 : IC=0 171 : DO 16 J=1,NNNOE 172 : IF(INO(J).NE.I) GO TO 16 173 : IC=IC+1 174 : NUM(1,IC)=IGEO(J) 175 : DO 18 K=1,NC 176 : IO=IDEJ(K) 177 : VPOCHA(IC,K)=BB(IO,J) 178 : 18 CONTINUE 179 : 16 CONTINUE 179 : call crech1(meleme,1) 180 : IGEOC=MELEME 181 : IPOVAL=MPOVAL 182 : SEGDES,MPOVAL 183 : SEGDES,MSOUPO 184 : SEGDES,MELEME 185 : 100 CONTINUE 186 : SEGSUP,ILO,IPE 187 : KCHPOI=MCHPOI 188 : SEGDES,MCHPOI 189 : SEGSUP,NTRAV 190 : SEGDES,MTRAV 191 : RETURN 192 : END 193 : 194 : 195 :
© Cast3M 2003 - All rights reserved.
Disclaimer