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

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