Sources Esope | Cast3M

devsor
C DEVSOR    SOURCE    BP208322  20/09/18    21:15:44     10718          
      SUBROUTINE DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,
     &             KTPAS,KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN,
     &             KOCLFA,KOCLB1,LMODYN,ITDYN)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Operateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Sortie de la table resultat et nettoyage de la memoire.        *
*                                                                    *
*     Parametres:                                                    *
*                                                                    *
* e   KPREF   Segment des points de référence                        *
* e   KTQ     Segment contenant les variables généralisées
*             (et les travaux)
* e   KTKAM   Segment contenant les matrices XK, XASM et XM          *
* e   KTPHI   Segment contenant les déformées modales                *
* e   KTLIAA  Segment descriptif des liaisons en base A              *
* e   KTLIAB  Segment descriptif des liaisons en base B              *
* e   KTFEX   Segment contenant les chargements libres               *
* e   KTPAS   Segment des variables au cours d'un pas de temps       *
* e   KTRES   Segment de sauvegarde des résultats                    *
* e   KTNUM   Segment contenant les paramètres numériques            *
* e   NINS    On veut une sortie tous les NINS pas de calcul         *
* e   IPMAIL  Maillage de référence                                  *
* e   REPRIS  Vrai si reprise de calcul, faux sinon                  *
* e   ICHAIN  Segment MLENTI (ACTIF) contenant les adresses des      *
*             chaines dans la pile des mots de CCNOYAU               *
*                                                                    *
*     Auteur, date de creation:                                      *
*                                                                    *
*     Denis ROBERT-MOUGIN, le 1er juin 1989.                         *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC SMLREEL
-INC SMLENTI
-INC SMELEME
*
      SEGMENT,MTQ
         REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
         REAL*8 WEXT(NA1,2),WINT(NA1,2)
      ENDSEGMENT
      SEGMENT,MTKAM
         REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
         REAL*8 XOPER(NB1,NB1,NOPER)
      ENDSEGMENT
      SEGMENT,MTPHI
         INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
         INTEGER IAROTA(NSB)
         REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
      ENDSEGMENT
      SEGMENT,MTLIAA
         INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
         REAL*8  XPALA(NLIAA,NXPALA)
      ENDSEGMENT
      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,MTFEX
         REAL*8  FEXA(NPFEXA,NPC1,2)
         REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
         REAL*8  FTEXB(NPLB,NPC1,2,IDIM)
*         INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
      ENDSEGMENT
      SEGMENT,MTPAS
         REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
         REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4)
         REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
         REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
      ENDSEGMENT
      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,MTNUM
         REAL*8 XDT(NPC1),XTEMPS(NPC1)
      ENDSEGMENT
      SEGMENT,MPREF
         INTEGER IPOREF(NPREF)
      ENDSEGMENT
* Segment "local" pour DEVLFA ...
      SEGMENT,LOCLFA
         REAL*8 FTEST(NA1,4),FTOTA0(NA1,4)
      ENDSEGMENT
* Segment "local" pour DEVLB1 ...
      SEGMENT,LOCLB1
         REAL*8 FTEST2(NPLB,6)
      ENDSEGMENT
*
      LOGICAL REPRIS,LMODYN
*
*     Remplissage des CHPOINTs résultats:
*
      CALL DEVSO2(KTRES)
      IF (IERR.NE.0) RETURN
*
*     Création et sous-typage de la table contenant les résultats:
*
      CALL DEVSO4(KPREF,KTRES,KTLIAA,KTLIAB,KTNUM,NINS,ICHAIN,
     &            MTABLE,REPRIS,LMODYN,ITDYN,0)
      IF (IERR.NE.0) RETURN
*
*     Ecriture de la table résultat:
*
      if (.not.lmodyn) CALL ECROBJ('TABLE',MTABLE)
      IF (IERR.NE.0) RETURN
*
*     Nettoyage de la mémoire:
*
      IF (IIMPI.EQ.333) THEN
      WRITE(IOIMP,*)'DEVSOR: nettoyage de la mémoire'
      ENDIF
      MELEME = IPMAIL
      SEGDES,MELEME
*
      MTQ = KTQ
      SEGSUP,MTQ
*
      MTFEX = KTFEX
      SEGSUP,MTFEX
*
      MTPHI = KTPHI
      SEGSUP,MTPHI
*
      MTLIAA = KTLIAA
      SEGSUP,MTLIAA
*
      MTLIAB = KTLIAB
      SEGSUP,MTLIAB
*
      MTRES = KTRES
      SEGSUP,MTRES
*
      MTNUM = KTNUM
      SEGSUP,MTNUM
      MPREF  = KPREF
      SEGSUP,MPREF
*
      MTKAM  = KTKAM
      SEGSUP,MTKAM
*
      MTPAS  = KTPAS
      SEGSUP,MTPAS
*
      LOCLFA = KOCLFA
      SEGSUP,LOCLFA
      LOCLB1 = KOCLB1
      SEGSUP,LOCLB1
*
      MLENTI = ICHAIN
      SEGSUP,MLENTI
      ICHAIN = 0
*
      RETURN
      END