1 : C SUBNNM SOURCE CHAT 11/03/16 21:31:52 6902 2 : SUBROUTINE SUBNNM(IPM,IPNN,IMD,IRET) 3 : C====================================================================C 4 : C C 5 : C OPERATEUR CABLE : Localisation d un element d un cable dans C 6 : C dans un element massif par la position de son milieu 7 : C le cable original a deja ete fragmente aux limites des C 8 : C elements massifs qu'il traverse par passage dans subinc C C 9 : C ENTREES : C 10 : C C 11 : C IPM(1 et 2) : Pointeurs sur les modèles de béton et d'aciers C 12 : C IMD : Nombre de modeles introduits dans IPM 13 : C 1 beton plus pour le moment 1 seul cable par modele 14 : C sauf pour les cerc axis C 15 : C C 16 : C SORTIES : C 17 : C C 18 : C IPM(3) : Pointeur sur le modele acier modifié C 19 : C IPNN C 20 : C--------------------------------------------------------------------C 21 : C C 22 : C====================================================================C 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : C 26 : -INC CCOPTIO 27 : -INC CCHAMP 28 : *- 29 : -INC CCREEL 30 : -INC SMELEME 31 : -INC SMMODEL 32 : -INC SMCOORD 33 : -INC SMLREEL 34 : -INC SMINTE 35 : -INC SMCHAML 36 : -INC CCGEOME 37 : 38 : segment icount 39 : integer ieint(2,nodes),maxpz(1) 40 : real*8 qqq(3,nodes) 41 : endsegment 42 : segment icosom 43 : integer iptt(nbsz) 44 : endsegment 45 : 46 : segment iexclu 47 : integer idejvu(nbpts) 48 : endsegment 49 : segment wrk1 50 : real*8 x1(3),x2(3),dx(3),p1(3),p2(3),p3(3) 51 : endsegment 52 : segment itabu 53 : integer inzel(2,nbpts) 54 : endsegment 55 : segment iccmai 56 : integer icmail(nsous) 57 : endsegment 58 : segment icofac 59 : integer inodfa1(25),inodfa2(25),icomn(10) 60 : endsegment 61 : 62 : segment ipnn 63 : integer ipnnum(nsous) 64 : endsegment 65 : segment nnum 66 : integer nnm(nbn,nbele),nbem(2,nbele) 67 : endsegment 68 : 69 : C 70 : SEGMENT NOTYPE 71 : CHARACTER*16 TYPE(NBTYPE) 72 : ENDSEGMENT 73 : C 74 : C 75 : CHARACTER*4 CMOT 76 : CHARACTER*8 CMATE 77 : CHARACTER*(NCONCH) CONM 78 : PARAMETER ( NINF=3 ) 79 : INTEGER INFOS(NINF) 80 : DIMENSION IPM(*) 81 : DATA EPSI/1.D-3/ 82 : C 83 : IPCHE=0 84 : IPCHE2=0 85 : MELVAL=0 86 : IRET=1 87 : 88 : IM=2 89 : C IF(IM.EQ.IMD+1.AND.IMD.NE.1) GOTO 9999 90 : IF(IMD.EQ.1) GOTO 5 91 : C 92 : C --- ACTIVATION DU model cable 93 : C 94 : MMODEL = IPM(IM) 95 : IM=IM+1 96 : SEGACT MMODEL 97 : NSOU1 = KMODEL(/1) 98 : 99 : 100 : 5 CONTINUE 101 : IF(IMD.EQ.1) NSOU1=1 102 : C 103 : C --- boucle sur les elemenst cable ( en fait 1 seul pour le moment) 104 : C 105 : DO 40 ISOU1=1,NSOU1 106 : IF(ISOU1.GT.1) THEN 107 : MMODEL = IPM(IM-1) 108 : SEGACT MMODEL 109 : END IF 110 : IMODEL=KMODEL(ISOU1) 111 : SEGACT IMODEL*MOD 112 : MELC = NEFMOD 113 : MELEM=MELE 114 : IPMAIL= IMAMOD 115 : CONM = CONMOD 116 : 116 : * CALL ELQUOI(MELC,0,3,IPINF,IMODEL) 117 : IF ( IERR.NE.0 ) THEN 118 : SEGDES IMODEL,MMODEL 119 : IRET=0 120 : RETURN 121 : END IF 122 : * INFO=IPINF 123 : * SEGSUP INFO 124 : C 125 : MELEME=IPMAIL 126 : SEGACT MELEME 127 : 128 : C attention pour le moment seg2 uniquement 129 : 130 : 131 : C activation du modele beton 132 : 133 : MMODEL = IPM(1) 134 : SEGACT MMODEL 135 : NSOUS = KMODEL(/1) 136 : NS=NSOUS 137 : 138 : segini IPNN 139 : 140 : nbpti = xcoor(/1)/(idim+1) 141 : nbpts=nbpti 142 : 143 : ipt2 = ipmail 144 : segact ipt2 145 : 146 : if(melc.ne.95) then 147 : idi4=idim+1 148 : nbnn=1 149 : nbelem=ipt2.num(/2) 150 : NBSOUS=0 151 : NBREF=0 152 : segini ipt3 153 : ipt3.itypel=1 154 : nbpts=nbpti+nbelem 155 : segadj mcoord 156 : 157 : do 400 k=1,nbelem 158 : i1=ipt2.num(1,k) 159 : i2=ipt2.num(2,k) 160 : ip =nbpti+k 161 : ipt3.num(1,k) =ip 162 : 163 : xmil=(xcoor((i1-1)*idi4+1)+xcoor((i2-1)*idi4+1))/2.D0 164 : ymil=(xcoor((i1-1)*idi4+2)+xcoor((i2-1)*idi4+2))/2.D0 165 : xcoor((ip-1)*idi4+1) = xmil 166 : xcoor((ip-1)*idi4+2) = ymil 167 : if(idim.eq.3) then 168 : zmil=(xcoor((i1-1)*idi4+3)+xcoor((i2-1)*idi4+3))/2.D0 169 : xcoor((ip-1)*idi4+3) = zmil 170 : endif 171 : 400 continue 172 : else 173 : segini ,ipt3=ipt2 174 : endif 175 : 176 : segdes ipt3 177 : 178 : C nodes = ipt2.num(/2) 179 : C on aura besoin du point initial 180 : C ipinit = ipt2.num(1,1) 181 : C 182 : 183 : C on veut savoir si il y a des point vus deux fois (interfaces sous zones) 184 : segini iexclu 185 : iexx = iexclu 186 : C 187 : C --- BOUCLE SUR LES ZONES ELEMENTAIRES DU BETON 188 : 189 : C 190 : NBSZ = NSOUS 191 : segini icosom 192 : iaccro = 0 193 : 194 : DO 22 ISOUS=1,NSOUS 195 : IMODEL=KMODEL(ISOUS) 196 : SEGACT IMODEL 197 : MELE = NEFMOD 198 : IPMAIL= IMAMOD 199 : 200 : MELEME=IPMAIL 201 : SEGACT MELEME 202 : 203 : if (itypel.lt.4) then 203 : call erreur(16) 204 : C attention a completer probablement 205 : segdes meleme 206 : return 207 : endif 208 : C segdes meleme 209 : C icmail(isous) = ipmail 210 : 211 : 212 : C ICI LE ZONAGE 213 : C============================================ 213 : CALL ZONAG(ipmail,ipt3,ICC,IEXX,1) 214 : C============================================ 215 : C 216 : C TABLE DES POINTEURS SUR LES TABLEAUX DE CORRESPONDANCE 217 : C WRITE(6,*) 'POINTEUR ZONE ',IOB,ICC 218 : IPTT(isous) = ICC 219 : ICOUNT = ICC 220 : SEGACT ICOUNT 221 : iaccro = iaccro + MAXPZ(1) 222 : C do 777 i=1,MAXPZ(1) 223 : C write(6,*)'zone ',i' 'point ',IEINT(1,I),'elem ',IEINT(2,I) 224 : C 777 continue 225 : 226 : C SEGDES ICOUNT 227 : 22 CONTINUE 228 : 229 : C segsup wrk1 230 : 40 continue 231 : segsup iexclu 232 : nbpts = xcoor(/1)/(idim+1) 233 : segini itabu 234 : 235 : do 140 izon = 1,nsous 236 : icc = iptt(izon) 237 : icount= icc 238 : C segact icount 239 : if(maxpz(1).eq.0) goto 139 240 : do 141 i=1,maxpz(1) 241 : kk = ieint(1,i) 242 : inzel(1,kk) = izon 243 : inzel(2,kk) = ieint(2,i) 244 : C write(6,*) kk ,izon,ieint(2,i) 245 : 141 continue 246 : 139 segdes icount 247 : 140 continue 248 : 249 : nbn=ipt2.num(/1) 250 : nbele=ipt2.num(/2) 251 : segini nnum 252 : ipnnum(1)=nnum 253 : C write(6,*) 'subinn ipnn nnum ',ipnn,nnum 254 : 255 : C segact ipt2 256 : 257 : izel = 0 258 : 259 : do 100 iel=1,nbele 260 : do 110 il=1,nbn 261 : nnm(il,iel)=ipt2.num(il,iel) 262 : 110 continue 263 : 264 : if(melc.ne.95) then 265 : C sous zone a laquelle appartientt l element iel 266 : nbem(2,iel) = inzel(1,nbpti+iel) 267 : C element beton contenant le cable iel 268 : nbem(1,iel) = inzel(2,nbpti+iel) 269 : else 270 : nbem(2,iel) = inzel(1,ipt2.num(1,iel)) 271 : nbem(1,iel) = inzel(2,ipt2.num(1,iel)) 272 : endif 273 : 274 : C write(6,2222)iel, nnm(1,iel),nnm(2,iel),nbem(1,iel), 275 : C & nbem(2,iel) 276 : 100 continue 277 : segsup itabu,icosom 278 : nbpts=nbpti 279 : segadj mcoord 280 : 281 : segdes nnum 282 : C110 continue 283 : 2222 FORMAT(I4,2X,2I4,2X,2I4) 284 : IMD = 2 285 : 286 : segsup ipt3 287 : SEGDES IMODEL,ipnn,ipt2 288 : 289 : C 290 : RETURN 291 : END 292 : 293 : 294 : 295 : 296 : 297 : 298 : 299 : 300 : 301 : 302 : 303 : 304 : 305 : 306 : 307 : 308 : 309 : 310 : 311 : 312 : 313 : 314 : 315 : 316 : 317 :
© Cast3M 2003 - All rights reserved.
Disclaimer