1 : C DYN207 SOURCE CHAT 05/01/12 23:11:15 5004 2 : C DYN206 SOURCE LAVARENN 96/10/30 21:23:03 2349 3 : SUBROUTINE DYN207(I,ITLB,ITYP,KTLIAB,NPLB) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Remplissage des tableaux de description des liaisons sur * 12 : * la base à partir des informations contenues dans la * 13 : * table ILIB * 14 : * Liaison ligne_cercle avec ou sans amortissement * 15 : * * 16 : * Paramètres: * 17 : * * 18 : * e I Numéro de la liaison. * 19 : * e ITLB Table rassemblant la description d'une liaison. * 20 : * e ITYP Type de la liaison. * 21 : * s KTLIAB Segment descriptif des liaisons sur base B. * 22 : * e NPLB Nombre total de points. * 23 : * * 24 : * * 25 : * Auteur, date de création: * 26 : * * 27 : * Ibrahim PINTO,05/97 * 28 : * * 29 : *--------------------------------------------------------------------* 30 : -INC CCOPTIO 31 : -INC SMCOORD 32 : -INC SMELEME 33 : -INC SMCHPOI 34 : * 35 : SEGMENT MTLIAB 36 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 37 : REAL*8 XPALB(NLIAB,NXPALB) 38 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 39 : ENDSEGMENT 40 : * 41 : SEGMENT MLIGNE 42 : INTEGER KPLIB(NPLB) 43 : ENDSEGMENT 44 : * 45 : LOGICAL L1,L0 46 : CHARACTER*8 MONAMO,MONESC,MONREC,MONRAY,CMOT,CMOT1,MONINV 47 : CHARACTER*8 MONCAL,CMOT2,CHARRE 48 : * 49 : MTLIAB = KTLIAB 50 : SEGINI MLIGNE 51 : * 52 : * --- choc élémentaire LIGNE_CERCLE_FROTTEMENT 53 : * avec ou sans amortissement 54 : * 54 : CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0, 55 : & 'MAILLAGE',I1,X1,' ',L1,IMAI) 56 : IF (IERR.NE.0) RETURN 57 : MONESC = ' ' 57 : CALL ACCTAB(ITLB,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0, 58 : & MONESC,I1,X1,CHARRE,L1,IESC) 59 : IF (IERR.NE.0) RETURN 59 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEURS',L0,IP0, 60 : & 'CHPOINT',I0,X1,' ',L1,IRAIES) 61 : IF (IERR.NE.0) RETURN 61 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_GLISSEMENT',L0,IP0, 62 : & 'FLOTTANT',I0,XGLIS,' ',L1,IP1) 63 : IF (IERR.NE.0) RETURN 63 : CALL ACCTAB(ITLB,'MOT',I1,X0,'COEFFICIENT_ADHERENCE',L0,IP0, 64 : & 'FLOTTANT',I0,XADHE,' ',L1,IP1) 65 : IF (IERR.NE.0) RETURN 65 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR_TANGENTIELLE',L0,IP0, 66 : & 'FLOTTANT',I0,XRAIT,' ',L1,IP1) 67 : IF (IERR.NE.0) RETURN 67 : CALL ACCTAB(ITLB,'MOT',I1,X0,'AMORTISSEMENT_TANGENTIEL',L0, 68 : & IP0,'FLOTTANT',I0,XAMOT,' ',L1,IP1) 69 : IF (IERR.NE.0) RETURN 70 : * 71 : MONAMO = ' ' 71 : CALL ACCTAB(ITLB,'MOT',I0,X0,'AMORTISSEMENTS',L0,IP0, 72 : & MONAMO,I1,X1,CHARRE,L1,IAMOES) 73 : IF (IERR.NE.0) RETURN 74 : * 75 : MONREC = ' ' 75 : CALL ACCTAB(ITLB,'MOT',I0,X0,'RECHERCHE',L0,IP0, 76 : & MONREC,I1,X1,CMOT,L1,IP1) 77 : IF (IERR.NE.0) RETURN 78 : * 79 : MONRAY = ' ' 79 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAYON',L0,IP0, 80 : & MONRAY,I0,XRAY,CHARRE,L1,IP1) 81 : IF (IERR.NE.0) RETURN 82 : 83 : MONCAL = ' ' 83 : CALL ACCTAB(ITLB,'MOT',I0,X0,'ACTNOR',L0,IP0, 84 : & MONCAL,I1,X1,CMOT2,L1,IP1) 85 : IF (IERR.NE.0) RETURN 86 : 87 : 88 : * 89 : IPALB(I,1) = ITYP 90 : IPALB(I,3) = IDIM 91 : XPALB(I,3) = XGLIS 92 : XPALB(I,4) = XADHE 93 : XPALB(I,5) = XRAIT 94 : XPALB(I,6) = XAMOT 95 : * 96 : IF (MONCAL.EQ.'MOT') THEN 97 : IF (CMOT2(1:4).EQ.'VRAI') THEN 98 : IPALB(I,1)=39 99 : ENDIF 100 : ENDIF 101 : 102 : 103 : IF (MONAMO.EQ.'CHPOINT') THEN 104 : IPALB(I,1) = IPALB(I,1)+1 105 : ID1 = 7 106 : ELSE 107 : ID1 = 6 108 : ENDIF 109 : 110 : 111 : * Normale aux butees ou au cylindre enveloppant le segment 112 : IF (IDIM.EQ.3) THEN 112 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0, 113 : & 'POINT',I1,X1,' ',L1,INOR) 114 : IF (IERR.NE.0) RETURN 115 : IPNO = (IDIM + 1) * (INOR - 1) 116 : PS = 0.D0 117 : DO 80 ID = 1,IDIM 118 : XC = XCOOR(IPNO + ID) 119 : PS = PS + XC * XC 120 : 80 CONTINUE 121 : * end do 122 : IF (PS.LE.0.D0) THEN 122 : CALL ERREUR(162) 123 : RETURN 124 : ENDIF 125 : DO 81 ID=1,IDIM 126 : XPALB(I,ID1+ID) = XCOOR(IPNO + ID) / SQRT(PS) 127 : 81 CONTINUE 128 : ELSE 129 : DO 82 ID=1,IDIM 130 : XPALB(I,ID1+ID) = 0.D0 131 : 82 CONTINUE 132 : ENDIF 133 : IF (MONRAY.EQ.'FLOTTANT') THEN 134 : XPALB(I,2) = XRAY 135 : ELSE 136 : XPALB(I,2) = 0.D0 137 : ENDIF 138 : * La recherche s'effectue par défaut localement 139 : IF (MONREC.EQ.'MOT') THEN 140 : IF (CMOT(1:7).EQ.'GLOBALE') THEN 141 : IPALB(I,23) = 1 142 : ELSE 143 : IPALB(I,23) = 0 144 : ENDIF 145 : ELSE 146 : IPALB(I,23) = 0 147 : ENDIF 148 : * 149 : * Coordonnées du maillage_maitre 150 : MELEME = IMAI 151 : 152 : SEGACT MELEME 153 : 154 : 155 : * Pour savoir si le contour est fermé 156 : NELEMA = NUM(/2) 157 : IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN 158 : NNOEMA = NELEMA 159 : IFERMA = 1 160 : ELSE 161 : NNOEMA = NELEMA +1 162 : IFERMA = 0 163 : ENDIF 164 : IPALB(I,21) = NNOEMA 165 : IPALB(I,24) = IFERMA 166 : ID2 = ID1 + 4*IDIM 167 : IPT = NUM(1,1) 168 : INPT = (IDIM+1)*(IPT-1) 168 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 169 : IPLIB(I,1) = IPLAC 170 : KPLIB(1) = IPT 171 : DO 84 ID=1,IDIM 172 : XPALB(I,ID2+ID) = XCOOR(INPT+ID) 173 : 84 CONTINUE 174 : DO 85 IE=1,(NNOEMA-1) 175 : IPT = NUM(2,IE) 176 : INPT = (IDIM+1)*(IPT-1) 176 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 177 : IPLIB(I,IE+1) = IPLAC 178 : KPLIB(IE+1) = IPT 179 : IDIE = ID2 + IE*IDIM 180 : DO 86 ID=1,IDIM 181 : XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 182 : 86 CONTINUE 183 : 85 CONTINUE 184 : SEGDES MELEME 185 : * 186 : * Maillage_esclave 187 : ID3 = ID2 + NNOEMA*IDIM 188 : IF (MONESC.EQ.'POINT') THEN 189 : * La ligne esclave est un point 190 : NNOEES=1 191 : IFERES=0 192 : ISYMET=-1 193 : * Lecture des coordonnées 194 : IPESC = (IDIM+1)*(IESC-1) 194 : CALL PLACE2(JPLIB,NPLB,IPLAC,IESC) 195 : IPLIB(I,NNOEMA+1) = IPLAC 196 : KPLIB(NNOEMA+1) = IESC 197 : DO 90 ID = 1,IDIM 198 : XPALB(I,ID3+ID) = XCOOR(IPESC+ID) 199 : 90 CONTINUE 200 : * 201 : IPALB(I,22) = NNOEES 202 : IPALB(I,25) = IFERES 203 : IPALB(I,26) = ISYMET 204 : ELSE 205 : IF (MONESC.EQ.'MAILLAGE') THEN 206 : * La ligne esclave est un maillage 207 : MELEME = IESC 208 : SEGACT MELEME 209 : * Pour savoir si le contour est fermé 210 : NELEES = NUM(/2) 211 : IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN 212 : NNOEES = NELEES 213 : IFERES = 1 214 : ELSE 215 : NNOEES = NELEES +1 216 : IFERES = 0 217 : ENDIF 218 : IPALB(I,22) = NNOEES 219 : IPALB(I,25) = IFERES 220 : * Coordonnées du maillage_esclave 221 : IPT = NUM(1,1) 222 : INPT = (IDIM+1)*(IPT-1) 222 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 223 : IPLIB(I,NNOEMA+1) = IPLAC 224 : KPLIB(NNOEMA+1) = IPT 225 : DO 94 ID=1,IDIM 226 : XPALB(I,ID3+ID) = XCOOR(INPT+ID) 227 : 94 CONTINUE 228 : DO 95 IE=1,(NNOEES-1) 229 : IPT = NUM(2,IE) 230 : INPT = (IDIM+1)*(IPT-1) 230 : CALL PLACE2(JPLIB,NPLB,IPLAC,IPT) 231 : IPLIB(I,NNOEMA+IE+1) = IPLAC 232 : KPLIB(NNOEMA+IE+1) = IPT 233 : IDIE = ID3 + IE*IDIM 234 : DO 96 ID=1,IDIM 235 : XPALB(I,IDIE+ID) = XCOOR(INPT+ID) 236 : 96 CONTINUE 237 : 95 CONTINUE 238 : SEGDES MELEME 239 : MONINV=' ' 239 : CALL ACCTAB(ITLB,'MOT',I0,X0,'INVERSION',L0,IP0, 240 : & MONINV,I1,X1,CMOT1,L1,IP1) 241 : * Le traitement symétrique ne s'effectue pas PAR DÉFAUT 242 : 243 : IF (MONINV.EQ.'LOGIQUE') THEN 244 : IF (.NOT.L1) THEN 245 : IPALB(I,26) = -1 246 : ELSE 247 : IPALB(I,26) = 0 248 : ENDIF 249 : ELSE 250 : IPALB(I,26) = -1 251 : ENDIF 252 : 253 : ELSE 254 : * La ligne esclave n'est ni un point ni un maillage 254 : * CALL ERREUR(...) 255 : RETURN 256 : ENDIF 257 : ENDIF 258 : * Lecture des chpoints de raideur et d amortissement 259 : * Raideurs des noeuds esclaves et maitres 260 : ID4=ID1+(2*(NNOEMA+NNOEES)+4)*IDIM 261 : MCHPOI=IRAIES 262 : SEGACT,MCHPOI 263 : NSOUP=IPCHP(/1) 264 : DO 100 IPC=1,NSOUP 265 : MSOUPO=IPCHP(IPC) 266 : SEGACT,MSOUPO 267 : MELEME = IGEOC 268 : SEGACT,MELEME 269 : MPOVAL = IPOVAL 270 : SEGACT,MPOVAL 271 : NNN = NUM(/2) 272 : DO 110 INN=1,NNN 273 : IPT = NUM(1,INN) 273 : CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) 274 : IF (IPLAC.NE.0) THEN 275 : XPALB(I,ID4+IPLAC)=VPOCHA(INN,1) 276 : ENDIF 277 : 110 CONTINUE 278 : SEGDES,MPOVAL,MELEME 279 : SEGDES MSOUPO 280 : 100 CONTINUE 281 : SEGDES,MCHPOI 282 : * Amortissement des noeuds esclaves et maitres 283 : ID5=ID4+NNOEMA+NNOEES 284 : IF (IPALB(I,1).EQ.38 .OR. IPALB(I,1).EQ.40) THEN 285 : MCHPOI=IAMOES 286 : SEGACT,MCHPOI 287 : NSOUP = IPCHP(/1) 288 : DO 120 IPC=1,NSOUP 289 : MSOUPO=IPCHP(IPC) 290 : SEGACT,MSOUPO 291 : MELEME = IGEOC 292 : SEGACT,MELEME 293 : MPOVAL = IPOVAL 294 : SEGACT,MPOVAL 295 : NNN=NUM(/2) 296 : DO 130 INN=1,NNN 297 : IPT = NUM(1,INN) 297 : CALL PLACE2(KPLIB,NPLB,IPLAC,IPT) 298 : IF (IPLAC.NE.0) THEN 299 : XPALB(I,ID5+IPLAC)=VPOCHA(INN,1) 300 : ENDIF 301 : 130 CONTINUE 302 : SEGDES MPOVAL,MELEME 303 : SEGDES MSOUPO 304 : 120 CONTINUE 305 : SEGDES MCHPOI 306 : ENDIF 307 : SEGSUP MLIGNE 308 : * end do 309 : * 310 : * 311 : * --- choc élémentaire ..._PLAN... 312 : * 313 : * ELSE IF (ITYP.EQ. ) THEN 314 : * ... 315 : * ... 316 : * 317 : 318 : 319 : 320 : END 321 : 322 : 323 : 324 : 325 : 326 : 327 : 328 : 329 : 330 : 331 : 332 : 333 : 334 :
© Cast3M 2003 - All rights reserved.
Disclaimer