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    CB215821  25/04/23    21:15:43     12247          
  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.       SEGINI xMATRI
  124.       IRIGEL(4,1) = xMATRI
  125.       NLIGRP=1
  126.       NLIGRD=1
  127.       DO 20 IM = 1,NBMODE
  128. *         SEGINI XMATRI
  129. *         IMATTT(IM) = XMATRI
  130.          CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',L0,IP0,
  131.      &                      'TABLE',I1,X1,' ',L1,ITMOD)
  132.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0,
  133.      &                'FLOTTANT',I1,XMGEN,' ',L1,IP1)
  134.          IF (IRIG.EQ.1) THEN
  135.             RE(1,1,im) = XMGEN
  136.          ELSE IF (IRIG.EQ.2) THEN
  137.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  138.      &                   'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  139.             OMEG = 2. * XPI * XFREQ
  140.             OMEG = OMEG * OMEG
  141.             RE(1,1,im) = XMGEN * OMEG
  142. cbp-2017-10-02 : ajout
  143.             IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0            
  144.          ELSE
  145.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0,
  146.      &                   'FLOTTANT',I1,XFREQ,' ',L1,IP1)
  147.             OMEG = 2. * XPI * XFREQ
  148.             RE(1,1,im) = XMGEN * OMEG * 2.
  149. cbp-2017-10-02 : ajout
  150.             IF(XFREQ.LT.0.D0) RE(1,1,im) = 0.D0            
  151.          ENDIF
  152. *         SEGDES XMATRI
  153.  20      CONTINUE
  154.  
  155.       SEGDES xMATRI
  156. *
  157.       mrimod = mrigid
  158.       SEGDES MRIGID
  159.       if (itbst.eq.0) goto 80
  160.  
  161.  30   continue
  162.       jgn = 4
  163. c      jgm = 6
  164.       segini mlmots
  165.       iinc = mlmots
  166.       do igm = 1,jgm
  167.        mots(igm) = lesinc(igm)
  168.       enddo
  169.       segini mlmots
  170.       idua = mlmots
  171.       do igm= 1,jgm
  172.        mots(igm) = lesdua(igm)
  173.       enddo
  174.  
  175.       if (itbas.ne.0) then
  176.         segini,ri1=mrigid
  177.         mrigid = ri1
  178.       endif
  179.       mrista = mrigid
  180.  
  181.       NLIGRP = 1
  182.       NLIGRD = 1
  183.       SEGINI DESCR
  184.       IRIGEL(3,1) = DESCR
  185.       NOELEP(1) = 1
  186.       NOELED(1) = 1
  187.       LISINC(1) = 'BETA'
  188.       LISDUA(1) = 'FBET'
  189.       SEGDES DESCR
  190. *
  191.  
  192.       mtable = itbst
  193.       segact mtable
  194.  
  195.       IM = 0
  196.       IPT1 = 0
  197.  40   CONTINUE
  198.       IM = IM + 1
  199.       itmod = mtabiv(im)
  200.       typret = mtabtv(im)
  201.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  202.          CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  203.      &                      'POINT',I1,X1,' ',L1,IPTS)
  204.          CALL CRELEM(IPTS)
  205.          IF (IPT1.EQ.0) THEN
  206.             IPT1 = IPTS
  207.          ELSE
  208.             IPT2 = IPTS
  209.             ltelq=.false.
  210.             CALL FUSE(IPT1,IPT2,IMAIL,ltelq)
  211.             IF (IERR.NE.0) RETURN
  212.             IPT1 = IMAIL
  213.          ENDIF
  214.          GOTO 40
  215.       ENDIF
  216.       if (im.lt.mlotab) goto 40
  217.       IRIGEL(1,1) = IPT1
  218.       if (ipt1.le.0) then
  219.         interr(1) = 2
  220.         if (mrigid.gt.0) segsup mrigid
  221.         call erreur(974)
  222.         return
  223.       endif
  224.  
  225.       segact ipt1
  226.       NBMODE = ipt1.num(/2)
  227.       segdes ipt1
  228.       NELRIG = NBMODE
  229.       SEGINI xMATRI
  230.       IRIGEL(4,1) = xMATRI
  231.       NLIGRP=1
  232.       NLIGRD=1
  233.  
  234.  
  235.       IM = 0
  236.       IMA = 0
  237.  50   CONTINUE
  238.       IM = IM + 1
  239.       itmod = mtabiv(im)
  240.       typret = mtabtv(im)
  241.       IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  242. *         SEGINI XMATRI
  243.          IMA = IMA + 1
  244. *         IMATTT(IMA) = XMATRI
  245.         ITAB2=itmod
  246.        IF (IRIG.EQ.1) THEN
  247.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  248.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  249.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  250.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  251.           if (ierr.ne.0) return
  252.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  253.           re(1,1,ima) = x1
  254.        ELSE IF (IRIG.EQ.2) THEN
  255.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  256.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  257.          CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  258.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  259.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  260.          if (ierr.ne.0) return
  261.          RE(1,1,ima) = x1
  262.        ELSE
  263.          MTYMAT = 'AMORMODA'
  264.        ENDIF
  265. *       segdes xmatri
  266.       ENDIF
  267.  
  268.       if (im.lt.mlotab) goto 50
  269.       segdes xmatri
  270. *
  271.       if (mrimod.gt.0) then
  272.         call fusrig(mrimod,mrista,mrigid)
  273.       else
  274.        goto 79
  275.       endif
  276.       if (irig.gt.2) goto 79
  277.  
  278.       mridec = mrigid
  279.       mrigid = mrimod
  280.       ri1 = mrimod
  281.       ri2 = mrista
  282.       segact ri1,ri2
  283.       ipt1 = ri1.irigel(1,1)
  284.       ipt2 = ri2.irigel(1,1)
  285.       segdes ri1,ri2
  286.  
  287.       segact ipt1,ipt2
  288.  
  289.       NRIGE = 8
  290.       NRIGEL = 2
  291. * hypothèse modes vib bloqués - pour la rigidite inutile de les coupler
  292.       if (irig.eq.2) nrigel = 1
  293. * il faut suffisamment de modes statiques
  294.       if (ipt2.num(/2).eq.1) nrigel = 1
  295.       SEGINI MRIGID
  296. *     write (6,*) ' ini mrigid ',mrigid,nrigel
  297.       mricou = mrigid
  298.       IF (IRIG.EQ.1) THEN
  299.          MTYMAT = 'MASSE   '
  300.       ELSE IF (IRIG.EQ.2) THEN
  301.          MTYMAT = 'RIGIDITE'
  302.       ELSE
  303.          MTYMAT = 'AMORMODA'
  304.       ENDIF
  305.       IFORIG = IFOUR
  306.       COERIG(1) = 1.D0
  307.       if (nrigel.gt.1) COERIG(2) = 1.D0
  308.       IMGEO1 = 0
  309.       IMGEO2 = 0
  310.       ICHOLE = 0
  311.       ISUPEQ = 0
  312. *
  313.       IRIGEL(2,1) = 0
  314.       IRIGEL(5,1) = NIFOUR
  315.       IRIGEL(6,1) = 0
  316.       if (nrigel.gt.1) IRIGEL(2,2) = 0
  317.       if (nrigel.gt.1) IRIGEL(5,2) = NIFOUR
  318.       if (nrigel.gt.1) IRIGEL(6,2) = 0
  319.  
  320. * hypothèse mod vib bloques
  321.       if (irig.eq.2) goto 64
  322.       NBELEM = ipt1.num(/2) * ipt2.num(/2)
  323.       NBNN = 2
  324.       NBSOUS = 0
  325.       NBREF = 0
  326.       SEGINI MELEME
  327.       ITYPEL=27
  328.       NELRIG=NBELEM
  329.           NLIGRP=2
  330.       NLIGRD=2
  331.       SEGINI xMATRI
  332.       SEGINI DESCR
  333.       NOELEP(1)=1
  334.       NOELEP(2)=2
  335.       NOELED(1)=1
  336.       NOELED(2)=2
  337.       LISINC(1)='ALFA'
  338.       LISINC(2)='BETA'
  339.       LISDUA(1)='FALF'
  340.       LISDUA(2)='FBET'
  341.       SEGDES DESCR
  342.       irigel(1,1) = meleme
  343.       irigel(3,1) = descr
  344.       IRIGEL(4,1) = xMATRI
  345.  
  346.  64   if (ipt2.num(/2).le.1) goto 61
  347.       nbelem = ipt2.num(/2)*(ipt2.num(/2) - 1) / 2
  348.       NBNN = 2
  349.       NBSOUS = 0
  350.       NBREF = 0
  351.       SEGINI MELEME
  352.       ITYPEL=27
  353.       NELRIG=NBELEM
  354.           NLIGRP=2
  355.       NLIGRD=2
  356.       SEGINI xMATRI
  357.       SEGINI DESCR
  358.       NOELEP(1)=1
  359.       NOELEP(2)=2
  360.       NOELED(1)=1
  361.       NOELED(2)=2
  362.       LISINC(1)='BETA'
  363.       LISINC(2)='BETA'
  364.       LISDUA(1)='FBET'
  365.       LISDUA(2)='FBET'
  366.       SEGDES DESCR
  367.       irigel(1,nrigel) = meleme
  368.       irigel(3,nrigel) = descr
  369.       IRIGEL(4,nrigel) = xMATRI
  370.  
  371.  61   continue
  372. * distingue les kas couplage mode_vib/mod_stat et couplage mode_stat/mode_stat
  373.       kas = 1
  374.       iima = ipt1.num(/2)
  375. * hypothese mod vib bloques
  376.       if (irig.eq.2) then
  377.        kas = kas + 1
  378.        iima = ipt2.num(/2) - 1
  379.       endif
  380.       meleme = irigel(1,1)
  381.       xmatri = irigel(4,1)
  382.       segact meleme*mod,xmatri*mod
  383.  62   continue
  384.       kelem = 0
  385.       do ii = 1, iima
  386.        IF (IRIG.EQ.1) THEN
  387.          IF (kas.EQ.1) THEN
  388.           CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  389.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  390.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  391.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  392.          ELSE IF (kas.EQ.2) THEN
  393.           CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  394.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  395.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  396.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  397.          ENDIF
  398.        ELSE IF (IRIG.EQ.2) THEN
  399.          IF (kas.EQ.1) THEN
  400.           CALL ACCTAB(ITBAS,'ENTIER',II,X0,' ',L0,IP0,
  401.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  402.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  403.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  404.          ELSE IF (kas.EQ.2) THEN
  405.           CALL ACCTAB(ITBST,'ENTIER',II,X0,' ',L0,IP0,
  406.      &                    TYPRET,I1,X1,CHARRE,L1,ITMOD)
  407.           CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE',L0,IP0,
  408.      &                  'CHPOINT ',I1,X1,' ',L1,ITDEPL)
  409.          ENDIF
  410.  
  411.        ELSE IF (IRIG.EQ.3) THEN
  412. *
  413.        ENDIF
  414. *         write(6,*) 'gk' , num(/1),num(/2), ii,kelem,kas
  415.        if (kas.eq.1) then
  416.            jjin = 1
  417.         elseif (kas.eq.2) then
  418.            jjin = ii + 1
  419.         endif
  420.  
  421.        do jj = jjin,ipt2.num(/2)
  422.           kelem = kelem +1
  423. *          write(6,*) 'jh' , kelem ,num(/2),ipt2.num(/2),jj
  424.           if (kas.eq.1) then
  425.             num(1,kelem) = ipt1.num(1,ii)
  426.           elseif (kas.eq.2) then
  427.             num(1,kelem) = ipt2.num(1,ii)
  428.           endif
  429.           num(2,kelem) = ipt2.num(1,jj)
  430.           mtable = itbst
  431.           segact mtable
  432.           ima = 0
  433.           im = 0
  434.  65       im = im + 1
  435.           itab2 = mtabiv(im)
  436.           typret = mtabtv(im)
  437.       if (ITAB2.NE.0 .AND. TYPRET.EQ.'TABLE   ')   ima = ima + 1
  438.          if (ima.ne.jj) goto 65
  439. *         SEGINI XMATRI
  440. *         IMATTT(kelem) = XMATRI
  441.  
  442.          IF (IRIG.EQ.1) THEN
  443.           CALL ACCTAB(ITAB2,'MOT',I0,X0,'MASSE_DEFORMEE',L0,IP0,
  444.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  445. c t(mode ou sol_stat)*Masse*Sol_stat
  446.          ELSE IF (IRIG.EQ.2) THEN
  447.           CALL ACCTAB(ITAB2,'MOT',I0,X0,'REACTION',L0,IP0,
  448.      &                  'CHPOINT ',I1,X1,' ',L1,ITREAC)
  449. c t(mode ou sol_stat)* Reac(Sol_stat)
  450.          ELSE
  451. c         MTYMAT = 'AMORMODA'
  452.          ENDIF
  453.          CALL XTY1(itdepl,itreac,iinc,idua,X1)
  454.          re(2,1,kelem) = x1
  455.          re(1,2,kelem) = re(2,1,kelem)
  456.  
  457. *         segdes xmatri
  458.         enddo
  459.       enddo
  460.  
  461.       segdes meleme,xmatri
  462.       if (kas.eq.1.and.ipt2.num(/2).gt.1) then
  463.        kas = kas + 1
  464.        iima = ipt2.num(/2) - 1
  465.        meleme = irigel(1,kas)
  466.        xmatri = irigel(4,kas)
  467.        goto 62
  468.       endif
  469.       continue
  470.       segdes ipt1,ipt2
  471.       mrigid=mridec
  472. *     write (6,*) 'avant segact mridec ',mridec
  473.       segact mrigid
  474.       mrigid=mricou
  475. *     write (6,*) 'avant segact mricou ',mricou
  476.       segact mrigid
  477.       call fusrig(mridec,mricou,mrigid)
  478.  
  479.  79   mlmots = idua
  480.       mlmot1 = iinc
  481.       segsup mlmots, mlmot1
  482.  
  483.  80   continue
  484.       IRET = MRIGID
  485.  
  486. *
  487.       END
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  

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