C ELPGEO SOURCE CHAT 05/01/12 23:37:32 5004 SUBROUTINE ELPGEO(SBORD,SCOIN,SPOST,IPT1,IPT2,IPF0,PF0,IPP0,IPT3) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-B,D-H,O-Z) IMPLICIT COMPLEX*16(C) ************************************************************************ * * PLAQUES PAR EQUATION INTEGRALE: * * TRADUCTION DES CARACTERISTIQUES DU MAILLAGE EN GRANDEURS * UTILES DANS L'ALGORITHME * * CONTENU DES TABLEAUX: *** ** SBORD * * XBORD(1,I) NX N NORMALE EXTERNE AU SEGMENT DE BORD * XBORD(2,I) NY * * XBORD(3,I) TX T TANGENTE ORIENTEE AU SEGMENT DE BORD * XBORD(4,I) TY * * XBORD(5,I) AX A PREMIER POINT DU SEGMENT DE BORD * XBORD(6,I) AY * * XBORD(7,I) BX B DEUXIEME POINT DU SEGMENT DE BORD * XBORD(8,I) BY * * XBORD(9,I) PX P POINT MILIEU DU SEGMENT DE BORD * XBORD(10,I) PY * * XBORD(11,I) LAB LONGUEUR DU SEGMENT DE BORD * XBORD(12,I) CENTRE DU CERCLE * XBORD(13,I) * XBORD(14,I) TETA ANGLE AOP * XBORD(15,I) R RAYON DE COURBURE * * IBORD(K,I) NUMERO GIBI DU KEME POINT DU SEGMENT I * *** ** SCOIN * * XCOIN(1,I) AX A COIN * XCOIN(2,I) AY * * XCOIN(3,I) N1X N1 NORMALE AVANT LE COIN * XCOIN(4,I) N1Y * * XCOIN(5,I) T1X T1 TANGENTE AVANT LE COIN * XCOIN(6,I) T1Y * * XCOIN(7,I) N2X N2 NORMALE APRES LE COIN * XCOIN(8,I) N2Y * * XCOIN(9 ,I) T2X T2 TANGENTE APRES LE COIN * XCOIN(10,I) T2Y * * XCOIN(11,I) L1 LONGUEUR DES SEGMENTS AUTOUR DU COIN * XCOIN(12,I) L2 ( 2 AVANT ET 2 APRES) * XCOIN(13,I) L3 * XCOIN(14,I) L4 * * * ICOIN(K,I) NUMERO DES SEGMENTS AUTOUR DU COIN * ( 2 AVANT ET 2 APRES) * * ** SPOST * * PP0(1,I) X POSITION DES POINTS DE POSTTRAITEMENT * PP0(2,I) Y POSITION DES POINTS DE POSTTRAITEMENT * * ************************************************************************ -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMCOORD * SEGMENT SBORD real*8 XBORD(15,NS) integer IBORD (2 ,NS) ENDSEGMENT SEGMENT SPOST real*8 PP0(2,NP0) complex*16 CRP (NP0) complex*16 CPOST(NS4) ENDSEGMENT SEGMENT SCOIN real*8 XCOIN(14,NC) integer ICOIN(4 ,NC) ENDSEGMENT * DIMENSION PF0(2) * *--0.A LIEU DE FORCE PONCTUELLE * PF0(1) = XCOOR (( IPF0 - 1) * (IDIM + 1) + 1) PF0(2) = XCOOR (( IPF0 - 1) * (IDIM + 1) + 2) * *--0.B LIEU DE POSTRAITEMENT * NP0 = PP0(/2) IF (NP0 .EQ.1) THEN PP0(1,1) = XCOOR (( IPP0 - 1) * (IDIM + 1) + 1) PP0(2,1) = XCOOR (( IPP0 - 1) * (IDIM + 1) + 2) ELSE DO 70 IP = 1,NP0 IPP1 = IPT3.NUM(1,IP) PP0(1,IP) = XCOOR (( IPP1 - 1) * (IDIM + 1) + 1) PP0(2,IP) = XCOOR (( IPP1 - 1) * (IDIM + 1) + 2) 70 CONTINUE ENDIF * *--1. BOUCLE SUR LES ELEMENTS DE BORD * NS = IBORD (/2) DO 100 I=1,NS IP1=IPT1.NUM(1,I) IP2=IPT1.NUM(2,I) IP3=IPT1.NUM(3,I) IBORD(1,I) = IP1 IBORD(2,I) = IP3 XA = XCOOR (( IP1 - 1) * (IDIM + 1) + 1) YA = XCOOR (( IP1 - 1) * (IDIM + 1) + 2) XP = XCOOR (( IP2 - 1) * (IDIM + 1) + 1) YP = XCOOR (( IP2 - 1) * (IDIM + 1) + 2) XB = XCOOR (( IP3 - 1) * (IDIM + 1) + 1) YB = XCOOR (( IP3 - 1) * (IDIM + 1) + 2) XX =( ( XB - XA ) ** 2 + (YB - YA ) ** 2 ) ** .5 XBORD(1,I) = (YB - YA )/XX XBORD(2,I) = (XA - XB )/XX XBORD(3,I) = (XB - XA )/XX XBORD(4,I) = (YB - YA )/XX XBORD(5,I) = XA XBORD(6,I) = YA XBORD(7,I) = XB XBORD(8,I) = YB XBORD(9 ,I) = XP XBORD(10,I) = YP * ---------- CERCLE DE COURBURE XM1 = (XA + XP ) / 2 YM1 = (YA + YP ) / 2 XM2 = (XB + XP ) / 2 YM2 = (YB + YP ) / 2 XAB = XB - XA YAB = YB - YA XAP = XP - XA YAP = YP - YA XBP = XP - XB YBP = YP - YB S1 = XM1 * XAP + YM1 * YAP S2 = XM2 * XBP + YM2 * YBP XDENO = XAP * YBP - XBP * YAP * ----------- SI L'ELEMENT EST TROP DROIT ON LE REND A PEINE COURBE IF ( ABS ( XDENO /(XX*XX) ) .LT. 1E-6) THEN X0 = XP - 1E3*YAB Y0 = YP + 1E3*XAB R = 1E3* XX ELSE X0 = ( S1 * YBP - S2* YAP ) / XDENO Y0 = ( S1 * XBP - S2* XAP ) / XDENO R = (( XA - X0) ** 2 + ( YA - Y0) ** 2 ) ** .5 ENDIF TETA = ASIN ( XX / (2 * R )) XBORD(11,I) = 2*TETA*R XBORD(12,I) = X0 XBORD(13,I) = Y0 XBORD(14,I) = TETA XBORD(15,I) = R 100 CONTINUE *--2. BOUCLE SUR LES COINS * if ( ipt2 .ne. 0 ) then NC = ICOIN(/2) DO 200 I=1,NC IPC1=IPT2.NUM(1,I) DO 210 J=1,NS IPS1 = IBORD (1,J) IPS2 = IBORD (2,J) IF ( IPS2.EQ.IPC1) THEN IF ( J .EQ. 1 ) THEN ICOIN(1,I) = NS ELSE ICOIN(1,I) = J - 1 ENDIF ICOIN(2,I) = J ENDIF IF ( IPS1.EQ.IPC1) THEN ICOIN(3,I) = J IF ( J .EQ. NS) THEN ICOIN(4,I) = 1 ELSE ICOIN(4,I) = J + 1 ENDIF ENDIF 210 CONTINUE XA = XCOOR (( IPC1 - 1) * (IDIM + 1) + 1) YA = XCOOR (( IPC1 - 1) * (IDIM + 1) + 2) XCOIN(1,I) = XA XCOIN(2,I) = YA * AVANT XCOIN(3,I) = XBORD (1 , ICOIN(2,I)) XCOIN(4,I) = XBORD (2 , ICOIN(2,I)) XCOIN(5,I) = XBORD (3 , ICOIN(2,I)) XCOIN(6,I) = XBORD (4 , ICOIN(2,I)) * APRES XCOIN(7,I) = XBORD (1 , ICOIN(3,I)) XCOIN(8,I) = XBORD (2 , ICOIN(3,I)) XCOIN(9,I) = XBORD (3 , ICOIN(3,I)) XCOIN(10,I)= XBORD (4 , ICOIN(3,I)) * LONGUEURS XCOIN(11,I) = XBORD (11, ICOIN(1,I)) XCOIN(12,I) = XBORD (11, ICOIN(2,I)) XCOIN(13,I) = XBORD (11, ICOIN(3,I)) XCOIN(14,I) = XBORD (11, ICOIN(4,I)) 200 CONTINUE endif * RETURN END