Sources Esope | Cast3M

dyne17
C DYNE17    SOURCE    CB215821  26/08/24    21:16:19     12622          
      SUBROUTINE DYNE17(ITBAS,ITKM,IPMAIL,KTRES,KPREF,NPLAA,NXPALA,
     &KSAM,lmodyn)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Creation des CHPOINTs qui contiendront les resultats.          *
*     Creation des LISTREELs qui contiendront les resultats.         *
*     Creation des POINTS qui contiendront les variables de liaison  *
*     necessaires a une reprise.                                     *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   ITBAS   Table representant une base modale                     *
* e   ITKM    Table contenant les matrices XK et XM                  *
* e   IPMAIL  Maillage de reference                                  *
* es  KTRES   Segment de sauvegarde des resultats                    *
* e   KPREF   Segment des points de reference                        *
* e   NPLAA   Nombre max de pts pour les liaisons en base A          *
* e   NXPALA  Nombre max de var internes pour ces memes liaisons     *
*                                                                    *
*     Remarque importante: tous les CHPOINTs crees vont pointer      *
*     sur le meme MELEME afin de limiter au maximum la memoire       *
*     utilisee.                                                      *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Denis ROBERT-MOUGIN, le 30 juin 1989.                          *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHARG
-INC SMCHPOI
-INC SMELEME
-INC SMRIGID
-INC SMLREEL
-INC SMLENTI
-INC SMCOORD
-INC SMTABLE
*
*     IPORES contient les pointeurs sur les CHPOINTs qui
*     representeront chaque variable pour chaque pas de sortie.
*     IPOREP contient les pointeurs sur les CHPOINTs
*     necessaires a une reprise eventuelle de calcul.
*
      SEGMENT,MTRES
         REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
         REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
         REAL*8 XMREP(NLIAB,4,IDIMB)
         INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
         INTEGER ILIRES(NRESLI,NCRES)
         INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
         INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
         INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
         INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
         INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
         INTEGER ILPOLA(NLIAA,2)
      ENDSEGMENT
      SEGMENT,MPREF
         INTEGER IPOREF(NPREF)
      ENDSEGMENT
* Segment pour Champoints
      SEGMENT,MSAM
         integer jplibb(NPLB)
      ENDSEGMENT
c segment local pour verifier que les matrices sont deja assemblees et
c pas 2 fois la meme inconnue (composante + noeud) dans 2 sous-matrices
      SEGMENT MVU
c          CHARACTER*4 COMPVU(NCVU)
c          INTEGER     IDEJVU(NIVU,NCVU)
         INTEGER     IDEJVU(NIVU)
      ENDSEGMENT
*
      LOGICAL L0,L1,lmodyn
*
      MTRES  = KTRES
      MPREF  = KPREF
      MSAM   = KSAM
      NPREF  = IPOREF(/1)
      NVES   = ICHRES(/1)
      NRES   = XRES(/1)
      NCRES  = XRES(/2)
      NPRES  = XRES(/3)
      NREP   = XREP(/1)
      NLSA   = IPLRLA(/1)
      NLSB   = IPLRLB(/1)
      NLIAB  = XMREP(/1)
      NLIAA  = ILPOLA(/1)
      NPLBB  = JPLIBB(/1)
      NTVAR  = ILIRNB(/2)
 
*
*=========== CAS D'UNE BASE MODALE ===========
*
      IF (ITBAS.NE.0.AND.ITKM.EQ.0) THEN
 
*   --- syntaxe table PASAPAS ---      
        IF(LMODYN) THEN
 
*         maillage
          meleme = ipmail
          segact meleme
          if (lisous(/1).eq.0) then
            ipmmod = ipmail
            ipmsta = 0
          else
            ipmmod = lisous(1)
            ipmsta = lisous(2)
          endif
*
*         production chpoint forces base A (devso2)
          NSOUPO = 1
          if(ipmmod.gt.0.and.ipmsta.gt.0) nsoupo = 2
          NAT=1
          SEGINI,MCHPOI
          IPCHPO = MCHPOI
          MTYPOI = 'FLIAISONS'
          IFOPOI = IFOUR
