! *** generated by SAPFOR with version 2412 and build date: Apr 29 2025 22:44:14
! *** Enabled options ***:
! *** maximum shadow width is 50 percent
! *** generated by SAPFOR

!---------------------------------------------------------------------
      subroutine btdv3

      include 'header3d_bt.h'
      integer ::  i,niter,step,fstatus,n3
      double precision ::  navg,mflops
      external timer_read_bt,verify_bt
      double precision ::  tmax,timer_read_bt
      logical ::  verified
      character ::  class

!---------------------------------------------------------------------
!      Root node reads input file (if it exists) else takes
!      defaults from parameters
!---------------------------------------------------------------------
      write (unit = *,fmt = 1000) 
      open (unit = 2,file = 'inputbt.data',status = 'old',iostat = fstat
     &us)
      if (fstatus .eq. 0) then
         write (unit = *,fmt = 233) 
233         format(' Reading from input file inputbt.data')
         read (unit = 2,fmt = *) niter
         read (unit = 2,fmt = *) dt
         read (unit = 2,fmt = *) grid_points(1),grid_points(2),grid_poin
     &ts(3)
         close (unit = 2)
      else  
         write (unit = *,fmt = 234) 
         niter = niter_default
         dt = dt_default
         grid_points(1) = problem_size
         grid_points(2) = problem_size
         grid_points(3) = problem_size
      endif  
234   format(' No input file inputbt.data. Using compiled defaults')
      write (unit = *,fmt = 1001) grid_points(1),grid_points(2),grid_poi
     &nts(3)
      write (unit = *,fmt = 1002) niter,dt
1000  format(//, ' NAS Parallel Benchmarks 3.3.1 - DVMH version',' - BT 
     &Benchmark ',/)
1001  format(' Size: ', i3, 'x', i3, 'x', i3)
1002  format(' Iterations: ', i3, '    dt: ', F10.6)
      if (grid_points(1) .gt. imax .or. grid_points(2) .gt. jmax .or. gr
     &id_points(3) .gt. kmax) then
         print *, (grid_points(i), i = 1,3)
         print *, ' Problem size too big for compiled array sizes'
         goto 999
      endif  
      open (unit = 2,file = 'inputStage',status = 'old',iostat = fstatus
     &)
      if (fstatus .eq. 0) then
         read (unit = 2,fmt = *) stage_n
         close (unit = 2)
      else  
         stage_n = 0
      endif  
      write (unit = *,fmt = *) 'stage = ',stage_n
      call set_constants_bt()
      call initialize_bt()
      call exact_rhs_bt()

! ************* DO 2 iterations for touch all code 
      call adi_first_bt()
      call adi_first_bt()
      call initialize_bt()
      call timer_clear_bt(1)
      call timer_start_bt(1)
      do  step = 1,niter
         if (mod (step,20) .eq. 0 .or. step .eq. 1) then
            write (unit = *,fmt = 200) step
200               format(' Time step ', i8)
         endif  
         call adi_bt()
      enddo  
      call timer_stop_bt(1)
      tmax = timer_read_bt(1)
      call verify_bt(niter,class,verified)
      n3 = grid_points(1) * grid_points(2) * grid_points(3)
      navg = (grid_points(1) + grid_points(2) + grid_points(3)) / 3.0
      if (tmax .ne. 0.) then
         mflops = 1.0e-6 * float (niter) * (3478.8 * float (n3) - 17655.
     &7 * navg** 2 + 28023.7 * navg) / tmax
      else  
         mflops = 0.0
      endif  
      call print_results_bt('BT',class,grid_points(1),
     &grid_points(2),grid_p
     &oints(3),niter,tmax,mflops,'          floating point',verified,npb
     &version)

!       ,compiletime, cs1, cs2, cs3, cs4, cs5,cs6, '(none)')
999   continue
      end

      subroutine adi_first_bt ()
      call compute_rhs_bt()
      call x_solve_bt()
      call y_solve_bt()
      call z_solve_bt()
      return 
      end

      subroutine adi ()

! DVM$ INTERVAL 1
      call compute_rhs_bt()

! DVM$ INTERVAL 11
! DVM$ END INTERVAL
      call x_solve_bt()

! DVM$ INTERVAL 12
! DVM$ END INTERVAL
      call y_solve_bt()

! DVM$ INTERVAL 13
! DVM$ END INTERVAL
      call z_solve_bt()

! DVM$ END INTERVAL
      return 
      end