Télécharger la plaquette Cast3M


fr en

Télécharger rigtab.eso

Retour à la liste

Numérotation des lignes : 

rigtab

  1. C RIGTAB    SOURCE    PV090527  26/04/30    21:16:22     12529          
  2.       SUBROUTINE RIGTAB(ITBAS,ITBST,IRIG,IRET)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     calcule pour les modes les petites matrices RIGIDITE contenant *
  9. *     la masse (IRIG = 1), la raideur (IRIG = 2), ou amortissement   *
  10. *     (IRIG = 3). Ces matrices sont associ{es @ l'{l{ment qui con-   *
  11. *     tient le point qui est l'indice de chaque mode.                *
  12. *                                                                    *
  13. *     Param}tres:                                                    *
  14. *                                                                    *
  15. * e   ITBAS   table de mode, de sous-type BASE_DE_MODES              *
  16. * e   IRIG    1, 2, ou 3                                             *
  17. * s   IRET    matrice de masse, de rigidit{, ou d'amortissement      *
  18. *                                                                    *
  19. *     Auteur, date de cr{ation:                                      *
  20. *                                                                    *
  21. *     Lionel VIVAN, le 7 juin 1990.                                  *
  22. *                                                                    *
  23. *--------------------------------------------------------------------*
  24. *                                                                    *
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. *-
  30. -INC SMELEME
  31. -INC SMRIGID
  32. -INC SMCOORD
  33. -INC SMTABLE
  34. -INC SMLMOTS
  35. *
  36.       LOGICAL L0,L1,ltelq
  37.       CHARACTER*8 TYPRET,CHARRE
  38. *      CHARACTER*4 lesinc(6),lesdua(6)
  39.       PARAMETER (jgm=12)
  40.       CHARACTER*4 lesinc(jgm),lesdua(jgm)
  41.       DATA lesinc/'UX','UY','UZ','RX','RY','RZ',
  42.      >'IUX','IUY','IUZ','IRX','IRY','IRZ'/
  43.       DATA lesdua/'FX','FY','FZ','MX','MY','MZ',
  44.      >'IFX','IFY','IFZ','IMX','IMY','IMZ'/
  45. *
  46.       IRET = 0
  47.       IF (IRIG.NE.1 .AND. IRIG.NE.2 .AND. IRIG.NE.3) RETURN
  48. *
  49.       NRIGE = 8
  50.       NRIGEL = 1
  51.       SEGINI MRIGID
  52.       IF (IRIG.EQ.1) THEN
  53.          MTYMAT = 'MASSE   '
  54.       ELSE IF (IRIG.EQ.2) THEN
  55.          MTYMAT = 'RIGIDITE'
  56.       ELSE
  57.          MTYMAT = 'AMORMODA'
  58.       ENDIF
  59.  
  60.       IFORIG = IFOUR
  61.       COERIG(1) = 1.D0
  62.       IMGEO1 = 0
  63.       IMGEO2 = 0
  64.       ICHOLE = 0
  65.       ISUPEQ = 0
  66. *
  67.       IRIGEL(2,1) = 0
  68.       IRIGEL(5,1) = NIFOUR
  69.       IRIGEL(6,1) = 0
  70.  
  71.       mrimod = 0
  72.       if (itbas.eq.0) goto 30
  73.  
  74.       NLIGRP = 1
  75.       NLIGRD = 1
  76.       SEGINI DESCR
  77.       IRIGEL(3,1) = DESCR
  78.       NOELEP(1) = 1
  79.       NOELED(1) = 1
  80.       LISINC(1) = 'ALFA'
  81.       LISDUA(1) = 'FALF'
  82.       SEGDES DESCR
  83. *
  84.       mtable = itbas
  85.       segact mtable
  86.       mlo = mlotab
  87.       IM = 0
  88.  10   CONTINUE
  89.       IM = IM + 1
  90.       TYPRET = ' '
  91.       CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  92.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  93.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  94.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  95.      &                      'POINT',I1,X1,' ',L1,IPTS)
  96.          CALL CRELEM(IPTS)
  97.  
  98.          IF (IM.EQ.1) THEN
  99.             IPT1 = IPTS
  100.          ELSE
  101.             IPT2 = IPTS
  102.             ltelq=.false.
  103.             CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  104.             IF (IERR.NE.0) RETURN
  105.             IPT1 = IMAIL
  106.          ENDIF
  107.          GOTO 10
  108.       ENDIF
  109.       if (im.lt.mlo) goto 10
  110.       if (ipt1.eq.0) then
  111.         interr(1) = 1
  112.         if (mrigid.gt.0) segsup mrigid
  113.         call erreur(974)
  114.         return
  115.       endif
  116.  
  117.       IRIGEL(1,1) = IPT1
  118. *
  119.       segact ipt1
  120.       NBMODE = ipt1.num(/2)
  121.       segdes ipt1
  122.       NELRIG = NBMODE
  123.       rigrel=0
  124.       SEGINI xMATRI
  125.       IRIGEL(4,1) = xMATRI
  126.       NLIGRP=1
  127.       NLIGRD=1
  128.       DO 20 IM = 1,NBMODE
  129. *         SEGINI XMATRI
  130. *         IMATTT(IM) = XMATRI
  131.          CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  132.      &                      'TABLE',I1,X1,' ',L1,ITMOD)
  133.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  134.      &                'FLOTTANT',I1,XMGEN,' ',L1,IP1)
  135.          IF (IRIG.EQ.1) THEN
  136.             RE(1,1,im) = XMGEN
  137.          ELSE IF (IRIG.EQ.2) THEN
  138.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  139.      &                   'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  140.             OMEG = 2. * XPI * XFREQ
  141.             OMEG = OMEG * OMEG
  142.             RE(1,1,im) = XMGEN * OMEG
  143. cbp-2017-10-02 : ajout
  144.             IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0            
  145.          ELSE
  146.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  147.      &                   'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  148.             OMEG = 2. * XPI * XFREQ
  149.             RE(1,1,im) = XMGEN * OMEG * 2.
  150. cbp-2017-10-02 : ajout
  151.             IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0            
  152.          ENDIF
  153. *         SEGDES XMATRI
  154.  20      CONTINUE
  155.  
  156.       SEGDES xMATRI
  157. *
  158.       mrimod = mrigid
  159.       SEGDES MRIGID
  160.       if (itbst.eq.0) goto 80
  161.  
  162.  30   continue
  163.       jgn = 4
  164. c      jgm = 6
  165.       segini mlmots
  166.       iinc = mlmots
  167.       do igm = 1,jgm
  168.        mots(igm) = lesinc(igm)
  169.       enddo
  170.       segini mlmots
  171.       idua = mlmots
  172.       do igm= 1,jgm
  173.        mots(igm) = lesdua(igm)
  174.       enddo
  175.  
  176.       if (itbas.ne.0) then
  177.         segini,ri1=mrigid
  178.         mrigid = ri1
  179.       endif
  180.       mrista = mrigid
  181.  
  182.       NLIGRP = 1
  183.       NLIGRD = 1
  184.       SEGINI DESCR
  185.       IRIGEL(3,1) = DESCR
  186.       NOELEP(1) = 1
  187.       NOELED(1) = 1
  188.       LISINC(1) = 'BETA'
  189.       LISDUA(1) = 'FBET'
  190.       SEGDES DESCR
  191. *
  192.  
  193.       mtable = itbst
  194.       segact mtable
  195.  
  196.       IM = 0
  197.       IPT1 = 0
  198.  40   CONTINUE
  199.       IM = IM + 1
  200.       itmod = mtabiv(im)
  201.       typret = mtabtv(im)
  202.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  203.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  204.      &                      'POINT',I1,X1,' ',L1,IPTS)
  205.          CALL CRELEM(IPTS)
  206.          IF (IPT1.EQ.0) THEN
  207.             IPT1 = IPTS
  208.          ELSE
  209.             IPT2 = IPTS
  210.             ltelq=.false.
  211.             CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  212.             IF (IERR.NE.0) RETURN
  213.             IPT1 = IMAIL
  214.          ENDIF
  215.          GOTO 40
  216.       ENDIF
  217.       if (im.lt.mlotab) goto 40
  218.       IRIGEL(1,1) = IPT1
  219.       if (ipt1.le.0) then
  220.         interr(1) = 2
  221.         if (mrigid.gt.0) segsup mrigid
  222.         call erreur(974)
  223.         return
  224.       endif
  225.  
  226.       segact ipt1
  227.       NBMODE = ipt1.num(/2)
  228.       segdes ipt1
  229.       NELRIG = NBMODE
  230.       rigrel=0
  231.       SEGINI xMATRI
  232.       IRIGEL(4,1) = xMATRI
  233.       NLIGRP=1
  234.       NLIGRD=1
  235.  
  236.  
  237.       IM = 0
  238.       IMA = 0
  239.  50   CONTINUE
  240.       IM = IM + 1
  241.       itmod = mtabiv(im)
  242.       typret = mtabtv(im)
  243.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  244. *         SEGINI XMATRI
  245.          IMA = IMA + 1
  246. *         IMATTT(IMA) = XMATRI
  247.         ITAB2=itmod
  248.        IF (IRIG.EQ.1) THEN
  249.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  250.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  251.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  252.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  253.           if (ierr.ne.0) return
  254.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  255.           re(1,1,ima) = x1
  256.        ELSE IF (IRIG.EQ.2) THEN
  257.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  258.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  259.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  260.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  261.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  262.          if (ierr.ne.0) return
  263.          RE(1,1,ima) = x1
  264.        ELSE
  265.          MTYMAT = 'AMORMODA'
  266.        ENDIF
  267. *       segdes xmatri
  268.       ENDIF
  269.  
  270.       if (im.lt.mlotab) goto 50
  271.       segdes xmatri
  272. *
  273.       if (mrimod.gt.0) then
  274.         call fusrig(mrimod,mrista,mrigid)
  275.       else
  276.        goto 79
  277.       endif
  278.       if (irig.gt.2) goto 79
  279.  
  280.       mridec = mrigid
  281.       mrigid = mrimod
  282.       ri1 = mrimod
  283.       ri2 = mrista
  284.       segact ri1,ri2
  285.       ipt1 = ri1.irigel(1,1)
  286.       ipt2 = ri2.irigel(1,1)
  287.       segdes ri1,ri2
  288.  
  289.       segact ipt1,ipt2
  290.  
  291.       NRIGE = 8
  292.       NRIGEL = 2
  293. * hypothèse modes vib bloqués - pour la rigidite inutile de les coupler
  294.       if (irig.eq.2) nrigel = 1
  295. * il faut suffisamment de modes statiques
  296.       if (ipt2.num(/2).eq.1) nrigel = 1
  297.       SEGINI MRIGID
  298. *     write (6,*) ' ini mrigid ',mrigid,nrigel
  299.       mricou = mrigid
  300.       IF (IRIG.EQ.1) THEN
  301.          MTYMAT = 'MASSE   '
  302.       ELSE IF (IRIG.EQ.2) THEN
  303.          MTYMAT = 'RIGIDITE'
  304.       ELSE
  305.          MTYMAT = 'AMORMODA'
  306.       ENDIF
  307.       IFORIG = IFOUR
  308.       COERIG(1) = 1.D0
  309.       if (nrigel.gt.1) COERIG(2) = 1.D0
  310.       IMGEO1 = 0
  311.       IMGEO2 = 0
  312.       ICHOLE = 0
  313.       ISUPEQ = 0
  314. *
  315.       IRIGEL(2,1) = 0
  316.       IRIGEL(5,1) = NIFOUR
  317.       IRIGEL(6,1) = 0
  318.       if (nrigel.gt.1) IRIGEL(2,2) = 0
  319.       if (nrigel.gt.1) IRIGEL(5,2) = NIFOUR
  320.       if (nrigel.gt.1) IRIGEL(6,2) = 0
  321.  
  322. * hypothèse mod vib bloques
  323.       if (irig.eq.2) goto 64
  324.       NBELEM = ipt1.num(/2) * ipt2.num(/2)
  325.       NBNN = 2
  326.       NBSOUS = 0
  327.       NBREF = 0
  328.       SEGINI MELEME
  329.       ITYPEL=27
  330.       NELRIG=NBELEM
  331.           NLIGRP=2
  332.       NLIGRD=2
  333.       rigrel=0
  334.       SEGINI xMATRI
  335.       SEGINI DESCR
  336.       NOELEP(1)=1
  337.       NOELEP(2)=2
  338.       NOELED(1)=1
  339.       NOELED(2)=2
  340.       LISINC(1)='ALFA'
  341.       LISINC(2)='BETA'
  342.       LISDUA(1)='FALF'
  343.       LISDUA(2)='FBET'
  344.       SEGDES DESCR
  345.       irigel(1,1) = meleme
  346.       irigel(3,1) = descr
  347.       IRIGEL(4,1) = xMATRI
  348.  
  349.  64   if (ipt2.num(/2).le.1) goto 61
  350.       nbelem = ipt2.num(/2)*(ipt2.num(/2) - 1) / 2
  351.       NBNN = 2
  352.       NBSOUS = 0
  353.       NBREF = 0
  354.       SEGINI MELEME
  355.       ITYPEL=27
  356.       NELRIG=NBELEM
  357.           NLIGRP=2
  358.       NLIGRD=2
  359.       rigrel=0
  360.       SEGINI xMATRI
  361.       SEGINI DESCR
  362.       NOELEP(1)=1
  363.       NOELEP(2)=2
  364.       NOELED(1)=1
  365.       NOELED(2)=2
  366.       LISINC(1)='BETA'
  367.       LISINC(2)='BETA'
  368.       LISDUA(1)='FBET'
  369.       LISDUA(2)='FBET'
  370.       SEGDES DESCR
  371.       irigel(1,nrigel) = meleme
  372.       irigel(3,nrigel) = descr
  373.       IRIGEL(4,nrigel) = xMATRI
  374.  
  375.  61   continue
  376. * distingue les kas couplage mode_vib/mod_stat et couplage mode_stat/mode_stat
  377.       kas = 1
  378.       iima = ipt1.num(/2)
  379. * hypothese mod vib bloques
  380.       if (irig.eq.2) then
  381.        kas = kas + 1
  382.        iima = ipt2.num(/2) - 1
  383.       endif
  384.       meleme = irigel(1,1)
  385.       xmatri = irigel(4,1)
  386.       segact meleme*mod,xmatri*mod
  387.  62   continue
  388.       kelem = 0
  389.       do ii = 1, iima
  390.        IF (IRIG.EQ.1) THEN
  391.          IF (kas.EQ.1) THEN
  392.           CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  393.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  394.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  395.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  396.          ELSE IF (kas.EQ.2) THEN
  397.           CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  398.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  399.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  400.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  401.          ENDIF
  402.        ELSE IF (IRIG.EQ.2) THEN
  403.          IF (kas.EQ.1) THEN
  404.           CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  405.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  406.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  407.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  408.          ELSE IF (kas.EQ.2) THEN
  409.           CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  410.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  411.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  412.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  413.          ENDIF
  414.  
  415.        ELSE IF (IRIG.EQ.3) THEN
  416. *
  417.        ENDIF
  418. *         write(6,*) 'gk' , num(/1),num(/2), ii,kelem,kas
  419.        if (kas.eq.1) then
  420.            jjin = 1
  421.         elseif (kas.eq.2) then
  422.            jjin = ii + 1
  423.         endif
  424.  
  425.        do jj = jjin,ipt2.num(/2)
  426.           kelem = kelem +1
  427. *          write(6,*) 'jh' , kelem ,num(/2),ipt2.num(/2),jj
  428.           if (kas.eq.1) then
  429.             num(1,kelem) = ipt1.num(1,ii)
  430.           elseif (kas.eq.2) then
  431.             num(1,kelem) = ipt2.num(1,ii)
  432.           endif
  433.           num(2,kelem) = ipt2.num(1,jj)
  434.           mtable = itbst
  435.           segact mtable
  436.           ima = 0
  437.           im = 0
  438.  65       im = im + 1
  439.           itab2 = mtabiv(im)
  440.           typret = mtabtv(im)
  441.       if (ITAB2.NE.0 .AND. TYPRET.EQ.'TABLE   ')   ima = ima + 1
  442.          if (ima.ne.jj) goto 65
  443. *         SEGINI XMATRI
  444. *         IMATTT(kelem) = XMATRI
  445.  
  446.          IF (IRIG.EQ.1) THEN
  447.           CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  448.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  449. c t(mode ou sol_stat)*Masse*Sol_stat
  450.          ELSE IF (IRIG.EQ.2) THEN
  451.           CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  452.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  453. c t(mode ou sol_stat)* Reac(Sol_stat)
  454.          ELSE
  455. c         MTYMAT = 'AMORMODA'
  456.          ENDIF
  457.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  458.          re(2,1,kelem) = x1
  459.          re(1,2,kelem) = re(2,1,kelem)
  460.  
  461. *         segdes xmatri
  462.         enddo
  463.       enddo
  464.  
  465.       segdes meleme,xmatri
  466.       if (kas.eq.1.and.ipt2.num(/2).gt.1) then
  467.        kas = kas + 1
  468.        iima = ipt2.num(/2) - 1
  469.        meleme = irigel(1,kas)
  470.        xmatri = irigel(4,kas)
  471.        goto 62
  472.       endif
  473.       continue
  474.       segdes ipt1,ipt2
  475.       mrigid=mridec
  476. *     write (6,*) 'avant segact mridec ',mridec
  477.       segact mrigid
  478.       mrigid=mricou
  479. *     write (6,*) 'avant segact mricou ',mricou
  480.       segact mrigid
  481.       call fusrig(mridec,mricou,mrigid)
  482.  
  483.  79   mlmots = idua
  484.       mlmot1 = iinc
  485.       segsup mlmots, mlmot1
  486.  
  487.  80   continue
  488.       IRET = MRIGID
  489.  
  490. *
  491.       END
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  

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