Sources Esope | Cast3M

elpgeo
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