Sources Esope | Cast3M

dyne20
C DYNE20    SOURCE    BP208322  19/02/25    21:15:59     10120          
      SUBROUTINE DYNE20(ILIB,KTLIAB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Remplissage des tableaux de description des liaisons sur       *
*     la base a partir des informations contenues dans la            *
*     table ILIB.                                                    *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   ILIB    Table rassemblant la description des liaisons          *
* es  KTLIAB  Segment descriptif des liaisons sur la base B.         *
*                                                                    *
*                                                                    *
*     Parametres de dimensionnement pour une liaison sur base:       *
*                                                                    *
*     NIPALB : nombre de parametres pour definir le type des         *
*              liaisons (NIPALB est fixe a 3).                       *
*     NXPALB : nombre maxi de parametres internes definissant les    *
*              liaisons.                                             *
*     NPLBB  : nombre maxi de points intervenant dans une liaison.   *
*                                                                    *
*     NPLB   : nombre total de points.                               *
*     NLIAB  : nombre total de liaisons.                             *
*                                                                    *
*                                                                    *
*     Tableaux fortran pour les liaisons sur base B :                *
*                                                                    *
*     XPALB(NLIAB,NXPALB) : parametres de la liaison.                *
*     IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison.        *
*                          et les eventuelles conditions             *
*     XABSCI  Tableau contenant les abscisses de la loi plastique    *
*             pour les liaisons point-point- ... -plastique          *
*     XORDON  Tableau contenant les ordonnees de la loi plastique    *
*             pour les liaisons point-point- ... -plastique          *
*                                                                    *
*     JPLIB(NPLB)         : numero global des points.                *
*     IPLIB(NLIAB,NPLBB)  : numeros locaux des points concernes par  *
*                           la liaison.                              *
*                                                                    *
*     Icorres  Pour garder le numero du pointeur des tables de       *
*            liaison                                                 *
*                                                                    *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Lionel VIVAN, le 21 Septembre 1989.                            *
*     E de LANGRE   08/94 laisns conditionnelles                     *
*     I. Pinto 05/97, liaisons ligne_cercle,appels a dyn207          *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
*
      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
*
      SEGMENT icorres( nliab)
*
      LOGICAL L1,L0
      CHARACTER*40 CMOT,MONMOT,CHARRE
      MTLIAB = KTLIAB
      NPLB = JPLIB(/1)
      NLIAB = IPALB(/1)
      segini icorres
*
*     Boucle sur le nombre de liaisons
*
      II = 0
*
      DO 10 I = 1,NLIAB
         CALL ACCTAB(ILIB,'ENTIER',I,X0,'  ',L0,IP0,
     &                    'TABLE',I0,X0,'  ',L1,ITLIAI)
 
         icorres ( i )=itliai
 
         IF (IERR.NE.0) RETURN
         CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
     &                      'MOT',I1,X0,MONMOT,L1,IP1)
         IF (IERR.NE.0) RETURN
*
*        Liaison elementaire
*
         IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN
 
            CMOT='  '
            CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
     &                         'MOT',I1,X0,CMOT,L1,IP1)
            IF (IERR.NE.0) RETURN
*
*           attention a l'ordre : en dernier les + courts !!!
            IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN
               ITYP = 3
               CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN
               ITYP = 5
               CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSEIF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
               ITYP = 7
               CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSEIF (CMOT(1:10).EQ.'POINT_PLAN') THEN
               ITYP = 1
               CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
 
            ELSE IF
     &      (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN
               ITYP = 50
               CALL DYN205(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
 
            ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN
               ITYP = 13
               CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF
     &      (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN
               ITYP = 16
               CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN
               ITYP = 11
               CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
 
            ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN
               ITYP = 23
               CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN
               ITYP = 25
               CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN
               ITYP = 33
               CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN
               ITYP = 21
               CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
 
            ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR') THEN
               ITYP = 31
               CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
            ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN
               ITYP = 32
               CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB)
               IF (IERR.NE.0) RETURN
 
            ELSE IF (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN
                ITYP = 35
                CALL DYN206(I,ITLIAI,ITYP,KTLIAB,NPLB)
 
            ELSE IF(CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN
                ITYP = 37
                CALL DYN207(I,ITLIAI,ITYP,KTLIAB,NPLB)
 
            ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN
                ITYP = 60
                CALL DYN208(I,ITLIAI,ITYP,KTLIAB,NPLB)
                IF (IERR.NE.0) RETURN
 
            ELSE
               CALL ERREUR(490)
               RETURN
            ENDIF
*
*        Liaison ...........
*
*        ELSE IF (MONMOT(1:  ).EQ.'                ') THEN
*           .......
*           .......
*
         ELSE
            CALL ERREUR(489)
            RETURN
         ENDIF
 10      CONTINUE
*
*
*
*
*   ----- liaisons conditionnelles ?
*
*
      DO 11 I = 1,NLIAB
         ksi = 0
         CALL ACCTAB(ILIB,'ENTIER',I,X0,'  ',L0,IP0,
     &                    'TABLE',I0,X0,'  ',L1,ITLIAI)
*        la I^eme liaison est-elle conditionnee par la J^eme
         DO 12 j = 1,NLIAB
           jtliai = icorres ( j )
           monmot = ' '
           CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai,
     &                        MONMOT,I1,X0,CHARRE,L1,IP1)
           IF (IERR.NE.0) RETURN
*          ------- si on trouve un logique en face d'une table
*                     de liaison  , c'est bon
           IF (MONMOT.EQ.'LOGIQUE ') THEN
              ksi = ksi + 1
              if(ipalb(i,4).ge.2) then
                CALL ERREUR(905)
                return
              endif
              ipalb(i,4) = 1
              IF (L1 ) THEN
                ipalb (i,4+ksi) = j
              ELSE IF (.NOT.  L1) THEN
                ipalb (i,4+ksi) = -1 * j
              ENDIF
           ENDIF
 12      CONTINUE
 11   CONTINUE
*    --------- fin des conditions
 
 
***** eventuel message ****
 
      IF (IIMPI.EQ.333) THEN
         NLIAB  = IPALB(/1)
         NIPALB = IPALB(/2)
         NXPALB = XPALB(/2)
         NPLBB  = IPLIB(/2)
         NPLB   = JPLIB(/1)
       DO 1000 IN = 1,NLIAB
          DO 1002 II = 1,NIPALB
          WRITE(IOIMP,*)'DYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II)
 1002     CONTINUE
          DO 1004 IX = 1,NXPALB
          WRITE(IOIMP,*)'DYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX)
 1004     CONTINUE
          DO 1006 IP = 1,NPLBB
          WRITE(IOIMP,*)'DYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP)
 1006     CONTINUE
 1000  CONTINUE
       DO 1008 IP = 1,NPLB
          WRITE(IOIMP,*)'DYNE20 : JPLIB(',IP,') =',JPLIB(IP)
 1008  CONTINUE
      ENDIF
 
*
      RETURN
      END