Sources Esope | Cast3M

ellp11
C ELLP11    SOURCE    KK2000    14/04/09    21:15:19     8027
        SUBROUTINE ELLP11(COOR, CORRES, GAMA, CARACT, XCL, FLAG,
     *  NUMERO, ZA1,ZSM, ZXX, ZSOL, ITERA, MASS, RMAS, NMAS,
     *  SA, SB, SU, SR, SQ, SDELTA, SDELT1, SP, SP1, SCH, SCH1,
     *  IPIVO, JPIVO, IAUX, XFRQ, NNPOI, ICHAR, NP, NP24, NP48, NNT,
     *  NNT12, NFRQ, S0, XPI, METH, IMP)
C
      IMPLICIT INTEGER(I-N)
        IMPLICIT REAL*8     (A-H,O-Y)
        IMPLICIT COMPLEX*16 (Z)
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C   OPERATEUR  ELFE LAPLACE POUTRE
C
C   PROGRAMME PRINCIPAL DE FORTRAN EN SORTIE DE L'INTERFACE ESOPE
C
C   L'ALGORITHME EST LE SUIVANT :
C
C
C        - ACQUISITION DES DONNEES PAR ARGUMENTS DE ELLP11
C
C        - REMPLISSAGE DE LA 2EME PARTIE DE ZA1 (INDEPENDANT DE W)
C          + 2EME PARTIE DU SECOND MEMBRE (CALL ELLP12)
C
C        - BOUCLE SUR W
C        |
C        |  S = S0 + I W
C        |
C        |  - BOUCLE SUR CHAQUE POUTRE
C        |  |
C        |  |  - CALCUL DE CHAQUE MATRICE CI (CALL ELLP21)
C        |  |
C        |  |  - ASSEMBLAGE DES MATRICES
C        |  |
C        |  |  - CALCUL DU SECOND MEMBRE
C        |  |
C        |  -  RESOLUTION (CALL ELLP51)
C        |
C        -  RETURN
C
C
C   PARAMETRES :
C
C   COOR   : TABLEAU DES COORDONNEES DES 2*NP NOEUDS FICTIFS
C   CORRES : TABLEAU D'ENTIER DES NUMEROS DES NOEUDS REELS
C            POUR CHAQUE NOEUD FICTIF
C   GAMA   : TABLEAU DES VECTEUR DONNANT LE PLAN OXY POUR CHAQUE POUTRE
C   CARACT : TABLEAU DES CARACTERISTIQUE DES POUTRES (11 ,NP)
C   XCL    : TABLEAU DES VALEURS DES CONDITIONS AUX LIMITES
C   FLAG   : TABLEAU DE POINTEURS SUR XCL
C   NUMERO : TABLEAU DE NUMEROTATION GLOBALE &lt;--> LOCALE
C   XFRQ   : TABLEAU DES POINTS DE CALCUL EN FREQUENCE
C
C   NFRQ   : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
C   NP     : NOMBRE DE POUTRES
C   NNT    : NOMBRE DE NOEUDS REELS
C
C   SORTIES :
C
C   ZA1    : TABLEAU COMPLEXE REPRESENTANT LA MATRICE DE "RIGIDITE"
C   ZSM    : VECTEUR COMPLEXE SECOND MEMBRE
C   ZXX    : VECTEUR COMPLEXE SOLUTION
C
C
C   AUTEUR : SAINT-DIZIER
C   DATE   : 22 DECEMBRE 1989 (VERSION DU 03 AVRIL 1990)
C
C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
        COMPLEX*16 ZA1(NP24,*),ZSM(*),ZXX(*),ZC1(12,24)
        COMPLEX*16 ZSOL(NNT12,*)
        REAL*8     COOR(3,*),GAMA(3,*),CARACT(12,*),XCL(12,*),XFRQ(*)
        REAL*8     SA(NP48,*),SB(*),SU(*),SR(*),SQ(*)
        REAL*8     SDELTA(*),SDELT1(*),SP(*),SP1(*)
        REAL*8     SCH(*),SCH1(*)
        INTEGER    FLAG(*),CORRES(*),NUMERO(*),ITERA(*)
        INTEGER    MASS(NNT,4)
        REAL*8     RMAS(NNT,4)
        INTEGER    IPIVO(*),JPIVO(*),IAUX(*)
C
C **********************************************************************
C                        INITIALISATION
C **********************************************************************
C
        ZI = (0.D0 , 1.D0)
C
C ---------------------------------  COEFFICIENT DE NORMALISATION
C                                    (CF ELLP52)
C **********************************************************************
C                       BOUCLE SUR LES FREQUENCES
C **********************************************************************
C
        DO 30 IFRQ = 1 , NFRQ
C
C **********************************************************************
C              REMISE A ZERO DES MATRICE POUR CHAQUE FREQUENCE
C **********************************************************************
C
C
        DO 58 I = 1 , 24*NP
            DO 59 J = 1 , 24*NP
                ZA1(I,J) = (0.D0,0.D0)
59          CONTINUE
            ZSM(I)   = (0.D0,0.D0)
