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

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