! 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.


module write

  use parameters
  use topography
  use states
  use write_vtk

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

  !Files identifiers
  integer :: file_rho, file_u, file_ut, file_etadiss &
       & ,file_time_im,file_time_int, &
	   & file_res_tangential, file_res_normal, file_res_pressure
  integer :: file_ep,file_ek,file_etot,file_xfront
  integer :: file_finertx,file_finerty
  integer :: file_faccx,file_faccy
  integer :: file_fpressionx,file_fpressiony
  integer :: file_fgravx,file_fgravy
  integer :: file_fcurvx,file_fcurvy
  integer :: file_ffricx,file_ffricy
  integer :: file_pbottom,file_shearx,file_sheary,file_shearz
  integer :: file_dth22divcu,file_divh22cudivcu
  integer :: file_normalx,file_normaly,file_normalz
  !Counting for writing
  integer :: naff, naffd, nafff, reco
  !Format for writing image
  character nbxwchar*32,formatim*32
  !Tests updates in loop to indicate if outputs must be written to files
  !avoids numerical uncertainties when delt is set to match output times
  logical :: write_im_bool=.FALSE.

contains

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

  !Write parameters to plotmat.dat file
  subroutine write_param
    open (999, file = folder_output(:len_output)//'/plotmat.dat') ! for 1d-plot
    write (999,*) xv, yv, zv
    write (999,*) av, bv, rai
    write (999,*) nx,ny, 0
    write (999,*) delx, dely, 0
    write (999,*) nbsec, nbim, 0
    write (999,*) icomp , 0, 0
    write (999,*) delta1 , 0, 0
    write (999,*) delta2, 0, 0
    write (999,*) delta3, 0, 0
    write (999,*) delta4, 0, 0
    write (999,*) theta0 , 0, 0
    write (999,*) theta1, 0, 0
    write (999,*) tmax , 0, 0
    write (999,*) grav, 0, 0
    write (999,*) beta, diam, wlong
    close (999)
  end subroutine write_param

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

  !Write initial datatopography (topography, axes, slope)
  subroutine write_topography

    !Write grid
    open(998,file=folder_output(:len_output)//'/grillexw.d',form='formatted',status='unknown')
    open(999,file=folder_output(:len_output)//'/grilleyw.d',form='formatted',status='unknown')
    write(998,'(1G13.5)')(grillex(i),i=1,nx,lwrstepx)
    write(999,'(1G13.5)')(grilley(j),j=1,ny,lwrstepy)
    close(998)
    close(999)

    !Write topography
    open(999,file=folder_output(:len_output)//'/z.bin' &
       &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    if (imformat.eq.0) then
       !c gnuplot format
       write(999,'(1G13.5)')(((z(i,j)) ,i=1,nx,lwrstepx),j=1,ny,lwrstepy)
       write(999,*)
       write(999,*)
    else if (imformat.eq.1) then
       !c matlab format
       do j=1,ny
          reco = j
          write(999,rec=reco) (real(z(i,j),psav), i=1,nx)
       enddo
    endif
    close(999)

    if (icomp.eq.4) then
       open(999,file=folder_output(:len_output)//'/filt.bin' &
            &,form='unformatted',status='replace',access='direct',recl=nx*psav)
       !c matlab format
       do j=1,ny
          reco = j
          write(999,rec=reco) (real(filt(i,j),psav), i=1,nx)
       enddo
    end if

    !Write slope angle
    open(999,file=folder_output(:len_output)//'/ota.d',form='formatted',status='unknown')
    write(999,'(1G13.5)')((ota(i,j),i=1,nx,lwrstepx),j=1,ny,lwrstepy)
    close(999)

  end subroutine write_topography

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

  !Define identification integers to acces states files, and open them
  subroutine write_init

    !Counting for writing files
    naff=0
    naffd=0
    nafff=0

    !c format d'ecriture des images
    nbxw=1+(nx-1)/lwrstepx
    nbyw=1+(ny-1)/lwrstepy
    write(nbxwchar,*)nbxw
    nbxwchar=adjustl(nbxwchar)
    lennbxw=index(nbxwchar(2:),' ')
    formatim='('//nbxwchar(:lennbxw)//'G18.8)'

    !!Open files for states

    !Thickness normal to topography
    file_rho=1
    open(file_rho,file=folder_output(:len_output)//'/rho.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)

    !X velocity component
    file_u=2
    open(file_u,file=folder_output(:len_output)//'/u.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)

    !Y velocity component
    file_ut=3
    open(file_ut,file=folder_output(:len_output)//'/ut.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)

    !Local entropy production
    file_etadiss=4
    open(file_etadiss,file=folder_output(:len_output)//'/etadiss.bin'&
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)

    !Time of writing
    file_time_im=5
    open(file_time_im,file=folder_output(:len_output)//'/time_im.d' &
         &,form='formatted',status='unknown')

    !!Open files for integrated quantites

    file_ek=100
    open(file_ek,file=folder_output(:len_output)//'/ek.d')

    file_ep=101
    open(file_ep,file=folder_output(:len_output)//'/ep.d')

    file_etot=102
    open(file_etot,file=folder_output(:len_output)//'/etot.d')

    file_xfront=104
    open(file_xfront,file=folder_output(:len_output)//'/xfront.d')

    file_time_int=103
    open(file_time_int,file=folder_output(:len_output)//'/time_int.d' &
         &,form='formatted',status='unknown')

    file_res_tangential=105
    open(file_res_tangential,file=folder_output(:len_output)//'/restangential.d' &
         &,form='formatted',status='unknown')
		 
	file_res_normal=106
    open(file_res_normal,file=folder_output(:len_output)//'/resnormal.d' &
         &,form='formatted',status='unknown')
		 
	file_res_pressure=107
    open(file_res_pressure,file=folder_output(:len_output)//'/respressure.d' &
         &,form='formatted',status='unknown')

    

    

  end subroutine write_init

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

  !Write states to file
  subroutine write_im

    if (imformat.eq.0) then
       !cformat gnuplot
       write(file_rho,'(3G13.5)')(((/grillex(i),grilley(j),rho(i,j)/),i=1,nx,lwrstepx),j=1,ny,lwrstepy)
       write(file_u,'(3G13.5)')(((/grillex(i),grilley(j),u(i,j)/),i=1,nx,lwrstepx),j=1,ny,lwrstepy)
       write(file_ut,'(3G13.5)')(((/grillex(i),grilley(j),ut(i,j)/),i=1,nx,lwrstepx),j=1,ny,lwrstepy)
       write(file_etadiss,'(3G13.5)')(((/grillex(i),grilley(j),etadiss(i,j)/)&
             ,i=1,nx,lwrstepx),j=1,ny,lwrstepy)
    else if (imformat.eq.1) then
       !cformat matlab
       do j=1,ny
          reco = (naff)*(ny) + j
          write(file_rho,rec=reco) (real(rho(i,j),psav),i=1,nx)
          write(file_u,rec=reco) (real(u(i,j),psav),i=1,nx)
          write(file_ut,rec=reco) (real(ut(i,j),psav),i=1,nx)
          write(file_etadiss,rec=reco) (real(etadiss(i,j),psav),i=1,nx)
       enddo
    else if (imformat.eq.2) then
       call write_vtk_ascii(naff)
    end if

    write(file_time_im,*) temps

    write_im_bool= .FALSE.

  end subroutine write_im

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

  !Write integrated quantites to file
  subroutine write_int

    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) + grav*rho(i,j)*z(i,j)/thet(i,j),&
         &i=1,nx),j=1,ny)/))

    etot=ec+ep
    if (epsh_front.gt.0) then
       xfront=0
       do j=1,ny
          do i=1,nx
             if ((rho(i,j).gt.epsh_front).and.(grillex(i).gt.xfront)) then
                xfront=grillex(i)
             endif
          enddo
       enddo
       write(file_xfront,'(2e13.5)')temps,xfront
    endif

    write(file_ek,'(2e13.5)')temps,ec
    write(file_ep,'(2e13.5)')temps,ep
    write(file_etot,'(2e13.5)')temps,etot
    write(file_time_int,*) temps
  

    ! Find the Centroid of rho and compute its inertial number
    !centroidx = 0.d0
    !centroidy = 0.d0
    !tMass = 0.d0
    !do i=1,nx
    ! do j=1,ny
    !    centroidx = centroidx+rho(i,j)*i
    !    centroidy = centroidy+rho(i,j)*j
    !    tMass = tMass + rho(i,j)
    !  enddo
    !enddo
    !centroidx = centroidx/tMass
    !centroidy = centroidy/tMass

    !i = int(centroidx)
    !j = int(centroidy)
    
   ! Need to add conditions in case of empty mass (rho=0 every where, meanwhile I shut off this step)
   !unorm =sqrt((u(i,j)**2+ut(i,j)**2&
   !               & +(p(i,j)*u(i,j)+pt(i,j)*ut(i,j))**2)/(1.+p(i,j)**2+pt(i,j)**2))

   !tI=5*unorm/(2*rho(i,j)*sqrt(grav*rho(i,j)*thet(i,j))) ! The centroid inertial number is normalized by d/sqrt(vol_frac) !!!!

   ! write(file_resultante,'(8e21.12)') temps,sumrestgy,sumrestgx,sumrestgz,sumresnormy,sumresnormx,sumresnormz,tI


  end subroutine write_int


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

  !Write maximum thicknesses and kinetic energies at the end of the simulation.

  subroutine write_max_states
    open(999,file=folder_output(:len_output)//'/rhomax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    open(998,file=folder_output(:len_output)//'/unormmax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    open(997,file=folder_output(:len_output)//'/ekmax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    open(996,file=folder_output(:len_output)//'/momentummax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    open(995,file=folder_output(:len_output)//'/pimpactmax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    open(994,file=folder_output(:len_output)//'/fimpactmax.bin' &
         &,form='unformatted',status='replace',access='direct',recl=nx*psav)
    do j=1,ny
       reco = j
       write(999,rec=reco) (real(rhomax(i,j),psav), i=1,nx)
       write(998,rec=reco) (real(unormmax(i,j),psav), i=1,nx)
       write(997,rec=reco) (real(ekmax(i,j),psav), i=1,nx)
       write(996,rec=reco) (real(momentummax(i,j),psav), i=1,nx)
       write(995,rec=reco) (real(pimpactmax(i,j),psav), i=1,nx)
       write(994,rec=reco) (real(fimpactmax(i,j),psav), i=1,nx)
    enddo
    close(999)
    close(998)
    close(997)
    close(996)
    close(995)
    close(994)
  end subroutine write_max_states

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

  

end module write
