Télécharger la plaquette Cast3M


fr en

Télécharger d3valg.eso

Retour à la liste

Numérotation des lignes : 

d3valg

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

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