Télécharger la plaquette Cast3M


fr en

Télécharger varin6.eso

Retour à la liste

Numérotation des lignes : 

varin6

  1. C VARIN6    SOURCE    CB215821  24/04/12    21:17:25     11897          
  2.       SUBROUTINE VARIN6(ipmode,icara)
  3. *
  4. * cree compos facultatives modele modal et statique
  5. *
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8(A-H,O-Z)
  8. *
  9. -INC SMCHAML
  10. -INC SMMODEL
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC SMLREEL
  15. -INC SMLMOTS
  16. -INC SMELEME
  17. -INC CCNOYAU
  18. -INC CCREEL
  19. -INC SMLENTI
  20. *
  21.       LOGICAL dricr,dmacr,damcr
  22.       CHARACTER*4 lesinc(8),lesdua(8)
  23.       DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT'/
  24.       DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT'/
  25.       POINTEUR MLENT4.MLENTI,MLENT5.MLENTI,MLENT6.MLENTI,
  26.      &MLENT7.MLENTI,MLENT8.MLENTI,MLENT9.MLENTI,MLEN10.MLENTI
  27.       POINTEUR MLREAM.MLREEL,MLREE4.MLREEL,MLREE5.MLREEL
  28. C
  29. * 0 : point support, 1: imodel, 2: mchaml, 3: defo,
  30. * 4: ricr , 5: maia, 6, maib, 7: macr, 8: imade, 9: itreac, 10: amcr
  31.       jgn = 4
  32.        if (ifour.eq.2) then
  33.       jgm = 6
  34.       segini mlmots
  35.       iinc = mlmots
  36.       do igm = 1,jgm
  37.        mots(igm) = lesinc(igm)
  38.       enddo
  39.       segini mlmots
  40.       idua = mlmots
  41.       do igm= 1,jgm
  42.        mots(igm) = lesdua(igm)
  43.       enddo
  44.        else if (ifour.lt.0) then
  45.       jgm = 4
  46.       segini mlmots
  47.       iinc = mlmots
  48.        mots(1) = lesinc(1)
  49.        mots(2) = lesinc(2)
  50.        mots(3) = lesinc(4)
  51.        mots(4) = lesinc(5)
  52.       segini mlmots
  53.       idua = mlmots
  54.        mots(1) = lesdua(1)
  55.        mots(2) = lesdua(2)
  56.        mots(3) = lesdua(4)
  57.        mots(4) = lesdua(5)
  58.        else if (ifour.eq.0) then
  59.       jgm = 3
  60.       segini mlmots
  61.       iinc = mlmots
  62.        mots(1) = lesinc(7)
  63.        mots(2) = lesinc(3)
  64.        mots(3) = lesinc(6)
  65.       segini mlmots
  66.       idua = mlmots
  67.        mots(1) = lesdua(7)
  68.        mots(2) = lesdua(3)
  69.        mots(3) = lesdua(6)
  70.        else if (ifour.eq.1) then
  71. * a faire
  72.        endif
  73.  
  74.         mchelm = icara
  75.  
  76.       mmodel = ipmode
  77.       NBELEM = kmodel(/1)
  78.  
  79.         NBNN = 1
  80.         NBELEM = kmodel(/1)
  81.         JG = NBELEM
  82.         segini mlenti,mlent1,mlent2
  83.         JG = 0
  84.  
  85.       do im = 1,kmodel(/1)
  86.         imodel = kmodel(im)
  87.         if (cmatee.eq.'STATIQUE'.OR.cmatee.eq.'MODAL') then
  88.          meleme = imamod
  89.          JG = JG + 1
  90. * a ameliorer si maillage non reduit à un point
  91.          lect(JG) = num(1,1)
  92.          mlent1.lect(JG) = imodel
  93.          do isous = 1,imache(/1)
  94.         if (imache(isous).eq.imamod.and.conche(isous).eq.conmod) then
  95.           mchaml = ichaml(isous)
  96.           segact mchaml*mod
  97.           mlent2.lect(JG) = mchaml
  98.         endif
  99.          enddo
  100.         endif
  101.       enddo
  102.       segadj mlenti,mlent1,mlent2
  103.       JG0 = JG
  104.       segini mlent3,mlent4,mlent5,mlent6,mlent7,mlent8,mlent9,mlen10
  105.       segini mlream
  106.  
  107.       do jjgg = 1,mlent1.lect(/1)
  108.         imodel = mlent1.lect(jjgg)
  109.         itreac = 0
  110.         imade = 0
  111.         idepl = 0
  112.           Xm1 = 0.d0
  113.           mchaml = mlent2.lect(jjgg)
  114.            do ie = 1,ielval(/1)
  115.             if (NOMCHE(IE).eq.'DEFO'.and.mlent3.lect(jjgg).eq.0) then
  116.              MELVA5 = ielval(ie)
  117.              segact melva5
  118.              idepl = melva5.ielche(1,1)
  119.              mlent3.lect(jjgg)= idepl
  120.             endif
  121.             if (NOMCHE(IE).eq.'AMOR') then
  122.              MELVA5 = ielval(ie)
  123.              segact melva5
  124.              xam0 = melva5.velche(1,1)
  125.              mlream.prog(jjgg)= xam0
  126.             endif
  127.        if (cmatee.eq.'STATIQUE') then
  128.             if (NOMCHE(IE).eq.'MADE') then
  129.              MELVA6 = ielval(ie)
  130.              segact melva6
  131.              imade = melva6.ielche(1,1)
  132.               mlent8.lect(jjgg) = melva6.ielche(1,1)
  133.             endif
  134.             if (NOMCHE(IE).eq.'RIDE') then
  135.              MELVA4 = ielval(ie)
  136.              segact melva4
  137.              itreac = melva4.ielche(1,1)
  138.               mlent9.lect(jjgg) = melva4.ielche(1,1)
  139.             endif
  140.        endif
  141.            enddo
  142.  
  143.        if(idepl.le.0) then
  144.          call erreur(26)
  145.          return
  146.        endif
  147.        if (cmatee.eq.'STATIQUE') then
  148.           if (itreac.le.0.or.imade.le.0) then
  149.            call erreur(26)
  150.            return
  151.           endif
  152.        endif
  153.  
  154.            NBNN = 1
  155.            NBELEM = JG
  156.            NBSOUS = 0
  157.            NBREF = 0
  158.  
  159.         if(mlent4.lect(jjgg).eq.0) then
  160.             segini mlreel
  161.           mlent4.lect(jjgg) = mlreel
  162.         endif
  163.         if(mlent5.lect(jjgg).eq.0.and.cmatee.eq.'STATIQUE') then
  164.             segini ipt1
  165.           mlent5.lect(jjgg) = ipt1
  166.            ipt1.ITYPEL = 1
  167.         endif
  168.         if(mlent6.lect(jjgg).eq.0) then
  169.             segini ipt1
  170.           mlent6.lect(jjgg) = ipt1
  171.            ipt1.ITYPEL = 1
  172.         endif
  173.         if(mlent7.lect(jjgg).eq.0) then
  174.             segini mlreel
  175.           mlent7.lect(jjgg) = mlreel
  176.         endif
  177.         if(mlen10.lect(jjgg).eq.0) then
  178.             segini mlreel
  179.           mlen10.lect(jjgg) = mlreel
  180.         endif
  181. * boucle jjgg
  182.       enddo
  183.  
  184.  
  185.       do jjgg = 1,mlent1.lect(/1)
  186.         imodel = mlent1.lect(jjgg)
  187.        if (cmatee.eq.'STATIQUE') then
  188.         itreac = mlent9.lect(jjgg)
  189.         imade = mlent8.lect(jjgg)
  190.  
  191.  
  192.           do jg2 = 1,mlent1.lect(/1)
  193.             imode2 = mlent1.lect(jg2)
  194.        if (jg2.lt.jjgg.and.imode2.cmatee.eq.'STATIQUE') goto 21
  195.              idepl = mlent3.lect(jg2)
  196.           Xk1 = 0.d0
  197.           Xm1 = 0.d0
  198.  
  199.           CALL XTY1(idepl,itreac,iinc,idua,Xk1)
  200.           if (ierr.ne.0) return
  201.           if (ABS(Xk1).gt.dble(xspeti)) then
  202.             mlreel = mlent4.lect(jjgg)
  203.             prog(jg2) = Xk1
  204. * rangement symetrique
  205.             mlreel = mlent4.lect(jg2)
  206.             prog(jjgg) = Xk1
  207.            if (imode2.cmatee.eq.'MODAL')  then
  208. * croisé ALFA - BETA
  209.               ipt1 = mlent5.lect(jjgg)
  210.               ipt1.num(1,jg2) = lect(jg2)
  211.               ipt1 = mlent6.lect(jg2)
  212.               ipt1.num(1,jjgg) = lect(jjgg)
  213.             elseif (imode2.cmatee.eq.'STATIQUE') then
  214.               ipt1 = mlent6.lect(jjgg)
  215.               ipt1.num(1,jg2) = lect(jg2)
  216.               ipt1 = mlent6.lect(jg2)
  217.               ipt1.num(1,jjgg) = lect(jjgg)
  218.             endif
  219.           endif
  220.  
  221.           xm1 = 0.d0
  222.           if(imade.gt.0) CALL XTY1(idepl,imade,iinc,idua,Xm1)
  223.           if (ierr.ne.0) return
  224.           if (ABS(xm1).gt.dble(xspeti)) then
  225.             mlreel = mlent7.lect(jjgg)
  226.             prog(jg2) = Xm1
  227. * rangement symetrique
  228.             mlreel = mlent7.lect(jg2)
  229.             prog(jjgg) = Xm1
  230.            if (ABS(Xk1).le.dble(xspeti)) then
  231.            if (imode2.cmatee.eq.'MODAL')  then
  232. * croisé ALFA - BETA
  233.               ipt1 = mlent5.lect(jjgg)
  234.               ipt1.num(1,jg2) = lect(jg2)
  235.               ipt1 = mlent6.lect(jg2)
  236.               ipt1.num(1,jjgg) = lect(jjgg)
  237.             elseif (imode2.cmatee.eq.'STATIQUE') then
  238.               ipt1 = mlent6.lect(jjgg)
  239.               ipt1.num(1,jg2) = lect(jg2)
  240.               ipt1 = mlent6.lect(jg2)
  241.               ipt1.num(1,jjgg) = lect(jjgg)
  242.             endif
  243.             endif
  244. * amortissement homologue à la masse
  245.             xamo1 = mlream.prog(jg2)
  246.             xamo2 = mlream.prog(jjgg)
  247.         xamo3 = xamo1*xamo2
  248.          if (xamo3.eq.0.) then
  249.           xamo = 0.
  250.          else
  251.           if (jg2.eq.jjgg) then
  252.            xamo = SQRT(ABS(xamo3*Xm1*Xk1))
  253.           else
  254.            xamo = SQRT(ABS(xamo3))*Xm1
  255.           endif
  256.           if (xamo3.lt.0) xamo = xamo * (-1.d0)
  257.           mlreel = mlen10.lect(jjgg)
  258.           prog(jg2) = xamo
  259.           mlreel = mlen10.lect(jg2)
  260.           prog(jjgg) = xamo
  261.          endif
  262. *
  263.           endif
  264.  
  265.  
  266.   21        continue
  267. * boucle jg2
  268.           enddo
  269.        endif
  270. * boucle jjgg
  271.       enddo
  272.  
  273.       do jjgg = 1,mlent5.lect(/1)
  274.         NBELEM = 0
  275.         ipt1 = mlent5.lect(jjgg)
  276.         mlreel = mlent4.lect(jjgg)
  277.        if (mlreel.gt.0) then
  278.         segini,mlree1=mlreel
  279.        else
  280.         mlreel = -1
  281.        endif
  282.         mlree2 = mlent7.lect(jjgg)
  283.        if (mlree2.gt.0) then
  284.         segini,mlree3=mlree2
  285.        else
  286.         mlree2 = -1
  287.        endif
  288. *       write(6,*) jjgg, lect(jjgg),(prog(ii), ii = 1,prog(/1))
  289.         mlree4 = mlen10.lect(jjgg)
  290.        if (mlree4.gt.0) then
  291.         segini,mlree5=mlree4
  292.        else
  293.         mlree4 = -1
  294.        endif
  295.         if (ipt1.gt.0) then
  296.           do jg2 = 1,mlent5.lect(/1)
  297.            if (ipt1.num(1,jg2).ne.0) then
  298.              NBELEM = NBELEM + 1
  299.             if (jg2.eq.NBELEM) then
  300.             else
  301.              ipt1.num(1,NBELEM) = ipt1.num(1,jg2)
  302.              if (mlreel.gt.0) then
  303.               prog(NBELEM) = mlree1.prog(jg2)
  304.              endif
  305.              if (mlree2.gt.0) then
  306.               mlree2.prog(NBELEM) = mlree3.prog(jg2)
  307.              endif
  308.              if (mlree4.gt.0) then
  309.               mlree4.prog(NBELEM) = mlree5.prog(jg2)
  310.              endif
  311.             endif
  312.            endif
  313.           enddo
  314.            segadj ipt1
  315.         endif
  316.         if (NBELEM.eq.0) then
  317.          segsup ipt1
  318.          mlent5.lect(jjgg) = 0
  319.         endif
  320.         ipt1 = mlent6.lect(jjgg)
  321.        JG0 = NBELEM
  322.         NBELEM = 0
  323.         if (ipt1.gt.0) then
  324.           do jg2 = 1,mlent5.lect(/1)
  325. *        write(6,*) ipt1,jg2,ipt1.num(1,jg2)
  326.           if (ipt1.num(1,jg2).ne.0) then
  327.              NBELEM = NBELEM + 1
  328.             if (jg2.eq.NBELEM) then
  329.             else
  330.              ipt1.num(1,NBELEM) = ipt1.num(1,jg2)
  331.             endif
  332. *          write(6,*) jg2, NBELEM, mlree1.prog(jg2)
  333.              if (mlreel.gt.0) then
  334.               prog(JG0+NBELEM) = mlree1.prog(jg2)
  335.              endif
  336.              if (mlree2.gt.0) then
  337.               mlree2.prog(JG0+NBELEM) = mlree3.prog(jg2)
  338.              endif
  339.              if (mlree4.gt.0) then
  340.               mlree4.prog(JG0+NBELEM) = mlree5.prog(jg2)
  341.              endif
  342.            endif
  343.           enddo
  344.            segadj ipt1
  345.         endif
  346.         JG = JG0 + NBELEM
  347.         if (JG.GT.0 ) then
  348.          if (mlreel.gt.0) then
  349.           segadj mlreel
  350.           segdes mlreel
  351.           segsup mlree1
  352.          endif
  353.          if (mlree2.gt.0) then
  354.           segadj mlree2
  355.           segdes mlree2
  356.           segsup mlree3
  357.          endif
  358.          if (mlree4.gt.0) then
  359.           segadj mlree4
  360.           segsup mlree5
  361.           do iam=1,JG
  362.            if (mlree4.prog(iam).ne.0) goto 32
  363.           enddo
  364.           segsup mlree4
  365.           mlen10.lect(jjgg) = 0
  366.           goto 33
  367.  32       segdes mlree4
  368.  33       continue
  369.         endif
  370.         else
  371.          if (mlreel.gt.0) then
  372.           segsup mlreel,mlree1
  373.           mlent4.lect(jjgg) = 0
  374.          endif
  375.          if (mlree2.gt.0) then
  376.           segsup mlree2,mlree3
  377.           mlent7.lect(jjgg) = 0
  378.          endif
  379.          if (mlree4.gt.0) then
  380.           segsup mlree4,mlree5
  381.           mlen10.lect(jjgg) = 0
  382.          endif
  383.         endif
  384.         if (NBELEM.eq.0) then
  385.          segsup ipt1
  386.          mlent6.lect(jjgg) = 0
  387.         endif
  388.       enddo
  389.  
  390.  
  391.             N1PTEL=0
  392.             N1EL  =0
  393.             N2PTEL=1
  394.             N2EL  =1
  395.  
  396.       do jjgg = 1,mlent1.lect(/1)
  397.         imodel = mlent1.lect(jjgg)
  398.           mchaml = mlent2.lect(jjgg)
  399.           dricr = .true.
  400.           dmacr = .true.
  401.           damcr = .true.
  402.           nu2 = ielval(/1)
  403.           nu20 = nu2
  404.            do ie = 1,nu20
  405.  
  406.           if (nomche(ie).eq.'RICR'.and.mlent4.lect(jjgg).gt.0) then
  407.               MELVA5 = ielval(ie)
  408.               segact melva5
  409.               mlree1 = melva5.ielche(1,1)
  410.               mlreel = mlent4.lect(jjgg)
  411.               segact mlreel,mlree1
  412.               do 211 ig = 1,prog(/1)
  413.                 do ig1 = 1,mlree1.prog(/1)
  414.           if(ABS(prog(ig) - mlree1.prog(ig1)).lt.
  415.      &dble(xspeti)*ABS(mlree1.prog(ig1))) goto 211
  416.                 enddo
  417. * non concordance données utilisateurs / calcul
  418.                 call erreur(26)
  419.                 return
  420.  211          continue
  421.               dricr = .false.
  422. * on ne pousse pas trop la verif
  423.           endif
  424.           if (nomche(ie).eq.'MACR'.and.mlent7.lect(jjgg).gt.0) then
  425.               MELVA5 = ielval(ie)
  426.               segact melva5
  427.               mlree1 = melva5.ielche(1,1)
  428.               mlreel = mlent7.lect(jjgg)
  429.               segact mlreel,mlree1
  430.               do 311 ig = 1,prog(/1)
  431.                 do ig1 = 1,mlree1.prog(/1)
  432.           if(ABS(prog(ig) - mlree1.prog(ig1)).lt.
  433.      &dble(xspeti)*ABS(mlree1.prog(ig1))) goto 311
  434.                 enddo
  435. * non concordance données utilisateurs / calcul
  436.                 call erreur(26)
  437.                 return
  438.  311          continue
  439.               dmacr = .false.
  440. * on ne pousse pas trop la verif
  441.           endif
  442.           if (nomche(ie).eq.'AMCR'.and.mlen10.lect(jjgg).gt.0) then
  443.               MELVA5 = ielval(ie)
  444.               segact melva5
  445.               mlree1 = melva5.ielche(1,1)
  446.               mlreel = mlen10.lect(jjgg)
  447.               segact mlreel,mlree1
  448.               do 411 ig = 1,prog(/1)
  449.                 do ig1 = 1,mlree1.prog(/1)
  450.           if(ABS(prog(ig) - mlree1.prog(ig1)).lt.
  451.      &dble(xspeti)*ABS(mlree1.prog(ig1))) goto 411
  452.                 enddo
  453. * non concordance données utilisateurs / calcul
  454.                 call erreur(26)
  455.                 return
  456.  411          continue
  457.               damcr = .false.
  458. * on ne pousse pas trop la verif
  459.           endif
  460.  
  461.            enddo
  462.  
  463.           n2 = nu2 + 5
  464.           segadj mchaml
  465.  
  466.         if(mlent4.lect(jjgg).gt.0.and.dricr) then
  467.           nu2 = nu2 + 1
  468.           typche(nu2)='POINTEURLISTREEL'
  469.           nomche(nu2)='RICR'
  470.             SEGINI,MELVAL
  471.             IELVAL(nu2) = MELVAL
  472.             ielche(1,1) = mlent4.lect(jjgg)
  473.         endif
  474.         if(mlent5.lect(jjgg).gt.0.and.(dmacr.or.dricr)) then
  475.           nu2 = nu2 + 1
  476.           typche(nu2)='POINTEURMAILLAGE'
  477.           nomche(nu2)='MAIA'
  478.             SEGINI,MELVAL
  479.             IELVAL(nu2) = MELVAL
  480.             ielche(1,1) = mlent5.lect(jjgg)
  481.         endif
  482.         if(mlent6.lect(jjgg).gt.0.and.(dmacr.or.dricr)) then
  483.           nu2 = nu2 + 1
  484.           typche(nu2)='POINTEURMAILLAGE'
  485.           nomche(nu2)='MAIB'
  486.             SEGINI,MELVAL
  487.             IELVAL(nu2) = MELVAL
  488.             ielche(1,1) = mlent6.lect(jjgg)
  489.         endif
  490.         if(mlent7.lect(jjgg).gt.0.and.dmacr) then
  491.           nu2 = nu2 + 1
  492.           typche(nu2)='POINTEURLISTREEL'
  493.           nomche(nu2)='MACR'
  494.             SEGINI,MELVAL
  495.             IELVAL(nu2) = MELVAL
  496.             ielche(1,1) = mlent7.lect(jjgg)
  497.         endif
  498.         if(mlen10.lect(jjgg).gt.0.and.damcr) then
  499.           nu2 = nu2 + 1
  500.           typche(nu2)='POINTEURLISTREEL'
  501.           nomche(nu2)='AMCR'
  502.             SEGINI,MELVAL
  503.             IELVAL(nu2) = MELVAL
  504.             ielche(1,1) = mlen10.lect(jjgg)
  505.         endif
  506.  
  507.         n2 = nu2
  508.         segadj mchaml
  509.       enddo
  510.  
  511.  
  512.        mlmots = idua
  513.        segsup mlmots
  514.        mlmots = iinc
  515.        segsup mlmots
  516. *
  517.       do im = 1,kmodel(/1)
  518.         imodel = kmodel(im)
  519.         if (cmatee.eq.'STATIQUE'.OR.cmatee.eq.'MODAL') then
  520.          do isous = 1,imache(/1)
  521.         if (imache(isous).eq.imamod.and.conche(isous).eq.conmod) then
  522.           mchaml = ichaml(isous)
  523.           n2 = ielval(/1)
  524.           do in = 1,n2
  525.            melval = ielval(in)
  526.             if(nomche(in).eq.'MAIA') then
  527.                ipt1 = ielche(1,1)
  528.             endif
  529.             if(nomche(in).eq.'MAIB') then
  530.                ipt1 = ielche(1,1)
  531.             endif
  532.           enddo
  533.         endif
  534.          enddo
  535.        endif
  536.       enddo
  537. *
  538.        segsup mlenti,mlent1,mlent2,mlent3,mlent4,mlent5,mlent6,mlent7
  539.        segsup mlent8,mlent9,mlen10
  540.        segsup mlream
  541.       END
  542.  
  543.  
  544.  
  545.  
  546.  

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