Télécharger la plaquette Cast3M


fr en

Télécharger d2valg.eso

Retour à la liste

Numérotation des lignes : 

d2valg

  1. C D2VALG    SOURCE    BP208322  20/09/18    21:15:12     10718          
  2. C DEVALG    SOURCE    LAVARENN  96/10/30    21:15:20     2349
  3.       SUBROUTINE D2VALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,
  4.      &                  KTRES,KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,
  5.      &                  RIGIDE)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8. *--------------------------------------------------------------------*
  9. *                                                                    *
  10. *     Opérateur DYNE : algorithme differences centrees               *
  11. *     ________________________________________________               *
  12. *                                                                    *
  13. *     Mise en oeuvre de l'algorithme.                                *
  14. *                                                                    *
  15. *     Paramètres:                                                    *
  16. *                                                                    *
  17. * es  KTQ     Segment contenant les variables généralisées           *
  18. *             (et les travaux)
  19. * es  KTKAM   Segment contenant les vecteurs XK, XASM et XM          *
  20. * es  KTPHI   Segment contenant les déformées modales                *
  21. * es  KTLIAA  Segment descriptif des liaisons en base A              *
  22. * es  KTLIAB  Segment descriptif des liaisons en base B              *
  23. * es  KTFEX   Segment contenant les chargements libres               *
  24. * es  KTPAS   Segment des variables au cours d'un pas de temps       *
  25. * es  KTRES   Segment de sauvegarde des résultats                    *
  26. * es  KTNUM   Segment contenant les paramètres numériques            *
  27. * es  KPREF   Segment des points de référence                        *
  28. * e   NINS    On veut une sortie tous les NINS pas de calcul         *
  29. * e   REPRIS  Vrai si reprise de calcul, faux sinon                  *
  30. * e   RIGIDE  Vrai si l'on a un corps rigide, faux sinon             *
  31. *                                                                    *
  32. *     Auteur, date de creation:                                      *
  33. *                                                                    *
  34. *     Denis ROBERT-MOUGIN, le 6 juin 1989.                           *
  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. *
  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.       NP     = XDT(/1) - 1
  112.       NA1    = Q2(/1)
  113.       NB1K   = XK(/2)
  114.       NB1C   = XASM(/2)
  115.       NB1M   = XM(/2)
  116.       NB1    = XOPER(/1)
  117.       NOPER  = XOPER(/3)
  118.       NRES   = XRES(/1)
  119.       NREP   = XREP(/1)
  120.       NCRES  = XRES(/2)
  121.       NPRES  = XRES(/3)
  122.       NPFEXA = FEXA(/1)
  123.       NPC1   = FEXA(/2)
  124.       MTLIAA = KTLIAA
  125.       NLIAA  = IPALA(/1)
  126.       NLSA   = INULA(/1)
  127.       MTPHI  = KTPHI
  128.       MTLIAB = KTLIAB
  129.       NLIAB  = IPALB(/1)
  130.       NLSB   = INULB(/1)
  131.       NPLB   = JPLIB(/1)
  132.       NA2    = XPHILB(/3)
  133.       IDIMB  = XPHILB(/4)
  134.       NTVAR  = ILIREB(/2)
  135.       NIP    = XABSCI(/2)
  136.       NSB    = INMSB(/1)
  137.       IERRD = 0
  138. *
  139. *     Boucle sur les pas de calcul:
  140. *
  141.       IINS  = 0
  142.       IINS2 = 0
  143. *
  144. *     Calcul du premier pas:
  145. *
  146. c       write(*,*) '=== Calcul du premier pas ==='
  147. c       write(*,*) 'Q1(:,2) =',(Q1(iou,2),iou=1,NA1)
  148. c       write(*,*) 'Q2(:,2) =',(Q2(iou,2),iou=1,NA1)
  149. c       write(*,*) 'Q3(:,2) =',(Q3(iou,2),iou=1,NA1)
  150.       PDT=XDT(1)
  151.       T=XTEMPS(1)
  152.       CALL D2VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,1,FTOTA,FEXA,
  153.      &            NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  154.      &            NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,XVALB,
  155.      &            FTOTB,FTOTBA,XPTB,
  156.      &            FEXPSM,FINERT,IERRD,FTEST,FTEST2,
  157.      &            WEXT,WINT,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,
  158.      &            KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M)
  159.       IF (IERRD.NE.0) THEN
  160.          IF (IERRD.EQ.1) CALL ERREUR(528)
  161.          RETURN
  162.       ENDIF
  163. *
  164. *     Remplissage du tableau de sauvegarde:
  165. *
  166.       IINS = IINS + 1
  167.       IF ( .NOT. REPRIS ) THEN
  168.          IINS2 = IINS2 + 1
  169.          CALL D2VTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,NCRES,
  170.      &               NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,XVALB,INULB,
  171.      &               NLIAB,NLSB,XRESLB,ILIREA,ILIREB,NTVAR,WEXT,WINT,
  172.      &               XCHPFB,NPLB)
  173.       ENDIF
  174.       IF (IINS.EQ.NINS) THEN
  175.          IINS = 0
  176.          IINS2 = IINS2 + 1
  177.          CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  178.      &               NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  179.      &               XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB,
  180.      &               NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,WEXT,WINT,
  181.      &               XCHPFB,NPLB)
  182.       ENDIF
  183. *
  184.       DO 10 I=2,NP
  185. *
  186. *      Decalage ou mise a zero dans les tableaux pour le pas suivant:
  187. *
  188.        CALL D2NE16(Q1,Q2,Q3,NA1,FTOTA,XPTB,NPLB,IDIMB,FINERT,WEXT,WINT)
  189. *
  190. *      Calcul d'un pas:
  191. *
  192.        PDT=XDT(I)
  193.        T=XTEMPS(I)
  194. *
  195. c        if(I.le.5) write(*,*) '=== Calcul du pas ===',I
  196.        CALL D2VPAS(Q1,Q2,Q3,NA1,NPC1,XK,XASM,XM,PDT,T,I,FTOTA,FEXA,
  197.      &             NPFEXA,NLIAA,NLSA,IPALA,IPLIA,XPALA,XVALA,
  198.      &             NLIAB,NLSB,NPLB,IDIMB,IPALB,IPLIB,JPLIB,XPALB,
  199.      &             XVALB,FTOTB,FTOTBA,XPTB,
  200.      &             FEXPSM,FINERT,IERRD,FTEST,FTEST2,
  201.      &             WEXT,WINT,XABSCI,XORDON,NIP,FTEXB,FEXB,RIGIDE,
  202.      &             KTPHI,XCHPFB,XOPER,NB1,NB1K,NB1C,NB1M)
  203. *
  204. *
  205.          IF (IERRD.NE.0) THEN
  206.             IF (IERRD.EQ.1) CALL ERREUR(528)
  207.             RETURN
  208.          ENDIF
  209. *
  210. *        Remplissage du tableau de sauvegarde:
  211. *
  212.          IINS = IINS + 1
  213.          IF (IINS.EQ.NINS) THEN
  214.             IINS = 0
  215.             IINS2 = IINS2 + 1
  216.             CALL DEVTR1(Q1,Q2,Q3,NA1,IINS2,NINS,FTOTA,XRES,ICHRES,NRES,
  217.      &                  NCRES,NPRES,XREP,NREP,XVALA,INULA,NLIAA,NLSA,
  218.      &                  XRESLA,XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,
  219.      &                  ILIREB,NTVAR,XPALB,IPALB,XMREP,IMREP,IDIMB,
  220.      &                  WEXT,WINT,XCHPFB,NPLB)
  221.          ENDIF
  222.  10      CONTINUE
  223. *     end do
  224. *
  225.       END
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  

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