*         nature  diffuse
          JATTRI(1) = 1
          nmost0 = 0
          KIPCHP = 0
          if (ipmmod.gt.0) then
            NC = 1
            SEGINI,MSOUPO
            KIPCHP = KIPCHP + 1
            IPCHP(KIPCHP)  = MSOUPO
            NOCOMP(1) = 'ALFA'
            NOHARM(1) = NIFOUR
            IGEOC = ipmmod
            ipt1 = ipmmod
            segact ipt1
            N = ipt1.num(/2)
            nmost0 = N
            SEGINI,MPOVAL
            IPOVAL = MPOVAL
          endif
 
          if (ipmsta.gt.0) then
            NC = 1
            SEGINI,MSOUPO
            KIPCHP = KIPCHP + 1
            IPCHP(KIPCHP)  = MSOUPO
            NOCOMP(1) = 'BETA'
            NOHARM(1) = NIFOUR
            IGEOC = ipmsta
            ipt1 = ipmsta
            segact ipt1
            N = ipt1.num(/2)
            SEGINI,MPOVAL
            IPOVAL = MPOVAL
          endif
 
*   --- syntaxe tables DYNE normales ---      
        ELSE
*
*         Cas de la base modale, on n'a qu'une composante: 'ALFA'
          IF (IIMPI.EQ.333) THEN
             WRITE(IOIMP,*)'DYNE17: cas de la base modale'
          ENDIF
          NSOUPO = 1
          NAT=1
          SEGINI,MCHPOI
          IPCHPO = MCHPOI
          MTYPOI = '        '
          IFOPOI = IFOUR
*           nature  diffuse
          JATTRI(1) = 1
          NC = 1
          SEGINI,MSOUPO
          IPCHP(1)  = MSOUPO
          NOCOMP(1) = 'ALFA'
          NOHARM(1) = NIFOUR
          NOCOMP(1) = 'ALFA'
          NOHARM(1) = NIFOUR
          IGEOC = IPMAIL
          N = NPREF
          SEGINI,MPOVAL
          IPOVAL = MPOVAL
 
        ENDIF
 
*
*=========== CAS DE MATRICES MODALES EN ENTREE ===========
*
      ELSE IF (ITKM.NE.0) THEN
*
*        On se refere au descripteur de la rigidite, mais attention:
*        les composantes peuvent differer d'une zone elementaire a
*        une autre.
*
         CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0,
     &               'RIGIDITE',I1,X1,' ',L1,IRIGI)
*
*        Creation du CHPOINT de reference:
*
         IF (IIMPI.EQ.333) THEN
           WRITE(IOIMP,*)
     &     'DYNE17: creation selon un descripteur de rigidite'
         ENDIF
         MRIGID = IRIGI
         SEGACT,MRIGID
         NRIGI = IRIGEL(/2)
         IF (IIMPI.EQ.333) THEN
            WRITE(IOIMP,*)
     &      'DYNE17: nombre de rigidites elementaires ',NRIGI
         ENDIF
         NSOUPO = NRIGI
         NAT=1
         SEGINI,MCHPOI
         IPCHPO = MCHPOI
         MTYPOI = '        '
*        nature  diffuse
         JATTRI(1) = 1
         IFOPOI = IFOUR
c        creation du segment de verif
         NIVU = NPREF
         SEGINI,MVU
         DO 30 I=1,NRIGI
            NYSONT = 0
            DESCR = IRIGEL(3,I)
            IPT1  = IRIGEL(1,I)
            SEGACT,DESCR,IPT1
*           NTOTC  est le nombre total d'inconnues
*           NBNO   est le nombre de noeuds par element
*           NBEL   est le nombre d'elements dans la zone
*           NC     est le nombre de composantes par noeud dans la zone
            NBNO   = IPT1.NUM(/1)
            NBEL   = IPT1.NUM(/2)
            NTOTC  = LISINC(/2)
            NC     = NTOTC / NBNO
      IF (IIMPI.EQ.333) THEN
       WRITE(IOIMP,*)'DYNE17: nombre total d''inconnues    ',NTOTC
       WRITE(IOIMP,*)'DYNE17: nombre de noeuds par element ',NBNO
       WRITE(IOIMP,*)'DYNE17: nombre d''elements dans la zone ',NBEL
       WRITE(IOIMP,*)'DYNE17: nombre de composantes par noeud ',NC
      ENDIF
            SEGINI,MSOUPO
            IPCHP(I) = MSOUPO
            DO 40 IC=1,NC
               IF (LISINC(IC).NE.'ALFA'.and.LISINC(IC).NE.'BETA') THEN
      WRITE(IOIMP,*) 'DYNE: la raideur K de la table RAIDEUR_ET_MASSE',
     &               ' ne peut avoir que ALFA ou BETA pour composante!'
                  CALL ERREUR(483)
                  RETURN
               ENDIF
               NOCOMP(IC) = LISINC(IC)
               NOHARM(IC) = NIFOUR
 40         CONTINUE
