kirkaldykinetics.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	kirkaldykinetics (nel0, time, tempel, tempmin, ae1, ae3, bs, ms, fcfer, fcper, fcbai, fgrain, frac1, frac2, frac3, frac4, frac5, x2, x3, x4, x5, qr2, qr3, qr4, kper, kbain, alpha, xeq2, xeq4, xgama, totfrac, timestep, nicool, index, theaccfact)

Function/Subroutine Documentation

kirkaldykinetics()

subroutine kirkaldykinetics	(	integer	nel0,
			time,
			tempel,
			tempmin,
			ae1,
			ae3,
			bs,
			ms,
			fcfer,
			fcper,
			fcbai,
			fgrain,
			frac1,
			frac2,
			frac3,
			frac4,
			frac5,
			x2,
			x3,
			x4,
			x5,
			qr2,
			qr3,
			qr4,
			kper,
			kbain,
			alpha,
			xeq2,
			xeq4,
			xgama,
			totfrac,
			timestep,
		integer	nicool,
		integer, dimension(nicool)	index,
		intent(in)	theaccfact )

Definition at line 30 of file kirkaldykinetics.F.

     
#include      "implicit_f.inc"
C-----------------------------------------------
C   I N P U T   A r g u m e n t s
C-----------------------------------------------
        INTEGER NEL0,NICOOL,INDEX(NICOOL)
        my_real ,intent(in) :: theaccfact
        my_real
     .        tempel(nel0),tempmin(nel0),timestep
        my_real
     .        time,alpha,tref,ae1,ae3,bs,ms,gsize,nu,fcfer,fcper,fcbai,
     .        fgrain,qr2,qr3,qr4,kper,kbain,xeq2,xeq4,yx
C-----------------------------------------------
        my_real
     .        frac1(nel0),frac2(nel0),frac3(nel0),frac4(nel0),frac5(nel0)
        my_real
     .        x2(nel0),x3(nel0),x4(nel0),x5(nel0),totfrac(nel0),xgama(nel0)
        my_real
     .        ftemp,ux,vx,udot,vdot,f,const,fdot,x2old(nel0),
     .        x3old(nel0),x4old(nel0),gx,gdot,dti
        INTEGER I,K,J
    
      ! SUM OF FRAC1+FRAC2+FRAC3+FRAC4+FRAC5=1--------
      dti= one/max(timestep*theaccfact,em10)
      DO j=1,nicool ! NEL0
 
       i=index(j)
       ! CHECK TEMPERATURE FOR CORRESPONDING PHASE CHANGE
       IF(totfrac(i)<one.AND.tempel(i)<tempmin(i))THEN
       IF (tempel(i)<ae3)THEN 
        IF(tempel(i)>ae1)THEN
          IF(x2(i)<0.999)THEN
           ! FERRITE FORMATION X2
           !X2OLD(I)= FRAC2(I)/XEQ2
           x2old(i)=x2(i) 
           IF(x2(i)==zero)x2(i)=em10
           ftemp=exp(-qr2/tempel(i))*abs(tempel(i)-ae3)**3
           const=ftemp*fgrain*fcfer
           DO k=1,3
             yx= (one-x2(i))/max(em10,x2(i))
             ux=x2(i)**(two_third*(one-x2(i)))
             vx=(one-x2(i))**(two_third*x2(i))
             f =(x2(i)-x2old(i))*dti-const*ux*vx
             fdot=dti-const*two_third*ux*vx*(yx-one/yx+log(yx))
             x2(i)=max(em20,x2(i)-f/fdot)
           ENDDO
           frac2(i)=x2(i)*xeq2
           frac1(i)=one-frac2(i)-frac3(i)-frac4(i)-frac5(i)
          ENDIF
c---------------------------------          
        ELSEIF(tempel(i)>bs)THEN           
         IF(x3(i)<0.999)THEN
            ! PEARLITE X3                                       
            x3old(i)= x3(i)  !FRAC3(I)/(ONE-XEQ2) !!
            IF(x3(i)==zero)x3(i)=em10
            ftemp=6.17*exp(-qr3/tempel(i))*abs(tempel(i)-ae1)**3
            const=ftemp*fgrain*fcper !!! adjusted
            DO k=1,3
              yx= (one-x3(i))/max(em10,x3(i))
              ux=x3(i)**(two_third*(one-x3(i)))
              vx=(one-x3(i))**(two_third*x3(i))
              f =(x3(i)-x3old(i))*dti-const*ux*vx
              fdot=dti-const*two_third*ux*vx*(yx-one/yx+log(yx))
              x3(i)=max(em20,x3(i)-f/fdot)
            ENDDO       
            frac3(i)=x3(i)*(one-xeq2)
            frac1(i)=one-frac2(i)-frac3(i)-frac4(i)-frac5(i)
          ENDIF
c---------------------------------                    
        ELSEIF(tempel(i)>ms)THEN
          IF(x4(i)<0.999)THEN
           ! BAINITE  FORMATION 
            x4old(i) =  x4(i) !FRAC4(I) = X4(I)
            IF(x4(i) == zero) x4(i) = x3(i)  !FRAC3(I)/(ONE-XEQ2) 
            ! INITIALISE AU TAUX DE PERLITE
            ftemp=exp(-qr4/tempel(i)) *(tempel(i)-bs)**2
            const=ftemp*fgrain*fcbai
            DO k=1,4
              yx= (one-x4(i))/max(em10,x4(i))
              ux=x4(i)**(two_third*(one-x4(i)))
              vx=(one-x4(i))**(two_third*x4(i)) 
              gx=exp(kbain*x4(i)*x4(i))
              IF (gx<zero)gx=one
              f =(x4(i)-x4old(i))*dti-const*ux*vx/gx
              udot=two_third*ux*((one-x4(i))/max(em10,x4(i))-
     .           log(max(em10,x4(i))))
              vdot=two_third*vx*(log(one-x4(i))-x4(i)/(one-x4(i)))
              gdot=two*kbain*x4(i)*gx
              fdot=dti-const*((udot*vx+vdot*ux)*gx-ux*vx*gdot)/gx/gx
              x4(i)=max(em20,x4(i)-f/fdot)
           ENDDO
           frac4(i)=x4(i)
           frac1(i)=one-frac2(i)-frac3(i)-frac4(i)-frac5(i)
          ENDIF
            
        ELSE           
          ! MARTENSITE  FORMATION X5
          IF (frac5(i)==zero)xgama(i)= frac1(i) 
          frac5(i)=xgama(i)*(one-exp(-alpha*(ms-tempel(i))))
          frac1(i)=one-frac2(i)-frac3(i)-frac4(i)-frac5(i)
        ENDIF
       ENDIF   
       ENDIF   
      ENDDO    
     
      RETURN