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

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