Télécharger la plaquette Cast3M


fr en

Télécharger ricroi.eso

Retour à la liste

Numérotation des lignes : 

ricroi

  1. C RICROI    SOURCE    CB215821  25/04/23    21:15:42     12247          
  2.       SUBROUTINE RICROI(modsta,ir2,irig)
  3. *--calcul termes croisés 'STATIQUE' et/ou 'MODAL'
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC CCREEL
  10. -INC SMRIGID
  11. -INC SMCOORD
  12. -INC SMCHAML
  13. -INC SMELEME
  14. -INC SMLMOTS
  15. -INC SMMODEL
  16. c
  17.       segment modsta
  18.        integer pimoda(nmoda),pistat(nstat)
  19.        integer ivmoda(nmoda),ivstat(nstat)
  20.       endsegment
  21.       CHARACTER*4 lesinc(7),lesdua(7),mot2
  22.       DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/
  23.       DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/
  24.  
  25.       ir2 = 0
  26.       nstat = pistat(/1)
  27.       nmoda = pimoda(/1)
  28.  
  29.       jgn = 4
  30.       jgm = 6
  31.       segini mlmots
  32.       iinc = mlmots
  33.       do igm = 1,jgm
  34.        mots(igm) = lesinc(igm)
  35.       enddo
  36.       segini mlmots
  37.       idua = mlmots
  38.       do igm= 1,jgm
  39.        mots(igm) = lesdua(igm)
  40.       enddo
  41.  
  42.       nelrig = 100
  43. * 'STATIQUE'/'STATIQUE' : 1 * 'STATIQUE'/'MODAL' : 2
  44.       nelri1 = nelrig
  45.       nelri2 = nelrig
  46.       kelri1 = 0
  47.       kelri2 = 0
  48.           nligrd = 2
  49.       nligrp = 2
  50.       segini xmatr1,xmatr2
  51.       NBELEM = nelrig
  52.       NBNN = 2
  53.       NBSOUS = 0
  54.       NBREF = 0
  55.       SEGINI IPT1,IPT2
  56.       IPT1.ITYPEL=27
  57.       IPT2.ITYPEL=27
  58.       NBELE1 = NELRI1
  59.       NBELE2 = NELRI2
  60. *
  61. *
  62.       DO is = 1,nstat
  63.  
  64.         imodel = pistat(is)
  65.         segact imodel
  66.         ipt4 = imamod
  67.         segact ipt4
  68.         if (ipt4.num(/1).ne.1) call erreur(5)
  69.         nbelem = ipt4.num(/2)
  70. * en principe on ne devrait pas trop boucler
  71.         do ib = 1,nbelem
  72.          if (nbelem.gt.1) then
  73.           do ib1 = ib+1 , nbelem
  74.              iv1 = ivstat(is)
  75.              iv2 = ivstat(is)
  76.          call ricro1(iv1,iv2,ib,ib1,'STAT',irig,iinc,idua,xr1)
  77.             if (ABS(xr1).lt.xspeti) goto 21
  78.             kelri1 = kelri1 + 1
  79. *            segini xmatri
  80.             xmatr1.re(2,1,kelri1) = xr1
  81.             xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  82. *            imatr1.imattt(kelri1) = xmatri
  83. * cree segment ib- ib1
  84.             ipt1.num(1,kelri1) = ipt4.num(1,ib)
  85.             ipt1.num(2,kelri1) = ipt4.num(1,ib1)
  86.             if (kelri1.eq.nelri1) then
  87.               nelrig = nelri1 + 100
  88.               nelri1 = nelrig
  89.               segadj xmatr1
  90.               nbelem = nelrig
  91.               segadj ipt1
  92.               NBELE1 = NELRI1
  93.             endif
  94.  21         continue
  95.           enddo
  96.          endif
  97.  
  98.  
  99.          IF (IS.LT.NSTAT) THEN
  100.           DO is2 = is + 1 ,nstat
  101.            imode2 = pistat(is2)
  102.            segact imode2
  103.            ipt5 = imode2.imamod
  104.            segact ipt5
  105.            if (ipt5.num(/1).ne.1) call erreur(6)
  106.            nbele2 = ipt5.num(/2)
  107.            do ib2 = 1,nbele2
  108.              iv1 = ivstat(is)
  109.              iv2 = ivstat(is2)
  110.          call ricro1(iv1,iv2,ib,ib2,'STAT',irig,iinc,idua,xr1)
  111.             if (ABS(xr1).lt.xspeti) goto 22
  112.             kelri1 = kelri1 + 1
  113. *            segini xmatri
  114.             xmatr1.re(2,1,kelri1) = xr1
  115.             xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  116. *            imatr1.imattt(kelri1) = xmatri
  117. * cree segment ib- ib2
  118.             ipt1.num(1,kelri1) = ipt4.num(1,ib)
  119.             ipt1.num(2,kelri1) = ipt5.num(1,ib2)
  120.             if (kelri1.eq.nelri1) then
  121.               nelrig = nelri1 + 100
  122.               nelri1 = nelrig
  123.               segadj xmatr1
  124.               nbelem = nelrig
  125.               segadj ipt1
  126.               NBELE1 = NELRI1
  127.             endif
  128.  22         continue
  129.            enddo
  130.           ENDDO
  131.          ENDIF
  132.  
  133. *
  134.  
  135.          DO im = 1, nmoda
  136.            imode1 = pimoda(im)
  137.            segact imode1
  138.            ipt3 = imode1.imamod
  139.            segact ipt3
  140.            if (ipt3.num(/1).ne.1) call erreur(7)
  141.            nbele3 = ipt3.num(/2)
  142.            do ib3 = 1,nbele3
  143.             iv1 = ivstat(is)
  144.             iv2 = ivmoda(im)
  145.          call ricro1(iv1,iv2,ib,ib3,'MODA',irig,iinc,idua,xr1)
  146.             if (ABS(xr1).lt.xspeti) goto 23
  147.             kelri2 = kelri2 + 1
  148. *            segini xmatri
  149.             xmatr2.re(2,1,kelri2) = xr1
  150.             xmatr2.re(1,2,kelri2) = xmatr2.re(2,1,kelri2)
  151. *            imatr2.imattt(kelri2) = xmatri
  152. * cree segment ib- ib3
  153.             ipt2.num(1,kelri2) =  ipt3.num(1,ib3)
  154.             ipt2.num(2,kelri2) =  ipt4.num(1,ib)
  155.             if (kelri2.eq.nelri2) then
  156.               nelrig = nelri2 + 100
  157.               nelri2 = nelrig
  158.               segadj xmatr2
  159.               nbelem = nelrig
  160.               segadj ipt2
  161.               NBELE2 = NELRI2
  162.             endif
  163.  23         continue
  164.            enddo
  165.  
  166.          ENDDO
  167.         enddo
  168.  
  169.       ENDDO
  170.  
  171.  100  continue
  172.       NRIGE = 8
  173.       NRIGEL = 1
  174.       irstat = 0
  175.       irmoda = 0
  176.       if (nstat.gt.1) then
  177.       nbelem = kelri1
  178.       SEGADJ IPT1
  179.       NELRIG=NBELEM
  180.       SEGADJ xMATR1
  181.       SEGINI DESCR
  182.       NOELEP(1)=1
  183.       NOELEP(2)=2
  184.       NOELED(1)=1
  185.       NOELED(2)=2
  186.       LISINC(1)='BETA'
  187.       LISINC(2)='BETA'
  188.       LISDUA(1)='FBET'
  189.       LISDUA(2)='FBET'
  190.       SEGDES DESCR
  191.       segini mrigid
  192.       irstat = mrigid
  193.       irigel(1,1) = ipt1
  194.       irigel(3,1) = descr
  195.       IRIGEL(4,1) = xMATR1
  196.       IFORIG = IFOUR
  197.       COERIG(1) = 1.D0
  198.       IMGEO1 = 0
  199.       IMGEO2 = 0
  200.       ICHOLE = 0
  201.       ISUPEQ = 0
  202.       if (irig.eq.1) then
  203.         MTYMAT = 'MASSE   '
  204.       elseif (irig.eq.2) then
  205.         MTYMAT = 'RIGIDITE'
  206.       elseif (irig.eq.3) then
  207.         MTYMAT = 'AMORTISS'
  208.       endif
  209. *
  210.       IRIGEL(2,1) = 0
  211.       IRIGEL(5,1) = NIFOUR
  212.       IRIGEL(6,1) = 0
  213.       endif
  214.  
  215.       if (nmoda.gt.0) then
  216.       nbelem = kelri2
  217.       SEGADJ IPT2
  218.       NELRIG=NBELEM
  219.       SEGADJ xMATR2
  220.       SEGINI DESCR
  221.       NOELEP(1)=1
  222.       NOELEP(2)=2
  223.       NOELED(1)=1
  224.       NOELED(2)=2
  225.       LISINC(1)='ALFA'
  226.       LISINC(2)='BETA'
  227.       LISDUA(1)='FALF'
  228.       LISDUA(2)='FBET'
  229.       SEGDES DESCR
  230.       segini mrigid
  231.       irmoda = mrigid
  232.       irigel(1,1) = ipt2
  233.       irigel(3,1) = descr
  234.       IRIGEL(4,1) = xMATR2
  235.       IFORIG = IFOUR
  236.       COERIG(1) = 1.D0
  237.       IMGEO1 = 0
  238.       IMGEO2 = 0
  239.       ICHOLE = 0
  240.       ISUPEQ = 0
  241.       if (irig.eq.1) then
  242.         MTYMAT = 'MASSE   '
  243.       elseif (irig.eq.2) then
  244.         MTYMAT = 'RIGIDITE'
  245.       endif
  246. *
  247.       IRIGEL(2,1) = 0
  248.       IRIGEL(5,1) = NIFOUR
  249.       IRIGEL(6,1) = 0
  250.       endif
  251.  
  252.       if (irmoda.eq.0) then
  253.        ir2 = irstat
  254.       else if (irstat.eq.0) then
  255.        ir2 = irmoda
  256.       else
  257.        call fusrig(irstat,irmoda, ir2)
  258.       endif
  259.  
  260.       mlmots = iinc
  261.       segsup mlmots
  262.       mlmots = idua
  263.       segsup mlmots
  264.  
  265.       END
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  

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