API tools faq
paste
Advertisement
rgedies

transformation

rgedies
May 26th, 2023 (edited)
515
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Fortran 8.06 KB | Source Code | 0 0
raw download clone embed print report
  1.     SUBROUTINE TRANSFORMATION(TIME1,TEMP1,TIME2,TEMP2,DELTAT,PEAK,VR,NNODE)
  2.     IMPLICIT REAL*8 (A-H,O-Z)
  3.  
  4.     PARAMETER(NN=10000,ZERO=1.0D-6,GA0=0.005D0)
  5.     LOGICAl COOLING,HEATING
  6.     INTEGER I,K,NSTEPS
  7.     REAL*8 DELTAT,XTERM,DIFF
  8.     REAL*8 TIME1,TIME2
  9.     dimension TEMP1(NN),TEMP2(NN),PEAK(NN),VR(NN),XCOMPOS(13)
  10.     real*8 C,Mn,Si,Ni,Cr,Mo,Cu,W,V,Nb,Ti,Al,N
  11.     REAL*8 C2,Mn2,Si2,Ni2,Cr2,Mo2,Cu2,W2,V2,Nb2,Ti2,Al2,N2
  12.     real*8 AC1,AC3,TDISS,AE4,AE3,AE1,TBS,TMS,as1,Tliquid,Tsolid
  13.     real*8 xfe,xpe,fc,pc,bc
  14.     real*8 AC1_1,AC3_1,TDISS1,AE4_1,AE3_1,AE1_1,TBS1,TMS1,as1_1 &   ,Tliquid1,Tsolid1
  15.     real*8 AC1_2,AC3_2,TDISS2,AE4_2,AE3_2,AE1_2,TBS2,TMS2,as1_2 &   ,Tliquid2,Tsolid2
  16.     real*8 XFE1,XPE1,XFE2,XPE2
  17.     REAL*8 XA(NN),XF(NN),XP(NN),XB(NN),XM(NN),GS(NN),G(NN),HV(NN),XL(NN)
  18.     real*8 fc1,pc1,bc1,FC2,PC2,BC2
  19.     real*8 GS0,G0,hv0,gsmax
  20.     dimension nodeflag(nn)
  21.  
  22.     COMMON/COMP/C,Mn,Si,Ni,Cr,Mo,Cu,W,V,Nb,Ti,Al,N
  23.     COMMON/COMP2/C2,Mn2,Si2,Ni2,Cr2,Mo2,Cu2,W2,V2,Nb2,Ti2,Al2,N2
  24.     COMMON/TEMPS/AC1_1,AC3_1,TDISS1,AE4_1,AE3_1,AE1_1,TBS1,TMS1,as1_1&  ,Tliquid1,Tsolid1
  25.     COMMON/TEMPS2/AC1_2,AC3_2,TDISS2,AE4_2,AE3_2,AE1_2,TBS2,TMS2,as1_2& ,Tliquid2,Tsolid2
  26.     COMMON/STRUCT/XA,XF,XP,XB,XM,GS,G,HV,XL
  27.     COMMON/KCONST/fc1,pc1,bc1
  28.     COMMON/KCONST2/fc2,pc2,bc2
  29.     COMMON/BASELINE/XFE1,XPE1
  30.     COMMON/BASELINE2/XFE2,XPE2
  31.     common/nodetype/nodeflag
  32.       COMMON/KINI/GS0,G0,hv0,gsmax
  33.     include 'common.f'
  34.  
  35.     DO 100 I=1,NNODE,1
  36.        if ( nodeflag(i) .eq. 1 ) then
  37.             fc = fc1
  38.             pc = pc1
  39.             bc = bc1
  40.             ac1=ac1_1
  41.             ac3=ac3_1
  42.             tdiss = tdiss1
  43.             ae4 = ae4_1
  44.             ae3 = ae3_1
  45.             ae1 = ae1_1
  46.             tbs = tbs1
  47.             tms = tms1
  48.             as1 = as1_1
  49.             tliquid = tliquid1
  50.             tsolid = tsolid1
  51.             xfe = xfe1
  52.             xpe = xpe1
  53.             XCOMPOS(1) = C
  54.             XCOMPOS(2) = Mn
  55.             XCOMPOS(3) = Si
  56.             XCOMPOS(4) = Ni
  57.             XCOMPOS(5) = Cr
  58.             XCOMPOS(6) = Mo
  59.             XCOMPOS(7) = Cu
  60.             XCOMPOS(8) = W
  61.             XCOMPOS(9) = V
  62.             XCOMPOS(10) = Nb
  63.             XCOMPOS(11) = Ti
  64.             XCOMPOS(12) = Al
  65.             XCOMPOS(13) = N
  66.             GS0=GS01*1.0d-3
  67.        else
  68.             fc=fc2
  69.             PC = PC2
  70.             BC = BC2
  71.             ac1=ac1_2
  72.             ac3=ac3_2
  73.             tdiss = tdiss2
  74.             ae4 = ae4_2
  75.             ae3 = ae3_2
  76.             ae1 = ae1_2
  77.             tbs = tbs2
  78.             tms = tms2
  79.             as1 = as1_2
  80.             tliquid = tliquid2
  81.             tsolid = tsolid2
  82.             xfe = xfe2
  83.             xpe = xpe2
  84.             XCOMPOS(1) = C2
  85.             XCOMPOS(2) = Mn2
  86.             XCOMPOS(3) = Si2
  87.             XCOMPOS(4) = Ni2
  88.             XCOMPOS(5) = Cr2
  89.             XCOMPOS(6) = Mo2
  90.             XCOMPOS(7) = Cu2
  91.             XCOMPOS(8) = W2
  92.             XCOMPOS(9) = V2
  93.             XCOMPOS(10) = Nb2
  94.             XCOMPOS(11) = Ti2
  95.             XCOMPOS(12) = Al2
  96.             XCOMPOS(13) = N2
  97.             GS0 = GS02*1.0d-3
  98.        end if
  99.        IF (TEMP2(I) .GT. TEMP1(I)) THEN
  100.           HEATING=.TRUE.                !!!!! HEATING
  101.           COOLING=.FALSE.              
  102.        ELSE
  103.           COOLING=.TRUE.                !!!!! COOLING
  104.           HEATING=.FALSE.
  105.        ENDIF
  106.  
  107.        IF (PEAK(I) .LT. TEMP2(I)) THEN
  108.           PEAK(I)=TEMP2(I)              !!!!! UPDATE PEAK TEMPERATURE
  109.        ENDIF
  110.  
  111.        IF (TEMP2(I) .GT. TSOLID) Then
  112.           XF(I)=ZERO
  113.           XP(I)=ZERO
  114.           XA(I)=0.0D0
  115.           XL(I)=1.0D0
  116.           XB(I)=ZERO
  117.           XM(I)=0.0D0
  118.        ELSEIF (TEMP2(I) .GT. AE3) THEN
  119.           XF(I)=ZERO
  120.           XP(I)=ZERO
  121.           XA(I)=1.0D0
  122.             XB(I)=ZERO
  123.           XM(I)=0.0D0
  124.           XL(I)=0.0D0
  125.        ENDIF
  126.  
  127.        if (heating) then
  128.             if (PEAK(I) .GT. Tsolid) then
  129.                GS(I)=0.05D0
  130.             elseif (TEMP2(I) .GT. TDISS) then
  131.                if (TEMP1(I) .LT. TDISS) then
  132.                   GS(I)=GS0
  133.                endif
  134.                if (GS(I) .lt. gsmax) then
  135.                 CALL STARTSTOPH (TEMP1(I),TEMP2(I),TIME1,TIME2,&   TDISS,Tsolid,TEMP0,DTEMP,DTIME)
  136.                 NSTEPS=NINT(100*DTIME)
  137.                   if (NSTEPS .gt. 100) then
  138.                      NSTEPS=100
  139.                   elseif (NSTEPS .lt. 10) then
  140.                      NSTEPS=10
  141.                   endif
  142.                 TIMEINC=DTIME/NSTEPS
  143.                   DO 10 K=1,NSTEPS,1
  144.                      TEMP=TEMP0+K*DTEMP/NSTEPS
  145.                      if (GS(I) .LT. GSMAX) then
  146.                         CALL GRAINGROWTH (TEMP,TIMEINC,GS(I),GSMAX)
  147.                      endif
  148. 10                continue
  149.                endif
  150.             elseif ((TEMP2(I) .GT. AE1) .and. (TEMP2(I) .LT. AE3)&  .AND. (abs(PEAK(I)-TEMP2(I)) .LT. 0.1D0)&     .AND. (XA(I) .LT. 0.999D0)) then
  151.                XF(I)=XFE*(TEMP2(I)-AE1)/(AE3-AE1)
  152.                XP(I)=ZERO
  153.              XA(I)=1.0D0-XF(I)-XP(I)
  154.                XL(I)=0.0D0
  155.                XB(I)=ZERO
  156.                XM(I)=0.0D0
  157.                GS(I)=GS0
  158.             endif
  159.          endif
  160.  
  161.          if (COOLING .AND. (TEMP2(I) .LT. AE3) .AND. (TEMP1(I) .GT. AE1)&   .and. (XA(I) .GT. 1.0D-4)) then
  162.           CALL STARTSTOPC (TEMP1(I),TEMP2(I),TIME1,TIME2, &     AE3,AE1,TEMP0,DTEMP,DTIME)
  163.             NSTEPS=NINT(1000*DTIME)
  164.             if (NSTEPS .gt. 1000) then
  165.                NSTEPS=1000
  166.             elseif (NSTEPS .lt. 10) then
  167.                NSTEPS=10
  168.             endif
  169.           TIMEINC=DTIME/NSTEPS
  170.  
  171.           DO 20 K=1,NSTEPS,1
  172.              TEMP=TEMP0+K*DTEMP/NSTEPS
  173.                DXF=0.4275D0*(AE3-TEMP)**3.0D0*XTERM(XF(I))*TIMEINC&    *DIFF(TEMP)/fc/GS(I)**0.83D0
  174.              IF (DXF .GT. (XFE-XF(I))) THEN
  175.                   XF(I)=XFE
  176.                 XA(I)=1.0D0-(XF(I)+XP(I)+XB(I)+XM(I))
  177.                   goto 20
  178.                else
  179.                 XF(I)=XF(I)+DXF
  180.                 XA(I)=1.0D0-(XF(I)+XP(I)+XB(I)+XM(I))
  181.                endif
  182. 20          continue
  183.          endif
  184.  
  185. 40       if ((TEMP2(I) .LT. AE1) .and. (TEMP1(I) .GT. TBS)&      .and. (XA(I) .GT. 1.0D-4)) then
  186.           CALL STARTSTOPC (TEMP1(I),TEMP2(I),TIME1,TIME2,&                     AE1,TBS,TEMP0,DTEMP,DTIME)
  187.             NSTEPS=NINT(1000*DTIME
  188.             if (NSTEPS .gt. 1000) then
  189.                NSTEPS=1000
  190.             elseif (NSTEPS .lt. 10) then
  191.                NSTEPS=10
  192.             endif
  193.           TIMEINC=DTIME/NSTEPS
  194.  
  195.           DO 60 K=1,NSTEPS,1
  196.              TEMP=TEMP0+K*DTEMP/NSTEPS
  197.              IF (XF(I) .LT. XFE) THEN
  198.                   DXF=0.4275D0*(AE3-TEMP)**3.0D0*XTERM(XF(I))*TIMEINC&                *DIFF(TEMP)/fc/GS(I)**0.83D0
  199.                 IF (DXF .LT. (XFE-XF(I))) THEN
  200.                    XF(I)=XF(I)+DXF
  201.                   else
  202.                    XF(I)=XFE
  203.                   endif
  204.                endif
  205.  
  206.              IF (XP(I) .LT. XPE) THEN
  207.                   DXP=0.52037D0*(AE1-TEMP)**3.0D0*XTERM(XP(I)/XPE)*TIMEINC&                *DIFF(TEMP)*XPE/pc/GS(I)**0.638D0
  208.                 IF (DXP .LT. (XPE-XP(I))) THEN
  209.                    XP(I)=XP(I)+DXP
  210.                   else
  211.                    XP(I)=XPE
  212.                   endif
  213.                endif
  214.              XA(I)=1.0D0-(XF(I)+XP(I)+XB(I)+XM(I))
  215. 60          continue
  216.          endif
  217.              
  218.          if ((TEMP2(I) .LT. TBS) .and. (TEMP1(I) .GT. TMS) &       .and. (XA(I) .GT. 1.0D-4)) then
  219.           CALL STARTSTOPC (TEMP1(I),TEMP2(I),TIME1,TIME2,&                       TBS,TMS,TEMP0,DTEMP,DTIME)
  220.             NSTEPS=NINT(1000*DTIME)
  221.             if (NSTEPS .gt. 1000) then
  222.                NSTEPS=1000
  223.             elseif (NSTEPS .lt. 10) then
  224.                NSTEPS=10
  225.             endif
  226.           TIMEINC=DTIME/NSTEPS
  227.  
  228.           DO 80 K=1,NSTEPS,1
  229.              TEMP=TEMP0+K*DTEMP/NSTEPS
  230.                DXB=0.55561D0*(TBS-TEMP)**2.0D0*XTERM(XB(I))*TIMEINC &             *DIFF(TEMP)/bc/GS(I)**0.574D0
  231.              IF (DXB .LT. XA(I)) THEN
  232.                 XB(I)=XB(I)+DXB
  233.                 XA(I)=1.0D0-(XF(I)+XP(I)+XB(I)+XM(I))
  234.                else
  235.                   XB(I)=1.0D0-(XF(I)+XP(I)+XM(I))
  236.                   XA(I)=0.0D0
  237.                   GOTO 99
  238.                endif
  239. 80          continue
  240.          endif
  241.  
  242.          if ((XA(I) .GT. ZERO) .and. (TEMP2(I) .LT. TMS) &       .and. (TEMP1(I) .GT. TMS)) then
  243.             XM(I)=1.0D0-(XF(I)+XP(I)+XB(I))
  244.             XA(I)=0.0D0
  245.           GOTO 99
  246.          endif
  247.  
  248. 99       if ((TEMP1(I) .lt. AE1) .and. (TEMP2(I) .gt. AE1)) then
  249.             HV(I)=0.0D0
  250.          endif
  251.  
  252.          if ((TEMP1(I) .ge. as1) .and. (TEMP2(I) .lt. as1)) then
  253.             VR(I)=3600.0D0*(TEMP1(I)-TEMP2(I))/(TIME2-TIME1)
  254.          endif
  255.        
  256.          if ((HV(I) .lt. zero) .and. (VR(I) .gt. 1.0D0)&       .and. (TEMP2(I) .lt. TMS) .and. (XA(I) .le. zero)) then
  257.           call hardness2(XCOMPOS,XF(I),XP(I),XB(I),XM(I),VR(I),HV(I))
  258.          endif
  259. 100 CONTINUE   
  260.     RETURN
  261.     END
  262.  
  263.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!