*
*           Combien de noeuds references dans cette zone ?
*
c           BP : le chpoint repose necessairement sur des elements POI1
            NBSOUS=0
            NBREF =0
            NBNN  =1
            NBELEM=NBNO*NBEL
            SEGINI,MELEME
            ITYPEL=1
            IGEOC = MELEME
            DO 341 IEL=1,NBEL
            DO 50 INO=1,NBNO
c              ce noeud appartient-il bien a la liste MPREF.IPOREF ?
               CALL PLACE2(IPOREF,NPREF,ILYEST,IPT1.NUM(INO,IEL))
               IF (ILYEST.EQ.0) GOTO 50
c              rem : si ILYEST = 0 , on a un pb --> erreur dans devtra
c              BP : ce noeud a t'il deja ete vu dans une autre zone?
               IF(IDEJVU(ILYEST).EQ.0) THEN
c                tout va bien on ajoute ce noeud pour ces composantes
                 NYSONT = NYSONT + 1
                 NUM(1,NYSONT) = IPT1.NUM(INO,IEL)
                 IDEJVU(ILYEST)=NYSONT
               ELSE
c                noeud deja vu a l element NYSONT : on ne fait rien
c                on suppose qu'1 noeud => 1 inconnue
               ENDIF
  50        CONTINUE
  341       CONTINUE
            IF(NYSONT.lt.NBELEM) THEN
              NBELEM=NYSONT
              SEGADJ,MELEME
            ENDIF
       IF (IIMPI.EQ.333) THEN
       WRITE(IOIMP,*)'DYNE17: nombre de noeuds dans la zone ',NYSONT
       ENDIF
            N = NYSONT
            SEGINI,MPOVAL
            IPOVAL = MPOVAL
            SEGDES,DESCR,IPT1,MELEME,MSOUPO
 30      CONTINUE
         SEGDES,MRIGID
         SEGSUP,MVU
 
      ENDIF
*=========== FIN DES CAS BASE MODALE / MATRICES MODALES ===========
 
*
*     Variables demandees en sortie:
c       II   = 0
      IIPO = 0
c       IILI = 0
c     boucle sur les variables (deplacement, vitesse ... )
      DO 60 ICR=1,8      
*      - Duplication du CHPOINT pour les variables demandees 
*        a tous les pas de sortie
         IF (ICHRES(ICR).EQ.1) THEN
c             II = II + 1
            IIPO=IIPO+1
            DO 70 IPAS=1,NPRES
               CALL COPIE5(IPCHPO,IPCHP1)
               IPORES(IIPO,IPAS) = IPCHP1
 70         CONTINUE 
*      - creation des LISTREEL pour les variables demandees 
*        et tous les modes
         ELSEIF(ICHRES(ICR).EQ.2) THEN
c             II = II + 1
c             IILI=IILI+1
c             if (NCRES.gt.IPORES(/2)) then
c               write(ioimp,*) 'il faut plus de pas que de modes !'
c               call erreur(481)
c               return
c             endif
c             DO 71 IMODE=1,NCRES
c                JG=NPRES
c                segini,MLREEL
c                ILIRES(IILI,IMODE) = MLREEL
c c        rem : on range le MLREEL ici en supposant qu'il y a plus
c c              de pas que de modes
cbp : on ne fait quasi-rien ici, on travaillera dans devso2
 71         CONTINUE            
         ENDIF
 
 60   CONTINUE
*
*     Cas des CHPOINTs necessaires a la reprise du calcul:
*
      DO 80 I = 1,NREP
         CALL COPIE5(IPCHPO,IPCHP1)
         IPOREP(I) = IPCHP1
 80   CONTINUE
