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

  use parameters
  use states
  use topography

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

contains
  
  subroutine write_vtk_ascii(n_im)
    !
    !     subroutine for the writting of the output vtk files
    !
    integer ::  n_im
    character*3 buf3
    ! For storage of sampled images
    integer ifil,ipasx,nxx,nyy,is,js
    double precision ener
    !
    !
    nxx=nx-1
    nyy=ny-1
    ifil=122
    write (buf3,'(I3.3)') n_im
    open (ifil,FILE=folder_output(:len_output)//'/output_'//buf3//'.vtk')
    !
    write(ifil,fmt=8990)
8990 format (T1,'# vtk DataFile Version 2.0')
    write(ifil,fmt=8991)
8991 format (T1,'Unstructured Grid Example')
    write(ifil,fmt=8992)
8992 format (T1,'ASCII')
    write(ifil,fmt=8993)
8993 format (T1,'DATASET UNSTRUCTURED_GRID')
    write(ifil,fmt=8994) (nxx+1)*(nyy+1)
8994 format (T1,'POINTS',I8,' float')
    !print*,'nxx',nxx,'nx',nx
    do is=1,nxx+1
       do js=1,nyy+1
          !print*,zz(is,js),z(is,js)
          r=rho(is,js)
          write(ifil,*) real(grillex(is)-r*sp(is,js)),&
               & real(grilley(js)-r*spt(is,js)), &
               & real(z(is,js)+r*thet(is,js))
       enddo
    enddo
    write (ifil,*)
    write (ifil,fmt=8995) nxx*nyy,5*nxx*nyy
8995 format (T1,'CELLS',I8,I8)
    do is=0,nxx-1
       do js=1,nyy
          write(ifil,*) 4,js-1+(nyy+1)*is, &
               1+(js-1)+(nyy+1)*is,2+(js-1+nyy)+ &
               (nyy+1)*is,1+(js-1+nyy)+(nyy+1)*is
       enddo
    enddo
    write (ifil,*)
    write (ifil,fmt=8996) nxx*nyy
8996 format (T1,'CELL_TYPES',I8)
    do ii=1,nxx*nyy
       write (ifil,fmt=9002)
9002   format(T1,'9')
    enddo
    !
    write (ifil,*)
    write (ifil,fmt=8997) nxx*nyy
8997 format (T1,'CELL_DATA',I8)
    write (ifil,fmt=8998)
8998 format (T1,'VECTORS Velocity FLOAT')
    do is=1,nxx
       do js=1,nyy
          if (dabs(u(is,js)).ge.1.0d-6) then
             uu_w = u(is,js)*thet(is,js)
          else
             uu_w = 0.0d0
          endif
          if (dabs(ut(is,js)).ge.1.0d-6) then
             uut_w = ut(is,js)*thet(is,js)
          else
             uut_w = 0.0d0
          endif
          if (rho(is,js).gt.1.0d-6) then
             write (ifil,*) real(uu_w), &
                  real(uut_w),&
                  real(thet(is,js)*(p(is,js)*u(is,js)+pt(is,js)*ut(is,js)))
          else
             write(ifil,*) 0.d0,0.d0,0.d0
          end if
       enddo
    enddo
    write (ifil,*)
    write (ifil,fmt=9005)
9005 format (T1,'SCALARS Fluid_height FLOAT')
    write (ifil,fmt=9006)
9006 format (T1,'LOOKUP_TABLE default')
    do is=1,nxx
       do js=1,nyy
          if (dabs(rho(is,js)).ge.1.0d-7) then
             write(ifil,*) real(rho(is,js))
          else
             write(ifil,*) real(0.0d0)
          endif
       enddo
    enddo
    write (ifil,*)
    write (ifil,fmt=9007)
9007 format (T1,'SCALARS Kinetic_energy FLOAT')
    write (ifil,fmt=9006)
    do is=1,nxx
       do js=1,nyy
          unorm2=thet(is,js)**2*(u(is,js)**2+ut(is,js)**2+&
               (u(is,js)*p(is,js)+ut(is,js)*pt(is,js))**2)
          ener = rho(is,js)*unorm2
          if (ener.ge.1.0d-6) then
             write (ifil,*) real(ener)
          else
             write (ifil,*) real(0.0d0)
          endif
       enddo
    enddo
    close(ifil)
  end subroutine write_vtk_ascii

end module write_vtk
