! SHALTOP

! Copyright 2022, Francois BOUCHUT, Anne MANGENEY, Marc PERUZZETTO, Antoine LUCAS,  Jacques SAINTE-MARIE
! This program is distributed under the terms of the Lesser GPL v3
! This file is part of SHALTOP.


program shaltop

  use init_functions
  use parameters
  use topography
  use rheology_functions
  use write
  use states
  use sources
  use spatial_reconstruction
  use bound_conditions
  use flux
  use apparent_topography
  use loop
  use viscosity

  implicit double precision (a-h,o-z)

  integer :: num_args
  character (len=300)::input_working_directory,in_param_file
  double precision,dimension(0:lx+1,0:ly+1) :: &
       & otam, pm, ptm,hiz,pmf,pmb,ptmr,ptml,pmbf, pmff,ptmrf,ptmlf  &
       & , pm_f,ptm_f,otam_f,sip,sipt,sipm,siptm,srtm,tm_f
  integer :: bym,byp, bxp, bxm

  write(*,*) 'Shaltop (Mangeney et al., [2005])'
  write(*,*) '----------'
  write(*,*) 'Saint-Venant, Savage-Hutter system with topography'
  write(*,*) 'and friction in two dimensions'
  write(*,*) ' '
  write(*,*) 'Mono-CPU Version, 2022'
  write(*,*) ' '
  write(*,*) '______________________________________________'

  !Get working folder
  num_args = command_argument_count()
  if (num_args.gt.0) then
     call get_command_argument(1,input_working_directory)
     if (num_args.gt.1) then
        call get_command_argument(2,in_param_file)
     else
        in_param_file='params.txt'
     end if
  else
     input_working_directory=' '
     in_param_file='params.txt'
  end if
  call parameters_input(input_working_directory,in_param_file)

  !Read parameters in parameters files, and intern parameters. See parameters.f90
  call parameters_init
  call parameters_read
  call parameters_process

  !Print parameters
  call print_param
  !Write parameters
  call write_param

  !---------------------------------------------------------------------

  !c Topography definition
  call topography_allocate_tables
  call topography_init

  !c Topography gradient and slope angle
  call topography_gradient
  !c Topography curvature
  call topography_curvature

  !c Write topography to files
  call write_topography

  !--------------------------------------------------------------------
  !Initialize files
  call write_init

  !------------------------------------------------------------------
  ! Source terms
  call sources_rho_init
  call sources_vel_init

  !------------------------------------------------------------------
  ! Constructing initial states (rho, u, ut)
  call states_allocate_tables
  call states_init
  ! Write initial states to files
  call write_im



  !------------------------------------------------------------------
  ! Write initial integrated quantities
  call write_int

  !c Spatial reconstruction of delz, delzy,p,pt,thet,ota, order 1 et 2
  call spatial_reconstruction_allocate
  call spatial_reconstruction_init

  !----------------------------------------------------
  ! Allocate flux tables
  call flux_allocate
  if (ivisc.gt.0) then
     call viscosity_allocate
  end if

  print*,""
  print*,"Debut boucle en temps"
  print*,""
  econtr=0.d0

  temps=0.d0
  l=0

  !Time loop
  do while ((l+1.le.nt).and.(temps.lt.tmax))
     l=l+1

     ! Contre les underflows
     call states_min0

     !c debut Euler

     !c pour l'ordre 2 en temps
     !c      if (.not.(mtordre.eq.1)) then
     call states_save
     !c     endif

     do lmt=1,mtordre

        call bound_conditions_variables

        call spatial_reconstruction_time_loop

        !cpour la friction
        if (icomp.ne.0) then

           if (lmt.eq.1) then

              !Save flux
              call states_flux_save

              !Estimate velocities at the beginning of the loop
              if (l.le.4) then
                 call flux_estimate_velocity_init
              end if

              !Compute time step
              call loop_time_step(naff+1)

           endif

           !Compute apparent topography in (i,j), (i+1/2,j), (i,j+1/2)
           call apparent_topography_ij
           call apparent_topography_i05j
           call apparent_topography_ij05

        endif

        !ccalcul des flux
        call flux_compute

        !ccalcul du pas de temps, cas sans friction
        if ((icomp.eq.0).and.(lmt.eq.1)) then
           call loop_time_step(naff+1)
        endif

        !ccalcul des nouvelles moyennes
        call flux_new_means(lmt)


        !cordre 2 en temps
        if (.not.(mtordre.eq.1)) then
           if (lmt.eq.1) then
              call states_etadiss_save
           else
              call states_update_mtordre2
           end if
        endif

     enddo

     !ccalcul de production d'entropie
     econtr=econtr+delt*delx*dely*sum((/((max(etadiss(i,j),0.d0)&
          & ,i=1,nx),j=1,ny)/))

     !Viscosity
     if (ivisc.gt.0) then
        call viscosity_flux(temps,delt)
     end if

     temps=temps+delt

     !Update with source terms
     call states_add_sources

     !Update maximum thickness and kinetic energies
     call states_update_max

     !cecriture
     !ctableaux
     !if (abs((nbim*temps/tmax)-naff-1).lt.1.0d-15) then
     !   print*,(nbim*temps/tmax)-naff-1
     !endif
     !if (abs((nbim*temps/tmax)-naff-1.d0).lt.1.d-15) then
     if (write_im_bool) then
        naff=naff+1
        call write_im
        print*,'writing image t=',temps,'s'
     endif

     !cquantites integrees
     if (int(nbdat*temps/tmax).ge.naffd+1.d0) then
        naffd=naffd+1
        call write_int
     endif

     

     !c******************************************************************************
  enddo

  call write_max_states

  !c Conservations
  final_vol=delx*dely*sum((/((rho(i,j)/thet(i,j),i=1,nx),j=1,ny)/))
  qmv=delx*dely*sum((/((rho(i,j)*u(i,j)/thet(i,j),i=1,nx),j=1,ny)/))
  qmvt=delx*dely*sum((/((rho(i,j)*ut(i,j)/thet(i,j) ,i=1,nx),j=1,ny)/))
  ec=delx*dely*sum((/((rho(i,j)/thet(i,j)*(u(i,j)**2+ut(i,j)**2 +&
       &(p(i,j)*u(i,j)+pt(i,j)*ut(i,j))**2)/(1.d0 +p(i,j)**2+pt(i,j)**2)/2.d0 ,i=1,nx),j=1,ny)/))
  ep=delx*dely*sum((/((ckappa*rho(i,j)**2  *ota(i,j)/thet(i,j),i=1,nx),j=1,ny)/))
  etot=ec+ep

  !c Affichage
  print*,'  '
  print*,'____________________________________________________________________________'

  write(*,"(A35,I15)") 'Number of iterations:', l
  write(*,"(A35,E15.2)") 'Final time', tmax
  write(*,"(A35,E15.2)") 'Final time step', delt
  write(*,"(A35,I15)") 'Number of recorded images', naff
  write(*,"(A35,E15.2)") 'Final momentum in x-direction', qmv
  write(*,"(A35,E15.2)") 'Final momentum in y-direction', qmvt
  write(*,"(A35,E15.2)") 'Final volume', final_vol
  write(*,"(A35,E15.2)") 'Relative volume variation', (final_vol-init_vol)/(init_vol+1.d-15)
  write(*,"(A35,E15.2)") 'Final energy', etot
  write(*,"(A35,E15.2)") 'Energy production', econtr
  write(*,"(A35,E15.2)") 'Relative energy production', econtr/(abs(etot)+1.d-15)

  write(*,*) ' End.'
9999 end program
