Télécharger la plaquette Cast3M


fr en

Télécharger dyne26.eso

Retour à la liste

Numérotation des lignes : 

dyne26

  1. C DYNE26    SOURCE    CB215821  24/04/12    21:15:38     11897          
  2.       SUBROUTINE DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IB,ICOMP,
  3.      &                  RIGIDE,ITCARA,LMODYN,ITKM)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Operateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Transpose l'information des objets de Castem2000 dans des      *
  12. *     tableaux de travail.                                           *
  13. *                                                                    *
  14. *     Parametres:                                                    *
  15. *                                                                    *
  16. * e   IBAS    Table representant une base modale                     *
  17. * es  KTKAM   Segment contenant les matrices XK, XASM et XM          *
  18. * es  KTPHI   Segment des deformees modales                          *
  19. * e   KTLIAB  Segment des liaisons sur base B                        *
  20. * es  IA1     Compteur                                               *
  21. * e   IB      Compteur de la sous base                               *
  22. * es  RIGIDE  Vrai si l'on a un corps rigide, faux sinon             *
  23. * e   LMODYN  Logique = vrai si table PASAPAS                        *
  24. * e   ITKM    >0 si table RAIDEUR_ET_MASSE fournie                   *
  25. *                                                                    *
  26. *     Auteur, date de creation:                                      *
  27. *                                                                    *
  28. *     Lionel VIVAN, le 24 octobre 1989.                              *
  29. *                                                                    *
  30. *--------------------------------------------------------------------*
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCREEL
  35. -INC SMCHAML
  36. -INC SMELEME
  37. -INC SMMODEL
  38. *
  39.       SEGMENT,MTKAM
  40.          REAL*8 XK(NA1,NB1K),XASM(NA1,NB1C),XM(NA1,NB1M)
  41.          REAL*8 XOPER(NB1,NB1,NOPER)
  42.       ENDSEGMENT
  43. *
  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. *
  50.       SEGMENT,MTLIAB
  51.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  52.          REAL*8 XPALB(NLIAB,NXPALB)
  53.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  54.       ENDSEGMENT
  55. *
  56.       segment mtbas
  57.         integer itbmod,lsstru(np1),nsstru
  58.       endsegment
  59. *
  60.       LOGICAL L0,L1,RIGIDE,LMODYN
  61.       CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3)
  62.       CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE
  63.       REAL*8      XAXROT(3),XROTA(2,3)
  64. *
  65. *     si IFOMOD = -1  :  modele PLAN
  66. *     si IFOMOD =  0  :  modele AXIS
  67. *     si IFOMOD =  1  :  modele FOUR
  68. *     si IFOMOD =  2  :  modele TRID
  69. *
  70. *     Les noms de composante sont
  71. *       - en modele PLAN   :  UX, UY, RT
  72. *       - en modele AXIS   :  UX, UY, RZ
  73. *       - en modele FOUR 1 :  UR, UZ, UT, RT
  74. *       - en modele TRID   :  UX, UY, UZ, RX, RY, RZ
  75. *
  76.       DATA NOMTRI/'UX  ','UY  ','UZ  ','RX  ','RY  ','RZ  '/
  77.       DATA NOMAXI/'UR  ','UT  ','UZ  ','RR  ','RT  ','RZ  '/
  78.       DATA NOMPLA/'UX  ','UY  ','RZ  '/
  79. *
  80.       MTKAM  = KTKAM
  81.       MTPHI  = KTPHI
  82.       MTLIAB = KTLIAB
  83. *
  84.       NLIAB  = IPALB(/1)
  85.       NPLB   = JPLIB(/1)
  86.       NSB    = XPHILB(/1)
  87.       NPLSB  = XPHILB(/2)
  88.       NA2    = XPHILB(/3)
  89.       IDIMB  = XPHILB(/4)
  90.       DEUXPI = 2.D0 * XPI
  91. *
  92.       IORSB(IB) = IA1 + 1
  93.       IAROTA(IB) = 0
  94.       IROT = 0
  95.       IN = 0
  96.  
  97.  
  98. ************************************************************************
  99. *      Aiguillage pour le cas
  100. ************************************************************************
  101.  
  102.       if (lmodyn) goto 40
  103.  
  104.  
  105. ************************************************************************
  106. *     table BASE_MODALE
  107. ************************************************************************
  108.  
  109.  10   CONTINUE
  110.       IN = IN + 1
  111.       TYPRET = ' '
  112.       CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0,
  113.      &                   TYPRET,I1,X1,CHARRE,L1,IBAMOD)
  114.       IF (IERR.NE.0) RETURN
  115. *    -on a bien un objet de type table
  116.       IF (IBAMOD.NE.0) THEN
  117.        IF (TYPRET.EQ.'TABLE   ') THEN
  118.  
  119.          IA1 = IA1 + 1
  120.  
  121. *        remplissage de XM et XK diagonale depuis la table BASE_MODALE
  122. *        sauf si deja fait car on a une table RAIDEUR_ET_MASSE !
  123.          IF(ITKM.LE.0) THEN
  124.            CALL ACCTAB(IBAMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  125.      &                        'FLOTTANT',I1,XMASSE,' ',L1,IP1)
  126.            IF (IERR.NE.0) RETURN
  127.            XM(IA1,1) = XMASSE
  128.            CALL ACCTAB(IBAMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  129.      &                        'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  130.            IF (IERR.NE.0) RETURN
  131.            OMEGA = XFREQ * DEUXPI
  132.            XK(IA1,1) = XMASSE * OMEGA * OMEGA
  133.            IF (IIMPI.EQ.333) THEN
  134.               WRITE(IOIMP,*)'DYNE26 :   XM(',IA1,') =',XMASSE
  135.               WRITE(IOIMP,*)'DYNE26 :   XK(',IA1,') =',XK(IA1,1)
  136.            ENDIF
  137.          ENDIF
  138.  
  139. *        si liaison_B existe, remplissage de IPLSB, XPHILB, IAROTA, INMSB...
  140.          IF (NLIAB.NE.0) THEN
  141.             CALL ACCTAB(IBAMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  142.      &                         'CHPOINT',I1,X1,' ',L1,ICDM)
  143.             IF (IERR.NE.0) RETURN
  144.             CALL ACTOBJ('CHPOINT ',ICDM,1)
  145.             DO 12 ID = 1,IDIMB
  146.                IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  147.                   CMOT = NOMAXI(ID)
  148.                ELSE
  149.                   IF (IFOMOD.EQ.-1) THEN
  150.                       CMOT = NOMPLA(ID)
  151.                   ELSE
  152.                       CMOT = NOMTRI(ID)
  153.                   ENDIF
  154.                ENDIF
  155.                IF (IIMPI.EQ.333)
  156.      &         WRITE(IOIMP,*)'DYNE26 :  composante a extraire :',CMOT
  157.                ICOMP  = 0
  158.                DO 14 IP = 1,NPLB
  159.                   IPOINT = JPLIB(IP)
  160. *      On extrait du chpoint ICDM au point IPOINT de composante CMOT
  161.                   CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET)
  162.                   ICOMP = ICOMP + 1
  163. *          on ajuste la taille si necessaire
  164.                   IF(ICOMP.GT.NPLSB) THEN
  165.                       NPLSB=ICOMP
  166.                       SEGADJ MTPHI
  167.                   ENDIF
  168.                   IPLSB(IP) = ICOMP
  169. * suite a la modif dans extra9, car on attribue une valeur meme
  170. * si le point n'existe pas dans le chpoint
  171.                   IF (XVAL.NE.0.) THEN
  172.                     IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  173.                       call erreur (783)
  174.                       RETURN
  175.                     ENDIF
  176.                     IBASB(IP) = IB
  177.                   ELSEIF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) THEN
  178.                     IBASB(IP) = IB
  179.                   ENDIF
  180.                   XPHILB(IB,ICOMP,IN,ID) = XVAL
  181.       IF (IIMPI.EQ.333) THEN
  182.         WRITE(IOIMP,*)'DYNE26 :   IPLSB(',IP,') =',IPLSB(IP)
  183.         WRITE(IOIMP,*)'DYNE26 :   IBASB(',IP,') =',IBASB(IP)
  184.         XVA2 = XPHILB(IB,ICOMP,IN,ID)
  185.         WRITE(IOIMP,*)'DYNE26 :   XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  186.       ENDIF
  187.  14            CONTINUE
  188.  12         CONTINUE
  189.          ENDIF
  190.  
  191. *        Prise en compte d'un mode de rotation de corps rigide
  192.          MORIGI = ' '
  193.          CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0,
  194.      &                      MORIGI,I1,X1,CMOT,L1,IP1)
  195.          IF (IERR.NE.0) RETURN
  196.          IF (MORIGI.EQ.'MOT') THEN
  197.             IF (CMOT(1:4).EQ.'VRAI') THEN
  198.                 CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',
  199.      &          L0,IP0,'POINT',I1,X1,'  ',L1,ICDG)
  200.                 IF (IERR.NE.0) RETURN
  201.                 IAROTA(IB)=IA1
  202.                 IROT = IN
  203.             ENDIF
  204.          ENDIF
  205.          GOTO 10
  206.        ELSE
  207.          CALL ERREUR(491)
  208.          RETURN
  209.        ENDIF
  210.       ENDIF
  211. *    -fin du cas ou on a bien un objet de type table
  212.       INMSB(IB) = IN - 1
  213.  
  214.  
  215. ************************************************************************
  216. *     table PASAPAS
  217. ************************************************************************
  218.  
  219.  40   if (lmodyn) then
  220. *
  221.        mtbas = ibas
  222.        mmodel = itbmod
  223.        segact mmodel
  224.        mchelm = itcara
  225.        segact mchelm
  226.        n1 = imache(/1)
  227.        IN = 0
  228.  
  229.        do 41 ik =1,kmodel(/1)
  230.         imodel = kmodel(ik)
  231.         if (lsstru(ik).ne.ib) goto 41
  232.          IN =  IN + 1
  233.         segact imodel
  234.         jdefo = 0
  235.         jmass = 0
  236.         jfreq = 0
  237.         jgrav = 0
  238.         do 46 inc = 1,n1
  239.           meleme = imache(inc)
  240.           if (meleme.ne.imamod) goto 46
  241.           if (conche(inc).ne.conmod) goto 46
  242.           segact meleme
  243.           mchaml = ichaml(inc)
  244.           segact mchaml
  245.           n2 = ielval(/1)
  246.  
  247.           do io = 1,n2
  248.             if (nomche(io)(1:4).eq.'DEFO') then
  249.               jdefo = io
  250.               melval = ielval(io)
  251.               segact melval
  252.             else if  (nomche(io)(1:4).eq.'MASS') then
  253.               jmass =io
  254.               melval = ielval(io)
  255.               segact melval
  256.             else if (nomche(io)(1:4).eq.'FREQ') then
  257.               jfreq = io
  258.               melval = ielval(io)
  259.               segact melval
  260.             else if (nomche(io)(1:4).eq.'CGRA') then
  261.               jgrav = io
  262.               melval = ielval(io)
  263.               segact melval
  264.             else
  265.             endif
  266.            if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0.and.
  267.      &jgrav.gt.0) goto 47
  268.           enddo
  269.            if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0) goto 47
  270.  46     continue
  271.         if (jdefo.eq.0.and.jmass.eq.0.and.jfreq.eq.0) then
  272.          write(6,*) 'pas de caracteristiques modele ',ik, conmod
  273.          return
  274.         endif
  275.  47     continue
  276.         do ip =1,num(/2)
  277.          IA1 = IA1 + 1
  278.            melval = ielval(jmass)
  279.            xmasse = velche(1,ip)
  280.          XM(IA1,1) = XMASSE
  281.  
  282.            melval = ielval(jfreq)
  283.            xfreq = velche(1,ip)
  284.          OMEGA = XFREQ * DEUXPI
  285.          XK(IA1,1) = XMASSE * OMEGA * OMEGA
  286.  
  287.            melval = ielval(jdefo)
  288.            icdm = ielche(1,ip)
  289.  
  290. **
  291. *   Prise en compte d'un mode de rotation de corps rigide
  292.            if (jgrav.gt.0) then
  293.              melval = ielval(jgrav)
  294.              ICDG = ielche(1,ip)
  295.                 IAROTA(IB)=IA1
  296.                 IROT = IN
  297.            endif
  298.         enddo
  299. *
  300. *
  301.          IF (IIMPI.EQ.333) THEN
  302.             WRITE(IOIMP,*)'DYNE26 :   XM(',IA1,') =',XMASSE
  303.             WRITE(IOIMP,*)'DYNE26 :   XK(',IA1,') =',XK(IA1,1)
  304.          ENDIF
  305.          IF (NLIAB.NE.0) THEN
  306.  
  307.             CALL ACTOBJ('CHPOINT ',ICDM,1)
  308.  
  309.             DO 42 ID = 1,IDIMB
  310.                IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN
  311.                   CMOT = NOMAXI(ID)
  312.                ELSE
  313.                   IF (IFOMOD.EQ.-1) THEN
  314.                       CMOT = NOMPLA(ID)
  315.                   ELSE
  316.                       CMOT = NOMTRI(ID)
  317.                   ENDIF
  318.                ENDIF
  319.                IF (IIMPI.EQ.333) THEN
  320.                   WRITE(IOIMP,*)'DYNE26 :  composante a extraire :',CMOT
  321.                ENDIF
  322.                ICOMP  = 0
  323.                DO 44 IP = 1,NPLB
  324.                   IPOINT = JPLIB(IP)
  325. *
  326. *     On extrait du chpoint ICDM au point IPOINT de composante CMOT
  327. *
  328.                   CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET)
  329.                      ICOMP = ICOMP + 1
  330. *
  331. *          on ajuste la taille si necessaire
  332. *                      MP
  333.                          IF(ICOMP.GT.NPLSB) THEN
  334.                              NPLSB=ICOMP
  335.                              SEGADJ MTPHI
  336.                          ENDIF
  337.                      IPLSB(IP) = ICOMP
  338. * suite e la modif dans extra9, car on attribue une valeur meme
  339. * si le point n'existe pas dans le chpoint
  340.                      IF (XVAL.NE.0.) THEN
  341.                       IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN
  342.                        call erreur (783)
  343.                         RETURN
  344.                       ENDIF
  345.                         IBASB(IP) = IB
  346.                      ELSE
  347.             IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB
  348.                      ENDIF
  349. *
  350.                      XPHILB(IB,ICOMP,IN,ID) = XVAL
  351.       IF (IIMPI.EQ.333) THEN
  352.         WRITE(IOIMP,*)'DYNE26 :   IPLSB(',IP,') =',IPLSB(IP)
  353.         WRITE(IOIMP,*)'DYNE26 :   IBASB(',IP,') =',IBASB(IP)
  354.         XVA2 = XPHILB(IB,ICOMP,IN,ID)
  355.         WRITE(IOIMP,*)'DYNE26 :   XPHILB(',IB,ICOMP,IN,ID,') =',XVA2
  356.       ENDIF
  357.  
  358.  44               CONTINUE
  359.  42            CONTINUE
  360.           ENDIF
  361. *
  362.  
  363.  41    continue
  364.        INMSB(IB) = IN
  365.        IN = IN + 1
  366.  
  367.        endif
  368. ****** fin du cas table PASAPAS ****************************************
  369.  
  370.  
  371. ************************************************************************
  372. *     Remplissage des fausses deformees modales de rotations
  373. ************************************************************************
  374.  
  375.  50   continue
  376.       IF (IAROTA(IB).NE.0) THEN
  377.          RIGIDE = .TRUE.
  378.          MERR = 0
  379.          NPLUS = IN + 1
  380.          IF (NPLUS.GT.NA2) THEN
  381. * On reajuste le dimension NA2 de XPHILB
  382.                  NA2 = NPLUS
  383.                  SEGADJ MTPHI
  384.          ENDIF
  385.          DO 18 IP=1,NPLB
  386.              IPOINT=JPLIB(IP)
  387.              IPOS=IPLSB(IP)
  388.              IBBAS= IBASB(IP)
  389.              IF (IBBAS.EQ.IB) THEN
  390.                 DO 20 ID=(IDIM+1),IDIMB
  391.                   XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID)
  392.  20             CONTINUE
  393. * En tridimensionnel l'axe de rotation est le vecteur propre de rotation
  394. * On norme l axe du plan de rotation
  395.                 CALL DYNE41(XAXROT,MERR,IDIM)
  396. * En bidimensionnel l'axe de rotation est fixe
  397. * Calcul des fausses deformees modales de rotation
  398.                 CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR)
  399.              DO 22 ID =1,IDIMB
  400.                  XPHILB(IB,IPOS,IN,ID)  = XROTA(1,ID)
  401.                  XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID)
  402.  22          CONTINUE
  403.              ENDIF
  404.  18       CONTINUE
  405.       ENDIF
  406.  
  407.       IF (IIMPI.EQ.333) THEN
  408.         WRITE(IOIMP,*)'DYNE26 :   INMSB(',IB,') =',INMSB(IB)
  409.         WRITE(IOIMP,*)'DYNE26 :   IORSB(',IB,') =',IORSB(IB)
  410.         WRITE(IOIMP,*)'DYNE26 :   IAROTA(',IB,') =',IAROTA(IB)
  411.       ENDIF
  412. *
  413.       END
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  

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