Sources Esope | Cast3M

elpd99
C ELPD99    SOURCE    KK2000    14/04/09    21:15:23     8027
      SUBROUTINE ELPD99(XBORD,IBORD,NS
     &                 ,XCOIN,ICOIN,NC,NC1
     &                 ,CRE,CPOST,CRP ,NS4
     &                 ,XD,XNU,NTRAP,PF0,XF0,PP0,NP0,CB,ISTAT )
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-B,D-H,O-Z)
      IMPLICIT COMPLEX*16(C)
************************************************************************
*
*    PLAQUES PAR EQUATION INTEGRALE:
*
*    CALCUL DU DEPLACEMENT EN UN POINT
*                          OU UN MAILLAGE PAR POST-TRAITEMENT
*
*
************************************************************************
 
-INC PPARAM
-INC CCOPTIO
*
          DIMENSION XBORD(15,*)
          DIMENSION IBORD (2 ,*)
          DIMENSION XCOIN(14,*)
          DIMENSION ICOIN(4 ,*)
          DIMENSION CRE (*)
          DIMENSION CRP (*)
          DIMENSION CPOST (*)
*
          DIMENSION PP0(2,*)
          DIMENSION PF0(2)
C          DIMENSION P0(2)
          DIMENSION PP1(2)
          DIMENSION A (2)
          DIMENSION B (2)
          DIMENSION OAB (2)
          DIMENSION Q (2)
*
          DIMENSION XN (2)
          DIMENSION XN0(2)
          DIMENSION XN1(2)
          DIMENSION XN2(2)
*
          DIMENSION XT (2)
          DIMENSION XT0(2)
          DIMENSION XT1(2)
          DIMENSION XT2(2)
*
*
          DIMENSION COP0(8)
          DIMENSION CS1 (8)
          DIMENSION CS2 (12)
          DIMENSION XLCOIN  (4)
*
*--    BOUCLE SUR LES POINTS
*
       DO 10 IP = 1,NP0
           PP1(1) = PP0(1,IP)
           PP1(2) = PP0(2,IP)
*--0.  MISE A 0
          CI = (0d0,1d0)
           DO 100 J=1,NS4
             CPOST(J) = CMPLX(0D0)*ci
100        CONTINUE
*
*--- INITIALISATION BIDON
*
            XN0(1) = 1D0
            XN0(2) = 0d0
            XT0(1) = 0d0
            XT0(2) = 1D0
*
*- 1.1       BOUCLE SUR LES  BORDS
*
             DO 200 JQ=1,NS
               XN (1) = XBORD(1,JQ)
               XN (2) = XBORD(2,JQ)
               XT (1) = XBORD(3,JQ)
               XT (2) = XBORD(4,JQ)
               A  (1) = XBORD(5,JQ)
               A  (2) = XBORD(6,JQ)
               B  (1) = XBORD(7,JQ)
               B  (2) = XBORD(8,JQ)
               Q  (1) = XBORD(9,JQ)
               Q  (2) = XBORD(10,JQ)
                XLQ   = XBORD(11,JQ)
               OAB(1) = XBORD(12,JQ)
               OAB(2) = XBORD(13,JQ)
               TETA   = XBORD(14,JQ)
               R      = XBORD(15,JQ)
               CALL ELPDI1(PP1,XN0,XT0
     &                    ,Q,XN,XT,A,B,OAB,TETA,R,XLQ
     &                    ,XD,XNU
     &                    ,NTRAP,CS1,CB,ISTAT)
              JCOL= 4* (JQ - 1)
 
              CPOST(JCOL+1) = CS1(4) / XD
              CPOST(JCOL+2) =-CS1(3) / XD
              CPOST(JCOL+3) = CS1(2) / XD
              CPOST(JCOL+4) =-CS1(1) / XD
200        CONTINUE
*
*- 1.2       TERMES BORDS-COINS
*
       IF ( NC1.NE.0) THEN
             DO 220 JC=1,NC
               A  (1) = XCOIN(1,JC)
               A  (2) = XCOIN(2,JC)
               XN1(1) = XCOIN(3,JC)
               XN1(2) = XCOIN(4,JC)
               XT1(1) = XCOIN(5,JC)
               XT1(2) = XCOIN(6,JC)
               XN2(1) = XCOIN(7,JC)
               XN2(2) = XCOIN(8,JC)
               XT2(1) = XCOIN(9,JC)
               XT2(2) = XCOIN(10,JC)
               XLCOIN(1) = XCOIN(11,JC)
               XLCOIN(2) = XCOIN(12,JC)
               XLCOIN(3) = XCOIN(13,JC)
               XLCOIN(4) = XCOIN(14,JC)
               CALL ELPDI3(PP1,XN0
     &                    ,A,XN1,XN2,XT1,XT2,XLCOIN
     &                    ,XD,XNU
     &                    ,CS2,CB,ISTAT)
 
              I1 = ICOIN(1,JC)
              I2 = ICOIN(2,JC)
              I3 = ICOIN(3,JC)
              I4 = ICOIN(4,JC)
              J1 = 4*(I1 - 1)
              J2 = 4*(I2 - 1)
              J3 = 4*(I3 - 1)
              J4 = 4*(I4 - 1)
 
*
*      TERMES MULTIPLIANT DES W,N SUR LES 2 LIGNES
*
              CPOST(J1+2) = CPOST(J1+2) - CS2(4)/XD
              CPOST(J2+2) = CPOST(J2+2) - CS2(3)/XD
              CPOST(J3+2) = CPOST(J3+2) - CS2(2)/XD
              CPOST(J4+2) = CPOST(J4+2) - CS2(1)/XD
*
*      TERMES MULTIPLIANT DES W   SUR LES 2 LIGNES
*
              CPOST(J2+1) = CPOST(J2+1) - CS2(6)/XD
              CPOST(J3+1) = CPOST(J3+1) - CS2(5)/XD
 
220        CONTINUE
*
*
*
        ENDIF
 
*
*-1.4     SECOND MEMBRE(SI PP0 NEG PF0)
*
         RR= ( PP1(2)-PF0(2)) ** 2
     &     + ( PP1(1)-PF0(1)) ** 2
         IF (   ISTAT.NE.1) THEN
           IF (   RR .GT. 1E-4 ) THEN
           CALL ELPDOP (PP1,XN0,PF0,XN0,XT0,XD,XNU,COP0,CB,ISTAT)
           ELSE
            COP0(1) = CI/( CMPLX(8d0) *CB * CB )
           ENDIF
         ELSE
            COP0(1) = CMPLX(0D0)
         ENDIF
         CSM0 = COP0(1) *XF0 / XD
*
*-1.5     CALCUL DU DEPLACEMENT
*
         CRP(IP) =(0D0,0d0)
         DO 300 J=1,NS4
           CRP(IP) = CRP(IP) - CPOST(J)*CRE(J)
300      CONTINUE
         CRP(IP) = CRP(IP) + CSM0
*
10      CONTINUE
*
       RETURN
      END