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

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