pxjoke

VMAT_lab3_24

Apr 9th, 2015
257
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program lab3
  2.   interface
  3.     subroutine dif(T, Y, YP)
  4.     real T, Y(2), YP(2)
  5.     end
  6.   end interface
  7.   integer, parameter :: NEQN = 2
  8.   integer ::  IFLAG, IWORK(6)
  9.   real :: Y(NEQN),YP(NEQN), T, TOUT, RELERR, ABSERR, WORK(3+6*NEQN + 1 ), Y2(NEQN), YP2(NEQN), h, step
  10.   Y(1) = 5.0
  11.   Y(2) = -1.0
  12.   T = 0.0
  13.   RELERR = 0.1E-03
  14.   ABSERR = 0.0
  15.   IFLAG = 1
  16.   HPRINT = 0.05
  17.   TOUT = T
  18.   open(1, file="rkf45.txt")
  19.   do while(TOUT<1.02)
  20.     CALL RKF45(dif,NEQN,Y,T,TOUT,RELERR,ABSERR,IFLAG,WORK,IWORK)
  21.     write(1,*) "Y = ", Y
  22.     write(1,*) "T = ", T
  23.     write(1,*) "--------------------------"
  24.     TOUT = TOUT + HPRINT
  25.   end do
  26.   close(1)
  27.   Y(1) = 5.0
  28.   Y(2) = -1.0
  29.   T = 0.0
  30.   h = 0.0025
  31.   step = 0.0
  32.   open(2, file="rung.txt")
  33.   do while(T<1.0)
  34.     call  dif(T, Y, YP)
  35.     Y2 = Y + (h/6.0) * YP
  36.     T = T + h/6.0
  37.     call dif(T, Y2, YP2)
  38.     Y = Y + h * (3 * YP2 - 2 * YP)
  39.     if (step >= hprint) then
  40.       step = 0
  41.       write(2,*) "Y = ", Y
  42.       write(2,*) "T = ", T
  43.       write(2,*) "--------------------------"
  44.     end if
  45.     T = T + h - h/6.0
  46.     step = step + h
  47.   end do
  48.   close(2)
  49.   write(*,*) "Values imported to rkf45.txt, rung.txt"
  50. end program lab3
  51.  
  52. subroutine dif(T, Y, YP)
  53. real T, Y(2), YP(2)
  54. YP(1) = -45 * Y(1) + 60 * Y(2) + sin(1 + T)
  55. YP(2) = 70 * Y(1) - 110 * Y(2) + cos(1 - T) + T + 1
  56. end
Advertisement
Add Comment
Please, Sign In to add comment