58      CONTINUE
C
C
C **********************************************************************
C         REMPLISSAGE DE LA 2EME PARTIE DE ZA1 (INDEPENDANT DE W)
C         + 2EME PARTIE DU SECOND MEMBRE
C **********************************************************************
C
      CALL ELLP12(CORRES,XCL,FLAG,NUMERO,MASS,NMAS,NP,NP24,NNT,ZA1,ZSM)
C
C
            ZS = S0 + ZI * CMPLX(2.D0) * XPI * XFRQ(IFRQ)
C
C **********************************************************************
C                       BOUCLE SUR LES POUTRES
C **********************************************************************
C
            DO 40 INP = 1 , NP
C
C ------------------------------ CALCUL DE ZC1 MATRICE ELEMENTAIRE
C
                CALL ELLP21 (CARACT,INP,ZS,COOR,GAMA,CORRES,ZC1)
C
C ------------------------------------- ASSEMBLAGE DE ZC1 DANS ZA1
C
                DO 41 J = 1 , 24
                    DO 42 I = 1 , 12
                        ZA1(12*(INP-1)+I,24*(INP-1)+J) = ZC1(I,J)
42                  CONTINUE
41              CONTINUE
C
40          CONTINUE
C
C
C
C -------------------------- PRISE EN COMPTE DES MASSES PONCTUELLES
C
            CALL ELLP22 (CORRES,FLAG,COOR,GAMA,ZA1,MASS,RMAS,
     *                   ZS,NP,NP24,NMAS,NNT)
C
C **********************************************************************
C                  IMPRESSION DE LA MATRICE ZA1
C **********************************************************************
C
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
            IF ((IMP.NE.0).AND.(IFRQ.EQ.1)) THEN
C
             EPS = 1.D-12
C
              WRITE(IMP,*)'IMPRESSION DE LA MATRICE ZA1 :'
              DO 10 I = 1 , 24*NP
                  DO 11 J = 1 , 24 * NP
                      IF (ABS(ZA1(I,J)).GT.EPS) THEN
                        WRITE(IMP,1001) I,J,ZA1(I,J)
                      END IF
11                CONTINUE
10            CONTINUE
C
C
              WRITE(IMP,*) 'IMPRESSION DU SECOND MEMBRE ZSM :'
              DO 22 I = 1 , 24*NP
                  WRITE(IMP,*) 'ZSM(',I,')',ZSM(I)
22            CONTINUE
C
            END IF
C
C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
C
C ----------------------------------------------------------------------
C                  RESOLUTION DU SYSTEME ZA1 * ZXX = ZSM
C ----------------------------------------------------------------------
C
          IF (IFRQ.EQ.1) THEN
            CALL ELLP51(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
            NP2 = NP24 / 12
C
C ---------------------------------------------------------------
C          CALCUL DES ORDRES DE GRANDEURS DES DEPLACEMENTS ET
C          DES EFFORTS, POUVANT ETRE UTILES POUR UNIFORMISER
C          LA MATRICE DE RESOLUTION POUR LES METHODES ITERATIVES
C ---------------------------------------------------------------
C
            XUR = 0.
            XFM = 0.
            DO 111 IN = 1 , NP2
                DO 112 JN = 1 , 6
                    XX = ABS(ZXX((IN-1)*12+JN))
                    IF (XX.GT.XUR) THEN
                      XUR = XX
                    END IF
112             CONTINUE
                DO 113 JN = 7 , 12
                    XX = ABS(ZXX((IN-1)*12+JN))
                    IF (XX.GT.XFM) THEN
                      XFM = XX
                    END IF
113             CONTINUE
111         CONTINUE
C
C         XUR ET XFM DONNE DES ORDRES DE GRANDEUR SUR LE DEPLACEMENT
C         ET SUR LES EFFORTS ; CE RESULTAT PEUT ETRE UTILE POUR LA
C         METHODE DE RESOLUTION ITERATIVE
C
          ELSE IF (METH.EQ.1) THEN
C
            CALL ELLP51(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
          ELSE IF (METH.EQ.2) THEN
C
            CALL ELLP53(ZA1,ZSM,ZXX,NP24,IPIVO,JPIVO,IAUX)
          ELSE IF (METH.EQ.3) THEN
C
            CALL ELLP54(ZA1,ZSM,ZXX,NP24,NP48,NNPOI,ICHAR,
     *                  XUR,XFM,NIT,SA,SB,SU,SR,SDELTA,SP,SCH,SCH1,EPSY)
          ELSE IF (METH.EQ.4) THEN
C
            CALL ELLP58(ZA1,ZSM,ZXX,NP24,NP48,NNPOI,ICHAR
     *                 ,NIT,SA,SB,SU,SR,SDELTA,SP,SCH,SCH1,EPSY)
          END IF
C
          ITERA(IFRQ) = NIT
C
          DO 51 I = 1 , 2*NP
              KK = CORRES ( I )
C
              DO 52 II = 1 , NNT
                  IF (NUMERO(II).EQ.KK) THEN
                    K = II
                  END IF
52            CONTINUE
C
              DO 53 J = 1 , 12
                  ZSOL((K-1)*12+J,IFRQ) = ZXX((I-1)*12 + J)
53            CONTINUE
C
51        CONTINUE
C
30      CONTINUE
C
1001    FORMAT('ZA1(',I3,',',I3,') =',2F12.3)
C
        END