Télécharger la plaquette Cast3M


fr en

Télécharger devalg.eso

Retour à la liste

Numérotation des lignes : 

devalg

  1. C DEVALG    SOURCE    BP208322  20/09/18    21:15:22     10718          
  2.       SUBROUTINE DEVALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,
  3.      &                  KTRES,KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,
  4.      &                  RIGIDE)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7. *--------------------------------------------------------------------*
  8. *                                                                    *
  9. *     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
  10. *     ________________________________________________               *
  11. *                                                                    *
  12. *     Mise en oeuvre de l'algorithme.                                *
  13. *                                                                    *
  14. *     Paramètres:                                                    *
  15. *                                                                    *
  16. * es  KTQ     Segment contenant les variables généralisées           *
  17. *             (et les travaux)
  18. * es  KTKAM   Segment contenant les vecteurs XK, XASM et XM          *
  19. * es  KTPHI   Segment contenant les déformées modales                *
  20. * es  KTLIAA  Segment descriptif des liaisons en base A              *
  21. * es  KTLIAB  Segment descriptif des liaisons en base B              *
  22. * es  KTFEX   Segment contenant les chargements libres               *
  23. * es  KTPAS   Segment des variables au cours d'un pas de temps       *
  24. * es  KTRES   Segment de sauvegarde des résultats                    *
  25. * es  KTNUM   Segment contenant les paramètres numériques            *
  26. * es  KPREF   Segment des points de référence                        *
  27. * e   NINS    On veut une sortie tous les NINS pas de calcul         *
  28. * e   REPRIS  Vrai si reprise de calcul, faux sinon                  *
  29. * e   RIGIDE  Vrai si l'on a un corps rigide, faux sinon             *
  30. *                                                                    *
  31. *     Auteur, date de creation:                                      *
  32. *                                                                    *
  33. *     Denis ROBERT-MOUGIN, le 6 juin 1989.                           *
  34. *                                                                    *
  35. *--------------------------------------------------------------------*
  36.       SEGMENT,MTQ
  37.          REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4)
  38.          REAL*8 WEXT(NA1,2),WINT(NA1,2)
  39.       ENDSEGMENT
  40.       SEGMENT,MTKAM
  41.          REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  42.          REAL*8 XOPER(NB1,NB1,NOPER)
  43.       ENDSEGMENT
  44.       SEGMENT,MTPHI
  45.          INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  46.          INTEGER IAROTA(NSB)
  47.          REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  48.       ENDSEGMENT
  49.       SEGMENT,MTLIAA
  50.          INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA)
  51.          REAL*8  XPALA(NLIAA,NXPALA)
  52.       ENDSEGMENT
  53.       SEGMENT,MTLIAB
  54.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  55.          REAL*8  XPALB(NLIAB,NXPALB)
  56.          REAL*8  XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  57.       ENDSEGMENT
  58.       SEGMENT,MTFEX
  59.          REAL*8  FEXA(NPFEXA,NPC1,2)
  60.          REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
  61.          REAL*8  FTEXB(NPLB,NPC1,2,IDIM)
  62. *         INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  63.       ENDSEGMENT
  64.       SEGMENT,MTPAS
  65.          REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  66.          REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4)
  67.          REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  68.          REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  69.       ENDSEGMENT
  70.       SEGMENT,MTRES
  71.          REAL*8  XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES)
  72.          REAL*8  XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB)
  73.          REAL*8  XMREP(NLIAB,4,IDIMB)
  74.          INTEGER ICHRES(NVES),IPORES(NRESPO,NPRES),IPOREP(NREP)
  75.          INTEGER ILIRES(NRESLI,NCRES)
  76.          INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA)
  77.          INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB)
  78.          INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR)
  79.          INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR)
  80.          INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4)
  81.          INTEGER ILPOLA(NLIAA,2)
  82.       ENDSEGMENT
  83.       SEGMENT,MTNUM
  84.          REAL*8 XDT(NPC1),XTEMPS(NPC1)
  85.       ENDSEGMENT
  86.       SEGMENT,MPREF
  87.          INTEGER IPOREF(NPREF)
  88.       ENDSEGMENT
  89. * Segment "local" pour DEVLFA ...
  90.       SEGMENT,LOCLFA
  91.          REAL*8 FTEST(NA1,4)
  92.       ENDSEGMENT
  93. * Segment "local" pour DEVLB1 ...
  94.       SEGMENT,LOCLB1
  95.          REAL*8 FTEST2(NPLB,6)
  96.       ENDSEGMENT
  97.  
  98. *
  99.       LOGICAL L0,L1,REPRIS,RIGIDE
  100.       CHARACTER*8 TYPRET
  101. *
  102.       MTQ    = KTQ
  103.       MTKAM  = KTKAM
  104.       MTNUM  = KTNUM
  105.       MTFEX  = KTFEX
  106.       MPREF  = KPREF
  107.       MTRES  = KTRES
  108.       MTPAS  = KTPAS
  109.       LOCLFA = KOCLFA
  110.       LOCLB1 = KOCLB1
  111.  
  112.       NP     = XDT(/1) - 1
  113.       NA1    = Q2(/1)
  114.       NB1K   = XK(/2)
  115.       NB1C   = XASM(/2)
  116.       NB1M   = XM(/2)
  117.       NB1    = XOPER(/1)
  118.       NOPER  = XOPER(/3)
  119.       NRES   = XRES(/1)
  120.       NREP   = XREP(/1)
  121.       NCRES  = XRES(/2)
  122.       NPRES  = XRES(/3)
  123.       NPFEXA = FEXA(/1)
  124.       NPC1   = FEXA(/2)
  125.  
  126.       MTLIAA = KTLIAA
  127.       NLIAA  = IPALA(/1)
  128.       NLSA   = INULA(/1)
  129.  
  130.       MTPHI  = KTPHI
  131.       MTLIAB = KTLIAB
  132.  
  133.       NLIAB  = IPALB(/1)
  134.       NLSB   = INULB(/1)
  135.       NPLB   = JPLIB(/1)
  136.       NA2    = XPHILB(/3)
  137.       IDIMB  = XPHILB(/4)
  138.       NTVAR  = ILIREB(/2)
  139.       NIP    = XABSCI(/2)
  140.       NSB    = INMSB(/1)
  141.       IERRD = 0
  142. *
  143. *     Boucle sur les pas de calcul:
  144. *
  145.       IINS  = 0
  146.       IINS2 = 0
  147. *
  148. *     Calcul du premier pas:
  149. *
  150. c      SEGMENT,MTPHI
  151. c         INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  152. cc         INTEGER IAROTA(NSB)
  153. c         REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  154. c      ENDSEGMENT
  155. c      SEGMENT,MTPAS
  156. c         REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1)
  157. c         REAL*8 XPTB(NPLB,2,IDIMB),FINERT(NA1,4)
  158. c         REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR)
  159. c         REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB)
  160. c      ENDSEGMENT
  161.  
  162. c      write(6,*) nplb,idimb,ntvar,nliab
  163.       PDT=XDT(1)
  164.       T=XTEMPS(1)
  165. *      CALL DEVPAS(NA1,NPC1,XK,XASM,XM,PDT,T,1,FTOTA,FEXA,IFEXA,
  166.       CALL DEVPAS(NA1,NPC1,XK,XASM,XM,PDT,T,1,FTOTA,FEXA,
  167.      &            NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  168.      &            NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,
  169.      &            FTOTB,FTOTBA,XPTB,
  170.      &            FEXPSM,FINERT,IERRD,FTEST,FTEST2,
  171.      &            KTQ,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,
  172.      &            KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M)
  173.       IF (IERRD.NE.0) THEN
  174.          IF (IERRD.EQ.1) CALL ERREUR(528)
  175.          RETURN
  176.       ENDIF
  177. *
  178. *     Remplissage du tableau de sauvegarde:
  179. *
  180.       IINS = IINS + 1
  181.       IF ( .NOT. REPRIS ) THEN
  182.          IINS2 = IINS2 + 1
  183.          CALL DEVTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,NCRES,
  184.      &               NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,XVALB,INULB,
  185.      &               NLIAB,NLSB,XRESLB,ILIREA,ILIREB,NTVAR,WEXT,WINT,
  186.      &               XCHPFB,NPLB)
  187.       ENDIF
  188.       IF (IINS.EQ.NINS) THEN
  189.          IINS = 0
  190.          IINS2 = IINS2 + 1
  191.          CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  192.      &               NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  193.      &               XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB,
  194.      &               NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,WEXT,WINT,
  195.      &               XCHPFB,NPLB)
  196.       ENDIF
  197. *
  198.       DO 10 I=2,NP
  199. *
  200. *        Decalage ou mise a zero dans les tableaux pour le pas suivant:
  201. *
  202.          CALL DYNE16(Q1,Q2,Q3,NA1,FTOTA,XPTB,NPLB,IDIMB,FINERT)
  203. *
  204. *        Calcul d'un pas:
  205. *
  206.          PDT=XDT(I)
  207.          T=XTEMPS(I)
  208. *
  209. *         CALL DEVPAS(NA1,NPC1,XK,XASM,XM,PDT,T,I,FTOTA,FEXA,IFEXA,
  210.          CALL DEVPAS(NA1,NPC1,XK,XASM,XM,PDT,T,I,FTOTA,FEXA,
  211.      &               NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  212.      &               NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,
  213.      &               XVALB,FTOTB,FTOTBA,XPTB,
  214.      &               FEXPSM,FINERT,IERRD,FTEST,
  215.      &               FTEST2,KTQ,XABSCI,XORDON,NIP,FTEXB,
  216.      &               FEXB,RIGIDE,KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M)
  217. *
  218.  
  219. *
  220.          IF (IERRD.NE.0) THEN
  221.             IF (IERRD.EQ.1) CALL ERREUR(528)
  222.             RETURN
  223.          ENDIF
  224. *
  225. *        Remplissage du tableau de sauvegarde:
  226. *
  227.          IINS = IINS + 1
  228.          IF (IINS.EQ.NINS) THEN
  229.             IINS = 0
  230.             IINS2 = IINS2 + 1
  231.             CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  232.      &                  NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  233.      &                  XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,
  234.      &                  ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,
  235.      &                  WEXT,WINT,XCHPFB,NPLB)
  236.          ENDIF
  237.  
  238.  10   CONTINUE
  239. *
  240.       END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales