1 : C ELPGEO SOURCE CHAT 05/01/12 23:37:32 5004 2 : SUBROUTINE ELPGEO(SBORD,SCOIN,SPOST,IPT1,IPT2,IPF0,PF0,IPP0,IPT3) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-B,D-H,O-Z) 5 : IMPLICIT COMPLEX*16(C) 6 : ************************************************************************ 7 : * 8 : * PLAQUES PAR EQUATION INTEGRALE: 9 : * 10 : * TRADUCTION DES CARACTERISTIQUES DU MAILLAGE EN GRANDEURS 11 : * UTILES DANS L'ALGORITHME 12 : * 13 : * CONTENU DES TABLEAUX: 14 : *** 15 : ** SBORD 16 : * 17 : * XBORD(1,I) NX N NORMALE EXTERNE AU SEGMENT DE BORD 18 : * XBORD(2,I) NY 19 : * 20 : * XBORD(3,I) TX T TANGENTE ORIENTEE AU SEGMENT DE BORD 21 : * XBORD(4,I) TY 22 : * 23 : * XBORD(5,I) AX A PREMIER POINT DU SEGMENT DE BORD 24 : * XBORD(6,I) AY 25 : * 26 : * XBORD(7,I) BX B DEUXIEME POINT DU SEGMENT DE BORD 27 : * XBORD(8,I) BY 28 : * 29 : * XBORD(9,I) PX P POINT MILIEU DU SEGMENT DE BORD 30 : * XBORD(10,I) PY 31 : * 32 : * XBORD(11,I) LAB LONGUEUR DU SEGMENT DE BORD 33 : * XBORD(12,I) CENTRE DU CERCLE 34 : * XBORD(13,I) 35 : * XBORD(14,I) TETA ANGLE AOP 36 : * XBORD(15,I) R RAYON DE COURBURE 37 : * 38 : * IBORD(K,I) NUMERO GIBI DU KEME POINT DU SEGMENT I 39 : * 40 : *** 41 : ** SCOIN 42 : * 43 : * XCOIN(1,I) AX A COIN 44 : * XCOIN(2,I) AY 45 : * 46 : * XCOIN(3,I) N1X N1 NORMALE AVANT LE COIN 47 : * XCOIN(4,I) N1Y 48 : * 49 : * XCOIN(5,I) T1X T1 TANGENTE AVANT LE COIN 50 : * XCOIN(6,I) T1Y 51 : * 52 : * XCOIN(7,I) N2X N2 NORMALE APRES LE COIN 53 : * XCOIN(8,I) N2Y 54 : * 55 : * XCOIN(9 ,I) T2X T2 TANGENTE APRES LE COIN 56 : * XCOIN(10,I) T2Y 57 : * 58 : * XCOIN(11,I) L1 LONGUEUR DES SEGMENTS AUTOUR DU COIN 59 : * XCOIN(12,I) L2 ( 2 AVANT ET 2 APRES) 60 : * XCOIN(13,I) L3 61 : * XCOIN(14,I) L4 62 : * 63 : * 64 : * ICOIN(K,I) NUMERO DES SEGMENTS AUTOUR DU COIN 65 : * ( 2 AVANT ET 2 APRES) 66 : * 67 : * 68 : ** SPOST 69 : * 70 : * PP0(1,I) X POSITION DES POINTS DE POSTTRAITEMENT 71 : * PP0(2,I) Y POSITION DES POINTS DE POSTTRAITEMENT 72 : * 73 : * 74 : ************************************************************************ 75 : -INC CCOPTIO 76 : -INC SMELEME 77 : -INC SMCOORD 78 : * 79 : SEGMENT SBORD 80 : real*8 XBORD(15,NS) 81 : integer IBORD (2 ,NS) 82 : ENDSEGMENT 83 : SEGMENT SPOST 84 : real*8 PP0(2,NP0) 85 : complex*16 CRP (NP0) 86 : complex*16 CPOST(NS4) 87 : ENDSEGMENT 88 : SEGMENT SCOIN 89 : real*8 XCOIN(14,NC) 90 : integer ICOIN(4 ,NC) 91 : ENDSEGMENT 92 : * 93 : DIMENSION PF0(2) 94 : 95 : * 96 : *--0.A LIEU DE FORCE PONCTUELLE 97 : * 98 : PF0(1) = XCOOR (( IPF0 - 1) * (IDIM + 1) + 1) 99 : PF0(2) = XCOOR (( IPF0 - 1) * (IDIM + 1) + 2) 100 : 101 : * 102 : *--0.B LIEU DE POSTRAITEMENT 103 : * 104 : NP0 = PP0(/2) 105 : IF (NP0 .EQ.1) THEN 106 : PP0(1,1) = XCOOR (( IPP0 - 1) * (IDIM + 1) + 1) 107 : PP0(2,1) = XCOOR (( IPP0 - 1) * (IDIM + 1) + 2) 108 : 109 : ELSE 110 : DO 70 IP = 1,NP0 111 : IPP1 = IPT3.NUM(1,IP) 112 : PP0(1,IP) = XCOOR (( IPP1 - 1) * (IDIM + 1) + 1) 113 : PP0(2,IP) = XCOOR (( IPP1 - 1) * (IDIM + 1) + 2) 114 : 70 CONTINUE 115 : ENDIF 116 : * 117 : *--1. BOUCLE SUR LES ELEMENTS DE BORD 118 : * 119 : NS = IBORD (/2) 120 : DO 100 I=1,NS 121 : IP1=IPT1.NUM(1,I) 122 : IP2=IPT1.NUM(2,I) 123 : IP3=IPT1.NUM(3,I) 124 : IBORD(1,I) = IP1 125 : IBORD(2,I) = IP3 126 : XA = XCOOR (( IP1 - 1) * (IDIM + 1) + 1) 127 : YA = XCOOR (( IP1 - 1) * (IDIM + 1) + 2) 128 : XP = XCOOR (( IP2 - 1) * (IDIM + 1) + 1) 129 : YP = XCOOR (( IP2 - 1) * (IDIM + 1) + 2) 130 : XB = XCOOR (( IP3 - 1) * (IDIM + 1) + 1) 131 : YB = XCOOR (( IP3 - 1) * (IDIM + 1) + 2) 132 : XX =( ( XB - XA ) ** 2 + (YB - YA ) ** 2 ) ** .5 133 : XBORD(1,I) = (YB - YA )/XX 134 : XBORD(2,I) = (XA - XB )/XX 135 : 136 : XBORD(3,I) = (XB - XA )/XX 137 : XBORD(4,I) = (YB - YA )/XX 138 : 139 : XBORD(5,I) = XA 140 : XBORD(6,I) = YA 141 : 142 : XBORD(7,I) = XB 143 : XBORD(8,I) = YB 144 : 145 : XBORD(9 ,I) = XP 146 : XBORD(10,I) = YP 147 : 148 : * ---------- CERCLE DE COURBURE 149 : XM1 = (XA + XP ) / 2 150 : YM1 = (YA + YP ) / 2 151 : XM2 = (XB + XP ) / 2 152 : YM2 = (YB + YP ) / 2 153 : 154 : XAB = XB - XA 155 : YAB = YB - YA 156 : XAP = XP - XA 157 : YAP = YP - YA 158 : XBP = XP - XB 159 : YBP = YP - YB 160 : 161 : S1 = XM1 * XAP + YM1 * YAP 162 : S2 = XM2 * XBP + YM2 * YBP 163 : 164 : XDENO = XAP * YBP - XBP * YAP 165 : * ----------- SI L'ELEMENT EST TROP DROIT ON LE REND A PEINE COURBE 166 : IF ( ABS ( XDENO /(XX*XX) ) .LT. 1E-6) THEN 167 : X0 = XP - 1E3*YAB 168 : Y0 = YP + 1E3*XAB 169 : R = 1E3* XX 170 : ELSE 171 : X0 = ( S1 * YBP - S2* YAP ) / XDENO 172 : Y0 = ( S1 * XBP - S2* XAP ) / XDENO 173 : R = (( XA - X0) ** 2 + ( YA - Y0) ** 2 ) ** .5 174 : ENDIF 175 : TETA = ASIN ( XX / (2 * R )) 176 : 177 : XBORD(11,I) = 2*TETA*R 178 : XBORD(12,I) = X0 179 : XBORD(13,I) = Y0 180 : XBORD(14,I) = TETA 181 : XBORD(15,I) = R 182 : 183 : 100 CONTINUE 184 : 185 : 186 : *--2. BOUCLE SUR LES COINS 187 : * 188 : if ( ipt2 .ne. 0 ) then 189 : NC = ICOIN(/2) 190 : DO 200 I=1,NC 191 : IPC1=IPT2.NUM(1,I) 192 : DO 210 J=1,NS 193 : IPS1 = IBORD (1,J) 194 : IPS2 = IBORD (2,J) 195 : IF ( IPS2.EQ.IPC1) THEN 196 : IF ( J .EQ. 1 ) THEN 197 : ICOIN(1,I) = NS 198 : ELSE 199 : ICOIN(1,I) = J - 1 200 : ENDIF 201 : ICOIN(2,I) = J 202 : ENDIF 203 : IF ( IPS1.EQ.IPC1) THEN 204 : ICOIN(3,I) = J 205 : IF ( J .EQ. NS) THEN 206 : ICOIN(4,I) = 1 207 : ELSE 208 : ICOIN(4,I) = J + 1 209 : ENDIF 210 : ENDIF 211 : 210 CONTINUE 212 : 213 : XA = XCOOR (( IPC1 - 1) * (IDIM + 1) + 1) 214 : YA = XCOOR (( IPC1 - 1) * (IDIM + 1) + 2) 215 : 216 : XCOIN(1,I) = XA 217 : XCOIN(2,I) = YA 218 : * AVANT 219 : XCOIN(3,I) = XBORD (1 , ICOIN(2,I)) 220 : XCOIN(4,I) = XBORD (2 , ICOIN(2,I)) 221 : XCOIN(5,I) = XBORD (3 , ICOIN(2,I)) 222 : XCOIN(6,I) = XBORD (4 , ICOIN(2,I)) 223 : * APRES 224 : XCOIN(7,I) = XBORD (1 , ICOIN(3,I)) 225 : XCOIN(8,I) = XBORD (2 , ICOIN(3,I)) 226 : XCOIN(9,I) = XBORD (3 , ICOIN(3,I)) 227 : XCOIN(10,I)= XBORD (4 , ICOIN(3,I)) 228 : * LONGUEURS 229 : XCOIN(11,I) = XBORD (11, ICOIN(1,I)) 230 : XCOIN(12,I) = XBORD (11, ICOIN(2,I)) 231 : XCOIN(13,I) = XBORD (11, ICOIN(3,I)) 232 : XCOIN(14,I) = XBORD (11, ICOIN(4,I)) 233 : 234 : 235 : 200 CONTINUE 236 : endif 237 : * 238 : RETURN 239 : END 240 :
© Cast3M 2003 - All rights reserved.
Disclaimer