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    PV090527  26/04/30    21:16:17     12529          
  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.       rigrel=0
  51.       segini xmatr1,xmatr2
  52.       NBELEM = nelrig
  53.       NBNN = 2
  54.       NBSOUS = 0
  55.       NBREF = 0
  56.       SEGINI IPT1,IPT2
  57.       IPT1.ITYPEL=27
  58.       IPT2.ITYPEL=27
  59.       NBELE1 = NELRI1
  60.       NBELE2 = NELRI2
  61. *
  62. *
  63.       DO is = 1,nstat
  64.  
  65.         imodel = pistat(is)
  66.         segact imodel
  67.         ipt4 = imamod
  68.         segact ipt4
  69.         if (ipt4.num(/1).ne.1) call erreur(5)
  70.         nbelem = ipt4.num(/2)
  71. * en principe on ne devrait pas trop boucler
  72.         do ib = 1,nbelem
  73.          if (nbelem.gt.1) then
  74.           do ib1 = ib+1 , nbelem
  75.              iv1 = ivstat(is)
  76.              iv2 = ivstat(is)
  77.          call ricro1(iv1,iv2,ib,ib1,'STAT',irig,iinc,idua,xr1)
  78.             if (ABS(xr1).lt.xspeti) goto 21
  79.             kelri1 = kelri1 + 1
  80. *            segini xmatri
  81.             xmatr1.re(2,1,kelri1) = xr1
  82.             xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  83. *            imatr1.imattt(kelri1) = xmatri
  84. * cree segment ib- ib1
  85.             ipt1.num(1,kelri1) = ipt4.num(1,ib)
  86.             ipt1.num(2,kelri1) = ipt4.num(1,ib1)
  87.             if (kelri1.eq.nelri1) then
  88.               nelrig = nelri1 + 100
  89.               nelri1 = nelrig
  90.               rigrel=0
  91.               segadj xmatr1
  92.               nbelem = nelrig
  93.               segadj ipt1
  94.               NBELE1 = NELRI1
  95.             endif
  96.  21         continue
  97.           enddo
  98.          endif
  99.  
  100.  
  101.          IF (IS.LT.NSTAT) THEN
  102.           DO is2 = is + 1 ,nstat
  103.            imode2 = pistat(is2)
  104.            segact imode2
  105.            ipt5 = imode2.imamod
  106.            segact ipt5
  107.            if (ipt5.num(/1).ne.1) call erreur(6)
  108.            nbele2 = ipt5.num(/2)
  109.            do ib2 = 1,nbele2
  110.              iv1 = ivstat(is)
  111.              iv2 = ivstat(is2)
  112.          call ricro1(iv1,iv2,ib,ib2,'STAT',irig,iinc,idua,xr1)
  113.             if (ABS(xr1).lt.xspeti) goto 22
  114.             kelri1 = kelri1 + 1
  115. *            segini xmatri
  116.             xmatr1.re(2,1,kelri1) = xr1
  117.             xmatr1.re(1,2,kelri1) = xmatr1.re(2,1,kelri1)
  118. *            imatr1.imattt(kelri1) = xmatri
  119. * cree segment ib- ib2
  120.             ipt1.num(1,kelri1) = ipt4.num(1,ib)
  121.             ipt1.num(2,kelri1) = ipt5.num(1,ib2)
  122.             if (kelri1.eq.nelri1) then
  123.               nelrig = nelri1 + 100
  124.               nelri1 = nelrig
  125.               rigrel=0
  126.               segadj xmatr1
  127.               nbelem = nelrig
  128.               segadj ipt1
  129.               NBELE1 = NELRI1
  130.             endif
  131.  22         continue
  132.            enddo
  133.           ENDDO
  134.          ENDIF
  135.  
  136. *
  137.  
  138.          DO im = 1, nmoda
  139.            imode1 = pimoda(im)
  140.            segact imode1
  141.            ipt3 = imode1.imamod
  142.            segact ipt3
  143.            if (ipt3.num(/1).ne.1) call erreur(7)
  144.            nbele3 = ipt3.num(/2)
  145.            do ib3 = 1,nbele3
  146.             iv1 = ivstat(is)
  147.             iv2 = ivmoda(im)
  148.          call ricro1(iv1,iv2,ib,ib3,'MODA',irig,iinc,idua,xr1)
  149.             if (ABS(xr1).lt.xspeti) goto 23
  150.             kelri2 = kelri2 + 1
  151. *            segini xmatri
  152.             xmatr2.re(2,1,kelri2) = xr1
  153.             xmatr2.re(1,2,kelri2) = xmatr2.re(2,1,kelri2)
  154. *            imatr2.imattt(kelri2) = xmatri
  155. * cree segment ib- ib3
  156.             ipt2.num(1,kelri2) =  ipt3.num(1,ib3)
  157.             ipt2.num(2,kelri2) =  ipt4.num(1,ib)
  158.             if (kelri2.eq.nelri2) then
  159.               nelrig = nelri2 + 100
  160.               nelri2 = nelrig
  161.               rigrel=0
  162.               segadj xmatr2
  163.               nbelem = nelrig
  164.               segadj ipt2
  165.               NBELE2 = NELRI2
  166.             endif
  167.  23         continue
  168.            enddo
  169.  
  170.          ENDDO
  171.         enddo
  172.  
  173.       ENDDO
  174.  
  175.  100  continue
  176.       NRIGE = 8
  177.       NRIGEL = 1
  178.       irstat = 0
  179.       irmoda = 0
  180.       if (nstat.gt.1) then
  181.       nbelem = kelri1
  182.       SEGADJ IPT1
  183.       NELRIG=NBELEM
  184.       rigrel=0
  185.       SEGADJ xMATR1
  186.       SEGINI DESCR
  187.       NOELEP(1)=1
  188.       NOELEP(2)=2
  189.       NOELED(1)=1
  190.       NOELED(2)=2
  191.       LISINC(1)='BETA'
  192.       LISINC(2)='BETA'
  193.       LISDUA(1)='FBET'
  194.       LISDUA(2)='FBET'
  195.       SEGDES DESCR
  196.       segini mrigid
  197.       irstat = mrigid
  198.       irigel(1,1) = ipt1
  199.       irigel(3,1) = descr
  200.       IRIGEL(4,1) = xMATR1
  201.       IFORIG = IFOUR
  202.       COERIG(1) = 1.D0
  203.       IMGEO1 = 0
  204.       IMGEO2 = 0
  205.       ICHOLE = 0
  206.       ISUPEQ = 0
  207.       if (irig.eq.1) then
  208.         MTYMAT = 'MASSE   '
  209.       elseif (irig.eq.2) then
  210.         MTYMAT = 'RIGIDITE'
  211.       elseif (irig.eq.3) then
  212.         MTYMAT = 'AMORTISS'
  213.       endif
  214. *
  215.       IRIGEL(2,1) = 0
  216.       IRIGEL(5,1) = NIFOUR
  217.       IRIGEL(6,1) = 0
  218.       endif
  219.  
  220.       if (nmoda.gt.0) then
  221.       nbelem = kelri2
  222.       SEGADJ IPT2
  223.       NELRIG=NBELEM
  224.       rigrel=0
  225.       SEGADJ xMATR2
  226.       SEGINI DESCR
  227.       NOELEP(1)=1
  228.       NOELEP(2)=2
  229.       NOELED(1)=1
  230.       NOELED(2)=2
  231.       LISINC(1)='ALFA'
  232.       LISINC(2)='BETA'
  233.       LISDUA(1)='FALF'
  234.       LISDUA(2)='FBET'
  235.       SEGDES DESCR
  236.       segini mrigid
  237.       irmoda = mrigid
  238.       irigel(1,1) = ipt2
  239.       irigel(3,1) = descr
  240.       IRIGEL(4,1) = xMATR2
  241.       IFORIG = IFOUR
  242.       COERIG(1) = 1.D0
  243.       IMGEO1 = 0
  244.       IMGEO2 = 0
  245.       ICHOLE = 0
  246.       ISUPEQ = 0
  247.       if (irig.eq.1) then
  248.         MTYMAT = 'MASSE   '
  249.       elseif (irig.eq.2) then
  250.         MTYMAT = 'RIGIDITE'
  251.       endif
  252. *
  253.       IRIGEL(2,1) = 0
  254.       IRIGEL(5,1) = NIFOUR
  255.       IRIGEL(6,1) = 0
  256.       endif
  257.  
  258.       if (irmoda.eq.0) then
  259.        ir2 = irstat
  260.       else if (irstat.eq.0) then
  261.        ir2 = irmoda
  262.       else
  263.        call fusrig(irstat,irmoda, ir2)
  264.       endif
  265.  
  266.       mlmots = iinc
  267.       segsup mlmots
  268.       mlmots = idua
  269.       segsup mlmots
  270.  
  271.       END
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  

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