Sources Esope | Cast3M

dyn204
C DYN204    SOURCE    BP208322  19/02/25    21:15:54     10120          
      SUBROUTINE DYN204(I,ITLB,ITYP,KTLIAB,NPLB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Remplissage des tableaux de description des liaisons sur       *
*     la base des informations contenues dans la table ILIB          *
*     Liaison PROFIL_PROFIL_INTERIEUR                                *
*     Liaison PROFIL_PROFIL_EXTERIEUR                                *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   I       Num{ro de la liaison.                                  *
* e   ITLB    Table rassemblant la description d'une liaison.        *
* e   ITYP    Type de la liaison.                                    *
*  s  KTLIAB  Segment descriptif des liaisons sur base B.            *
* e   NPLB    Nombre total de points.                                *
*                                                                    *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 1 f{vrier 1991.                               *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
*
      SEGMENT MTLIAB
         INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
         REAL*8 XPALB(NLIAB,NXPALB)
         REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
      ENDSEGMENT
*
      LOGICAL L1,L0
      CHARACTER*8 CHARRE
*
      MTLIAB = KTLIAB
      NLIAB  = XPALB(/1)
*
* --- choc {l{mentaire PROFIL_PROFIL_INTERIEUR
* --- choc {l{mentaire PROFIL_PROFIL_EXTERIEUR
*
      IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
         CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0,
     &                    'MAILLAGE',I1,X1,CHARRE,L1,IMA1)
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0,
     &                    'MAILLAGE',I1,X1,CHARRE,L1,IMA2)
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
     &                    'POINT',I1,X1,CHARRE,L1,INOR)
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
     &                    'FLOTTANT',I0,XRAID,CHARRE,L1,IP1)
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLB,'MOT',I1,X0,'SUPPORT',L0,IP0,
     &                    'POINT',I0,X1,CHARRE,L1,ISUP)
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLB,'MOT',I1,X0,'EXPOSANT_RAIDEUR',L0,IP0,
     &                    'FLOTTANT',I0,XPUIS,CHARRE,L1,IP1)
         IF (IERR.NE.0) RETURN
*
         IPALB(I,1) = ITYP
         IPALB(I,3) = IDIM
         XPALB(I,1) = XRAID
         XPALB(I,3) = XPUIS
         ID1 = 3
         IP1 = 5
*
*        le maillage IMA1 est en {l{ment de type POI1
         MELEME = IMA1
         SEGACT MELEME
         NOMBN1 = NUM(/2)
         IPALB(I,4) = NOMBN1
         IDP = ID1 + 5*IDIM
         DO 12  IE = 1,NOMBN1
            IPT = NUM(1,IE)
            INPT = ( IDIM + 1 ) * ( IPT - 1 )
            DO 14 ID = 1,IDIM
               XPALB(I,IDP+ID) = XCOOR(INPT + ID)
 14            CONTINUE
*           end do
            IDP = IDP + IDIM
 12         CONTINUE
*        end do
         SEGDES MELEME
*
*        le maillage IMA2 est en {l{ment de type POI1
         MELEME = IMA2
         SEGACT MELEME
         NOMBN2 = NUM(/2)
         IPALB(I,5) = NOMBN2
         DO 16  IE = 1,NOMBN2
            IPT = NUM(1,IE)
            INPT = ( IDIM + 1 ) * ( IPT - 1 )
            DO 18 ID = 1,IDIM
               XPALB(I,IDP+ID) = XCOOR(INPT + ID)
 18            CONTINUE
*           end do
            IDP = IDP + IDIM
 16         CONTINUE
*        end do
         SEGDES MELEME
         CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
         IPLIB(I,1) = IPLAC
*
*        cr{ation d'un rep}re orthonorm{ dans le plan des maillages
*        le point origine est le premier point de IMA1
         CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
         IF (IERR.NE.0) RETURN
*
*        coefficient des droites form{es par les {l{ments de IMA1
         CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
*
*        position initiale de IMA2 par rapport @ IMA1
         CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
*
*        calcul de la section du profil mobile
         CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
         XPALB(I,2) = XSECT
*
* --- choc {l{mentaire PROFIL_...
*
*     ELSE IF (ITYP.EQ.  ) THEN
*        ...
*        ...
      ENDIF
*
      END