Télécharger la plaquette Cast3M


fr en

Télécharger fatig2.eso

Retour à la liste

Numérotation des lignes : 

fatig2

  1. C FATIG2    SOURCE    CB215821  24/04/12    21:15:55     11897          
  2.       SUBROUTINE FATIG2(ITCONT,ITTEMP,IPMODE,IPCAR,ICF1,xre1,xre2,
  3.      &ICLE,NCLE,CLE,ZECRIT,ICHOUT)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMMODEL
  10. -INC SMCHAML
  11. -INC SMELEME
  12. -INC SMEVOLL
  13. -INC SMLREEL
  14.       PARAMETER (MCRIT=5)
  15.       SEGMENT,MLCARF
  16.         integer lcarfa(2*MCRIT,N1)
  17.       ENDSEGMENT
  18.       SEGMENT,MCYSIG
  19.         integer lcysig(nbrobl,ncycl)
  20.         real*8 sigcyc(nbrobl,ncycl),pcyc(ncycl)
  21.       ENDSEGMENT
  22.       SEGMENT,MRECYC
  23.          real*8 ycyc(ncycl)
  24.       ENDSEGMENT
  25.       SEGMENT,MDEVCY
  26.          real*8 sdcyc(nbrobl-1,ncycl)
  27.       ENDSEGMENT
  28.       SEGMENT,MDEVSI
  29.          real*8 sd(nbrobl)
  30.       ENDSEGMENT
  31.       LOGICAL LOG0,LOG1,dcarf1,dcarf2,d_cle
  32.       CHARACTER*4 COFA(2*MCRIT),CLE(NCLE)
  33.       real*8 cofa1(NCLE-1),cofa2(NCLE-1)
  34.       DATA COFA/'ADVK','BDVK','APAP','BPAP','ASIN','BSIN','ACRO','BCRO',
  35.      &'A_DC','B_DC'/
  36.  
  37.  
  38.  
  39.       SQ2 = dsqrt(2.d0)
  40.       SQ3S2 = dsqrt(1.5D0)
  41.       SQ3 = dsqrt(3.d0)
  42.  
  43.  
  44.       mmodel = ipmode
  45.       segact mmodel
  46.       n1 = kmodel(/1)
  47.       n2 = 0
  48.       l1 = 16
  49.       n3 = 6
  50.       segini mchel2
  51.        mchel2.titche(1:8) = 'FATIGUE '
  52.       if (ICF1.gt.0) then
  53.         mchel1= ICF1
  54.         segact mchel1
  55. *       mchel2.titche(9:16) = mchel1.titche(9:16)
  56.       endif
  57.       segini mlcarf
  58.  
  59.       if(icle.ge.2.and.icle.le.6) then 
  60.          n=0
  61.          segini mevoll
  62.          IEVTEX = 'EVOLUTION VIDE'
  63.          mevnul = mevoll
  64.          segdes mevoll
  65.       endif
  66.  
  67.  
  68.  
  69.       do ik = 1,n1
  70.         imodel = kmodel(ik)
  71.         segact imodel
  72.         mchel2.conche(ik) = conmod
  73.         mchel2.imache(ik) = imamod
  74.         mchel2.ifoche = ifour
  75.         mchel2.infche(ik,4) = infmod(7)
  76.         mchel2.infche(ik,6) = 5
  77.  
  78.         if(ICF1.gt.0) then
  79.         do ic = 1,mchel1.imache(/1)
  80.          if (mchel1.imache(ic).eq.imamod) then
  81.            mchaml = mchel1.ichaml(ic) 
  82.            segact mchaml
  83.            n2 = nomche(/2)     
  84.            do inom = 1,n2
  85. * controler les noms des caracteristiques du critere             
  86.              melval = ielval(inom)
  87.              if(icle.le.6) then
  88.                do jcr = 1,mcrit
  89.               if(nomche(inom)(1:4).eq.cofa(2*jcr-1)(1:4)) then
  90.                              segact melval
  91.                       lcarfa(2*jcr-1,ik) = melval
  92.               endif
  93.               if(nomche(inom)(1:4).eq.cofa(2*jcr)(1:4)) then
  94.                              segact melval
  95.                       lcarfa(2*jcr,ik) = melval
  96.               endif
  97.                enddo
  98.              endif             
  99.  
  100.            enddo
  101.            segdes mchaml
  102.          endif 
  103.         enddo
  104. * verification        
  105.           d_cle = .true.
  106.           do jcr = 1,mcrit
  107.             dcarf1 = .false.
  108.             dcarf2 = .false.
  109.             if (lcarfa(2*jcr-1,ik).gt.0) dcarf1 = .true. 
  110.             if (lcarfa(2*jcr,ik).gt.0)   dcarf2 = .true.
  111.             if (icle.eq.1) then
  112.              d_cle = dcarf1 .and. dcarf2 .and. d_cle
  113.             else if (icle.ge.2.and.icle.le.6.and.jcr.eq.icle-1) then
  114.               d_cle = dcarf1 .and. dcarf2
  115.             endif
  116.           enddo        
  117.  
  118.           if (.not.d_cle) then
  119.             call erreur(472)
  120.             return
  121.           endif
  122.         endif
  123.  
  124. * sorties
  125.          if(icle.eq.1) then
  126.            n2 = ncle - 1
  127.          elseif(icle.ge.2.and.icle.le.6) then
  128.            n2 = 2
  129.          else 
  130.            n2 = 1
  131.          endif
  132.            segini mchaml
  133.            mchel2.ichaml(ik) = mchaml
  134.          meleme = imamod
  135.          segact meleme
  136.          nbelem = num(/2)
  137.          nbgs = infele(4)
  138.            n1ptel= nbgs
  139.            n1el = nbelem
  140.            n2ptel = 0
  141.            n2el = 0
  142.          if(icle.eq.1) then
  143.            do je = 1,n2
  144.             segini melval
  145.             ielval(je) = melval
  146.             nomche(je) = cle(je+1)
  147.             typche(je) = 'REAL*8'
  148.            enddo
  149.          elseif(icle.gt.1) then
  150.           segini melval
  151.           ielval(1) = melval
  152.           nomche(1) = cle(icle)
  153.            typche(1) = 'REAL*8'
  154.          endif
  155.  
  156.          if(icle.ge.2.and.icle.le.6) then 
  157.            n2ptel = nbgs
  158.            n2el = nbelem
  159.            n1ptel = 0
  160.            n1el = 0
  161.            segini melval
  162.          ielval(2) = melval
  163.          nomche(2) = 'PTAU'
  164.          typche(2) = 'POINTEUREVOLUTIO'
  165.               segini kevoll
  166.               ielche(1,1) = kevoll
  167.               kevdvk = kevoll
  168.               jg = 2
  169.               segini mlreel
  170.               iprogx = mlreel
  171.               segini mlreel
  172.               iprogy = mlreel
  173.               NUMEVX = 4
  174.               NUMEVY='REEL'
  175.               NOMEVX = 'P'
  176.               NOMEVY = 'TAU'
  177.               TYPX = 'LISTREEL'
  178.               TYPY = 'LISTREEL'
  179.          endif
  180.  
  181.       enddo
  182.  
  183.       mtable = ITCONT
  184.       mtab1 = ittemp
  185.  
  186.       i0 = 0 
  187.       X0 = 0.D0
  188.       LOG0 = .TRUE.
  189.       ip0 = 0
  190.       I1 = 0
  191.       x1 = 0.d0
  192.       LOG1 = .TRUE.
  193.       IP1 = 0
  194.  
  195.       CALL DIMEN7 (ittemp,ntemps)
  196.       do jr =1,2
  197.         if(jr.eq.1) xreu = xre1
  198.         if(jr.eq.2) xreu = xre2
  199. * presuppose indice 0 t=0.
  200.       if(xreu.eq.0.d0) then
  201.        intc = 0
  202.       elseif(xreu.gt.0.d0) then
  203.          xd1 = xreu
  204.        do ind1 = 1,ntemps
  205.            I0 = ind1 - 1
  206.            CALL ACCTAB(ITTEMP,'ENTIER',I0,X0,' ',LOG0,IP0,
  207.      &                       'FLOTTANT',I1,X1,' ',LOG1,IP1)
  208.           if (ierr.ne.0) return
  209.          xu = xreu - x1
  210.          if (xu.gt.0.d0.and.xu.le.xd1) then
  211.            xd1 = xu
  212.          else if (dabs(xu).le.xd1) then
  213.            goto 14
  214.          else
  215.            I0 = I0 - 1
  216.            goto 14
  217.          endif
  218.        enddo        
  219.  14    continue 
  220.        intc = I0
  221.       endif
  222.  
  223.         if(jr.eq.1) i0temd = intc
  224.         if(jr.eq.2) then
  225.          if(xre2.gt.0) then
  226.            i0temf = intc
  227.          else
  228.            i0temf = ntemps -1
  229.          endif
  230.         endif
  231.       enddo
  232.  
  233.       DO ik = 1,kmodel(/1)
  234.          isk = 0
  235.          imodel = kmodel(ik)
  236.  
  237. * sorties 
  238.          mcham2 = mchel2.ichaml(ik)
  239.          nomid = lnomid(4)
  240.          segact nomid
  241.          nbrobl = lesobl(/2)
  242.          segini mdevsi
  243.  
  244.          ncycl = i0temf - i0temd + 1
  245.          segini mcysig
  246.          segini MDEVCY
  247.          segini mrecyc
  248.  
  249.         ktem = 0
  250.         DO I0 = i0temd,i0temf
  251.           ktem = ktem + 1
  252.            CALL ACCTAB(ITCONT,'ENTIER',I0,X0,' ',LOG0,IP0,
  253.      &                       'MCHAML ',I1,X1,' ',LOG1,IP1)
  254.          MCHELM = ip1
  255.          SEGACT MCHELM 
  256.  
  257.          do is = 1,imache(/1)
  258.            if(imamod.eq.imache(is)) isk = is
  259.          enddo
  260.          if (isk.eq.0) then
  261.            call erreur(472)
  262.            return
  263.          endif
  264.          mchaml = ichaml(isk) 
  265.          segact mchaml
  266. * controle des composantes de contraintes
  267.          n2 = nomche(/2)
  268. * on travaille a priori avec les composantes obligatoires
  269.          do iobl = 1, nbrobl
  270.           do imch = 1,nomche(/2)
  271.             if(lesobl(iobl).eq.nomche(imch)) then
  272.               lcysig(iobl,ktem) = ielval(imch)
  273.               melval = ielval(imch)
  274.               segact melval
  275.             endif
  276.           enddo
  277.          enddo
  278.  
  279.          segdes mchaml
  280.          SEGDES MCHELM
  281.         ENDDO
  282.  
  283.          meleme = imamod
  284.          nbelem = num(/2)
  285.          nbgs = infele(4)
  286.          nstrs = infele(16)
  287.          mfr = infele(13)
  288.          DO ib = 1,nbelem
  289.           do igau = 1,nbgs
  290.  
  291. * caracteristiques critere
  292.             IF(ib.eq.1.and.igau.eq.1) THEN
  293. * kich : d un point de vue pratique on attend des constantes
  294.             if(icle.eq.1) then
  295.               do jcr = 1,mcrit
  296.                melva1 = lcarfa(2*jcr-1,ik)
  297.                IGMN=MIN(IGAU,melva1.VELCHE(/1))
  298.                IBMN=MIN(IB  ,melva1.VELCHE(/2))
  299.                cofa1(jcr) = melva1.velche(igmn,ibmn)*(-1)
  300.  
  301.                melva2 = lcarfa(2*jcr,ik)
  302.                IGMN=MIN(IGAU,melva2.VELCHE(/1))
  303.                IBMN=MIN(IB  ,melva2.VELCHE(/2))
  304.                cofa2(jcr) = melva2.velche(igmn,ibmn)
  305.               enddo
  306.  
  307.             elseif(icle.ge.2.and.icle.le.6) then
  308.                melva1 = lcarfa(2*icle-3,ik)
  309.                IGMN=MIN(IGAU,melva1.VELCHE(/1))
  310.                IBMN=MIN(IB  ,melva1.VELCHE(/2))
  311.                cofa1(icle-1) = melva1.velche(igmn,ibmn)*(-1)
  312.  
  313.                melva2 = lcarfa(2*icle-2,ik)
  314.                IGMN=MIN(IGAU,melva2.VELCHE(/1))
  315.                IBMN=MIN(IB  ,melva2.VELCHE(/2))
  316.                cofa2(icle-1) = melva2.velche(igmn,ibmn)
  317.             endif
  318.              cofa1(6) = 0.d0
  319.              cofa2(6) = 0.d0
  320.             ENDIF
  321.  
  322. * trajet de chargement
  323.             DO icyc = 1,ncycl 
  324.  
  325.               do iobl = 1,nbrobl
  326.             MELVAL = lcysig(iobl,icyc)
  327.           if (melval.gt.0) then
  328.             IGMN=MIN(IGAU,VELCHE(/1))
  329.             IBMN=MIN(IB  ,VELCHE(/2))
  330.             sd(iobl)=VELCHE(IGMN,IBMN)
  331.             sigcyc(iobl,icyc) = VELCHE(IGMN,IBMN)
  332.           else 
  333.             sd(iobl) = 0.d0
  334.             sigcyc(iobl,icyc) = 0.d0
  335.           endif
  336.               enddo
  337.  
  338.       PCYC(ICYC) = (SIGCYC(1,ICYC)+SIGCYC(2,ICYC)+SIGCYC(3,ICYC))/3
  339.          if(ib.eq.1.and.igau.eq.1.and.icyc.eq.1) then
  340.            pcymax = pcyc(1)
  341.            pcymin = pcyc(1)
  342.          else
  343.            pcymax = max(pcymax,pcyc(icyc))
  344.            pcymin = min(pcymin,pcyc(icyc))
  345.          endif
  346.        SDCYC(1,icyc)   = (SIGCYC(1,icyc)-SIGCYC(2,icyc))/SQ2
  347.        SDCYC(2,icyc)=(SIGCYC(1,icyc)+SIGCYC(2,icyc)-2.*PCYC(icyc))*SQ3S2
  348.        SDCYC(3,icyc)   =  SIGCYC(4,icyc)
  349.        if(nbrobl.gt.4) then
  350.          SDCYC(4,icyc)   =  SIGCYC(5,icyc)
  351.          SDCYC(5,icyc)   =  SIGCYC(6,icyc)
  352.        endif
  353.  
  354.       if (igau.eq.6) then
  355. *       write(6,*) 'f2-6-icyc',icyc,(sigcyc(iu,icyc),iu = 1,5)
  356.       endif
  357.  
  358. * boucle icyc
  359.             ENDDO
  360.  
  361.       if(nbrobl.le.1) then
  362. *       write(6,*) 'DVPA2, manquent composantes contraintes'
  363.        interr(1) = imodel
  364.        interr(2) = imamod
  365.        call erreur(973)
  366.        return
  367.       endif
  368.  
  369.  
  370. * calculs criteres
  371.              if(icle.eq.1) then
  372.                do jl = 2,ncle
  373.       call FATIG3(sigcyc,pcyc,ycyc,nbrobl,ncycl,jl,
  374.      & cofa1(jl-1),cofa2(jl-1),ycri,SDCYC,ib,igau)
  375.           melval = mcham2.ielval(jl-1)
  376.           velche(igau,ib) = ycri
  377.                enddo
  378.              else
  379.       call FATIG3(sigcyc,pcyc,ycyc,nbrobl,ncycl,icle,
  380.      &cofa1(icle-1),cofa2(icle-1),ycri,SDCYC,ib,igau)
  381.           melval = mcham2.ielval(1)
  382.           velche(igau,ib) = ycri
  383.              endif
  384.  
  385. * sorties
  386.        IF (ICLE.GT.1.and.ICLE.LT.7) THEN
  387.  
  388.         if (ib.eq.1.and.igau.eq.1) then
  389.           melval = mcham2.ielval(2)
  390.           kevdvk = ielche(1,1)
  391.         endif
  392.  
  393.         if (ycri.gt.zecrit) then
  394.             melval = mcham2.ielval(2)
  395.               n = 2
  396.               segini mevoll
  397.               ielche(igau,ib) = mevoll
  398.               ITYEVO='REEL'
  399.               IEVTEX='CYCLE P/TAU '
  400.               IEVTEX(13:20) = mchel1.titche(9:16)
  401.               segini kevoll
  402.               ievoll(1) = kevoll
  403.               ievoll(2) = kevdvk
  404.           if(icle.eq.2.or.icle.eq.3) then
  405.             jg = ncycl
  406.           else
  407.             jg = 1
  408.           endif
  409.               segini mlreel
  410.               iprogx = mlreel
  411.               segini mlree1
  412.               iprogy = mlree1
  413.               TYPX = 'LISTREEL'
  414.               TYPY = 'LISTREEL'
  415.  
  416.           if(icle.eq.2.or.icle.eq.3) then
  417. c       Critère de Dang Van et Papadopoulos
  418.               NUMEVY='REEL'
  419.               NOMEVX = 'P'
  420.               NOMEVY = 'TAU'
  421.             do jcyc = 1,ncycl
  422.              mlree1.prog(jcyc) = ycyc(jcyc)
  423.              prog(jcyc) = pcyc(jcyc)
  424.             enddo
  425.           else
  426.             mlree1.prog(1) = ycyc(2)
  427.             prog(1) = ycyc(1)
  428.             if(icle.eq.4) then
  429. c       Critère de Sines
  430.               NUMEVY='REEL'
  431.               NOMEVX = 'P moyenne'
  432.               NOMEVY = 'sqrt(J2),a'
  433.             elseif(icle.eq.5) then
  434. c       Critère de Crossland
  435.               NUMEVY='REEL'
  436.               NOMEVX = 'P max'
  437.               NOMEVY = 'sqrt(J2),a'
  438.             elseif(icle.eq.6) then
  439. c       Critère de Deperrois
  440.               NUMEVY='REEL'
  441.               NOMEVX = 'P max'
  442.               NOMEVY = 'A(psi)'
  443.             endif
  444.           endif
  445.  
  446.           segdes mlreel,mlree1
  447.           segdes kevoll
  448.           segdes mevoll
  449.  
  450.          else 
  451.            melval = mcham2.ielval(2)
  452.            ielche(igau,ib) = mevnul
  453.          endif
  454.         ENDIF
  455.  
  456. * boucle igau
  457.           enddo
  458. * boucle ib
  459.          ENDDO
  460.  
  461.  
  462.          if(icle.ge.2.and.icle.le.6) then
  463.           kevoll = kevdvk
  464.           mlreel = iprogx
  465.           mlree1 = iprogy
  466.            if (abs(pcymin).le.1.e-6.and.abs(pcymax).le.1.e-6) then
  467.              pcymin = -1.D0
  468.              pcymax = 1.D0
  469.            elseif (abs((pcymax - pcymin)/pcymax).le.0.1) then
  470.              pcymin = pcymin - 0.1*abs(pcymax)
  471.              pcymax = pcymax + 0.1*abs(pcymax)
  472.            endif
  473.            prog(1) = pcymin
  474.            prog(2) = pcymax
  475. *           WRITE(6,*) 'MINMAX',PCYMIN,PCYMAX
  476.            mlree1.prog(1) = cofa1(icle-1)*(-1)*pcymin + cofa2(icle-1)
  477.            mlree1.prog(2) = cofa1(icle-1)*(-1)*pcymax + cofa2(icle-1)
  478.           segdes mlreel,mlree1
  479.           segdes kevoll
  480.          endif
  481.  
  482.          do lt = 1,ktem
  483.           do iobl = 1, nbrobl
  484.            melval = lcysig(iobl,lt)
  485.            if(melval.gt.0) segdes melval
  486.           enddo
  487.          enddo
  488.          do jcr = 1,mcrit
  489.            melva1 = lcarfa(2*jcr-1,ik)
  490.            if (melva1.gt.0) segdes melva1
  491.            melva2 = lcarfa(2*jcr,ik)
  492.            if (melva2.gt.0) segdes melva2
  493.          enddo
  494.          segsup mdevsi
  495.          segsup mcysig
  496.          segsup mrecyc
  497.         segdes imodel
  498.         mchaml = mchel2.ichaml(ik)
  499.         if(icle.eq.1) then
  500.          do jf = 1,ncle-1
  501.            melval = ielval(jf)
  502.            segdes melval
  503.          enddo
  504.         elseif(icle.ge.2.and.icle.le.6) then
  505.          do jf = 1,2
  506.            melval = ielval(jf)
  507.            segdes melval
  508.          enddo
  509.         endif
  510.         segdes mchaml
  511. * boucle ik
  512.       ENDDO
  513.  
  514.        if(ICF1.gt.0) segdes mchel1
  515.       segdes mmodel,mchel2
  516.       ICHOUT = MCHEL2
  517.       RETURN
  518.       END
  519.  
  520.  
  521.  
  522.  
  523.  

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