*
*     Cas des POINTS necessaires a la reprise du calcul:
*
      IDIM1 = IDIM + 1
      segact mcoord*mod
      NPTS = nbpts
      NBPTS = NPTS + 4 * NLIAB
      SEGADJ MCOORD
      DO 342 I = 1,NLIAB
      DO 90 II = 1,4
            NPTS = NPTS + 1
            IPPREP(I,II) = NPTS
 90   CONTINUE
  342 CONTINUE
*
      MCHPOI = IPCHPO
      SEGSUP,MCHPOI
*
*     Creation des LISTREELs qui contiendront les resultats
*
      JG = NPRES
      SEGINI,MLREEL
      IPOLR(1) = MLREEL
*
*     liaisons en base A
      DO 100 IL = 1,NLSA
         NLR = ICHRES(10 + IL)
         DO 105 IN = 1,NLR
            JG = NPRES
            SEGINI,MLREEL
            IPLRLA(IL,IN) = MLREEL
 105     CONTINUE
 100  CONTINUE
 
*      DO 110 IL = 1,NLSB
*         NLR = ICHRES(10 + NLSA + IL)
*         DO 115 IN = 1,NLR
*            JG = NPRES
*            SEGINI,MLREEL
*            IPLRLB(IL,IN) = MLREEL
* 115        CONTINUE
*        end do
* 110     CONTINUE
*     end do
*
*     Creation des LISTENTIs et des LISTREELs pour sauvegarde
*     des liaisons en base A en vue d'une reprise
*
      DO 200 I = 1,NLIAA
*        liaisons POLYNOMIALEs 
         IF (ILPOLA(I,1).EQ.1) THEN
            JG = NPLAA * 2
            SEGINI,MLENTI
            ILPOLA(I,1) = MLENTI
            JG = NXPALA
            SEGINI,MLREEL
            ILPOLA(I,2) = MLREEL
*        liaisons COUPLAGE_DEPLACEMENT + CONVOLUTION 
         ELSEIF(ILPOLA(I,1).EQ.2) THEN
*        on ne fait rien ici : 
*        on branchera les listreels creees par dyne19 dans devso4 
         ENDIF
 200  CONTINUE
*
*     liaisons en base B
      DO 300 IL=1,NLSB
         II=0
         DO 310 IV = 1,NTVAR
 
*         -Creation de listreels
           IF (ILIREB(IL,IV).EQ.1) THEN
              II=II+1
              JG = NPRES
              SEGINI,MLREEL
              IPLRLB(IL,II) = MLREEL
 
*         -Creation d'une table de chpoints
           ELSEIF (ILIREB(IL,IV).EQ.2) THEN
              M=NPRES
              SEGINI,MTABLE
              MLOTAB=M
              DO 320 IM=1,NPRES
                 MTABTI(IM)='ENTIER'
                 MTABTV(IM)='CHPOINT'
                 MTABII(IM)=IM
 320          CONTINUE
              SEGDES,MTABLE
              IPLRLB(IL,II+1)=MTABLE
*             Creation d un champoint
              NSOUPO=1
              SEGINI,MCHPOI
              IPCHPO = MCHPOI
              MOCHDE = 'Force_de_choc'
*             nature  diffuse
              NC=2
              SEGINI,MSOUPO
              NOCOMP(1)='NORM'
              NOCOMP(2)='TANG'
              IPCHP(1)=MSOUPO
              N=NPLBB
              SEGINI,MPOVAL
              IPOVAL=MPOVAL
              NBELEM=NPLBB
              NBNN=1
              NBREF=0
              NBSOUS=0
              SEGINI,MELEME
              DO 330 IE=1,NPLBB
                 NUM(1,IE)=JPLIBB(IE)
 330          CONTINUE
              IGEOC=MELEME
              JG=NPRES
              SEGINI,MLENTI
              DO 340 I = 1,NPRES
                 CALL COPIE5(IPCHPO,IPCHP1)
                 LECT(I) = IPCHP1
 340          CONTINUE
              SEGDES,MLENTI
              IPLRLB(IL,II+2)=MLENTI
              MCHPOI=IPCHPO
              SEGSUP,MCHPOI
              II=II+NPLBB*2
           ENDIF
 
 310     CONTINUE
 300  CONTINUE
*
      END