  PROGRAM cerf2tec
!=========================== DOCUMENTATION ============================= 
!DOCDEBh*    UTI/cerf2tec  *
!
!    NOM
! cerf2tec
!    DESCRIPTION  
!*
! Programme permettant la lecture de fichiers binaires au format CERF
! puis de les transformer en un fichier au format tecplot en version multibloc
! Program for reading binary files in CERF format
! then transform them into a file in tecplot format in a multiblock version
!*
!
!    AUTEUR 
! GOLAY
!
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
!=========================== DEBUT DES DECLARATIONS ==================== 
!.1-----  Implicit, Use
  use uti
  IMPLICIT NONE
!.2-----  Declaration
  type(calcul)                                    :: calc 
  type(point)                                     :: p 
  integer                                         :: idom,i,j,k,ii,ib,nx,ny,nz,ivar,np,i2d,icell
  integer                                         :: ibloc,ifc,nb_bloc,nbdom,is,nxtot
  real(kind=kind(0.d0)) ,allocatable,dimension(:) :: x,y,z
!=========================== DEBUT DU CODE EXECUTABLE ==================

 write(*,*)achar(27)//'[34m**********************************************************'
 write(*,*) fdate()
 write(*,*)'CERF 2 Tecplot format output '
 write(*,*)'**********************************************************' //achar(27)//'[0m'

 nx=1;ny=1;nz=1;nxtot=0

! lecture des informations necessaires a la transformation
  OPEN(11,file='cerfbin_000',status='old',form='unformatted')
  read(11) nb_bloc,nbdom
  CLOSE(11)

! Boucle sur les domaines et les blocs 
  OPEN(12,file='cerfout.dat',status='unknown')
  !~OPEN(13,file='blocamr.dat',status='unknown')
  !~write(13,*)'Number of blocks',nb_bloc
  DO idom=1,nbdom
      CALL empty_mesh(calc%msh,nbdom,idom)
      CALL empty_sol(calc%list_sol)
! Recuperation du calcul
      CALL get_calc(calc)
      IF (idom.eq.1) THEN
          write(12,*)' TITLE="',calc%tmin,'"'
          if(imodel_phy.ne.1)then  
            write(12,*)' VARIABLES="X","Y","Z","R","U","V","W","P","Prod"'
          else   !Cas particulier du modele de SaintVenant
            write(12,*)' VARIABLES="X","Y","Z","eta","U","V","P_S","Zbottom"'
          endif
      endif
      if(imodel_phy.eq.1)then  
        do i=1,calc%msh%nb_cell
          if(calc%msh%list_cell(i)%w%vprim%v(1)<hzero_phy)then
            calc%msh%list_cell(i)%w%vprim%v(1)=0.d0
          else
            calc%msh%list_cell(i)%w%vprim%v(1)=calc%msh%list_cell(i)%w%vprim%v(1)+&
                                               calc%msh%list_cell(i)%w%vprim%v(5)
          endif
        enddo
      endif
      
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  DEBUG SOLIDE !!!!!!!!!!!!!!!!!!!
       !~do i=1,calc%msh%nb_cell
       !~     calc%msh%list_cell(i)%w%vprim%v(4)=calc%msh%list_cell(i)%w%chi
       !~ enddo
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  DEBUG SOLIDE !!!!!!!!!!!!!!!!!!!

      DO ib=1,calc%nb_bloc
          !~CALL ecrit_bloc(calc%list_bloc(ib))
          ibloc=calc%list_bloc(ib)%numbl
          SELECT CASE (calc%msh%ndim)
            CASE (1) ! Cas 1D
              nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb)
              ny=1
              nz=1
              i2d=-1
              nxtot=nxtot+nx
            CASE (2) ! Cas 2D
              nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb)
              ny=calc%list_bloc(ib)%ny*2**(calc%list_bloc(ib)%nrb)
              nz=1
              i2d=1
            CASE (3) ! Cas 3D
              nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb)
              ny=calc%list_bloc(ib)%ny*2**(calc%list_bloc(ib)%nrb)
              nz=calc%list_bloc(ib)%nz*2**(calc%list_bloc(ib)%nrb)
              i2d=0
          END SELECT

          write(12,1000)nx+1,ny+1,nz+1
1000 format('ZONE I=',i5,' J=',i5,' K=',i5,&
            ', DATAPACKING=BLOCK, VARLOCATION=([4,5,6,7,8,9]=CELLCENTERED)')
                  
          ii=0
          np=(nx+1)*(ny+1)*(nz+1)
          allocate(x(np))
          allocate(y(np))
          allocate(z(np))

! construction de la liste des sommets
          DO i=1,nx+1
              DO j=1,ny+1
                  DO k=1,nz+1
                      is=i+(nx+1)*(j-1)+(nx+1)*(ny+1)*(k-1)
                      p=pni(calc%list_bloc(ib),i*1.d0,j*1.d0,k*1.d0,i2d)
                      x(is)=p%x
                      y(is)=p%y
                      z(is)=p%z
                  END DO
              END DO
          END DO
! Cas particulier du modele de SaintVenant
          if(imodel_phy.eq.1)then
            do i=1,nx
              do j=1,ny
                icell=calc%list_bloc(ib)%first_cell+i+(j-1)*nx
                z(i+(j-1)*(nx+1))  =calc%msh%list_cell(icell)%w%vprim%v(1)
                z(i+1+(j-1)*(nx+1))=calc%msh%list_cell(icell)%w%vprim%v(1)
                z(i+(j)*(nx+1))    =calc%msh%list_cell(icell)%w%vprim%v(1)
                z(i+1+(j)*(nx+1))  =calc%msh%list_cell(icell)%w%vprim%v(1)
                z(i+(j-1)*(nx+1)+(nx+1)*(ny+1))  =calc%msh%list_cell(icell)%w%vprim%v(5)
                z(i+1+(j-1)*(nx+1)+(nx+1)*(ny+1))=calc%msh%list_cell(icell)%w%vprim%v(5)
                z(i+(j)*(nx+1)+(nx+1)*(ny+1))    =calc%msh%list_cell(icell)%w%vprim%v(5)
                z(i+1+(j)*(nx+1)+(nx+1)*(ny+1))  =calc%msh%list_cell(icell)%w%vprim%v(5)
              enddo
           enddo
          endif

          write(12,'(10e13.5)')x
          write(12,'(10e13.5)')y
          write(12,'(10e13.5)')z
          deallocate(x)
          deallocate(y)
          deallocate(z)
                 
          ifc=calc%list_bloc(ib)%first_cell
          DO ivar=1,nvar
           write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(ivar),ii=ifc+1,ifc+nx*ny*nz)
          END DO
          if(imodel_phy.eq.1)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(4),ii=ifc+1,ifc+nx*ny*nz) ! production entropie
          if(imodel_phy.eq.1)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(5),ii=ifc+1,ifc+nx*ny*nz) ! bathy
          if(imodel_phy.eq.2)write(12,'(10e13.5)')(calc%msh%list_cell(ii)%w%vprim%v(6),ii=ifc+1,ifc+nx*ny*nz) ! production entropie
      END DO
  END DO
  
  close(12)
  
  
  
  
  if(calc%msh%ndim.ne.1) return
  !=========================== SAUVEGARDE EN 1D SI NECESSAIRE  ======================================
  ! Boucle sur les domaines et les blocs 
  OPEN(12,file='cerfout1d.dat',status='unknown')

  DO idom=1,nbdom
      CALL empty_mesh(calc%msh,nbdom,idom)
      CALL empty_sol(calc%list_sol)
! Recuperation du calcul
      CALL get_calc(calc)
      IF (idom.eq.1) THEN
          write(12,*)' TITLE="',calc%tmin,'"'
          if(imodel_phy.ne.1)then  
            write(12,*)' VARIABLES="X","R","U","P"'
          else   !Cas particulier du modele de SaintVenant
            write(12,*)' VARIABLES="X","h","U","eta","q","Zbottom"'
          endif
          write(12,1001)nxtot
1001 format('ZONE T="", I=',i9,' F=POINT')
     endif

      DO ib=1,calc%nb_bloc
          ibloc=calc%list_bloc(ib)%numbl
          nx=calc%list_bloc(ib)%nx*2**(calc%list_bloc(ib)%nrb)

! Cas du modele de SaintVenant
          if(imodel_phy.eq.1)then
            do i=1,nx
                icell=calc%list_bloc(ib)%first_cell+i
                write(12,'(6e14.6)')calc%msh%list_cell(icell)%center%x, &
                                     calc%msh%list_cell(icell)%w%vprim%v(1), &
                                     calc%msh%list_cell(icell)%w%vprim%v(2), &
                                     calc%msh%list_cell(icell)%w%vprim%v(1)+calc%msh%list_cell(icell)%w%vprim%v(5), &
                                     calc%msh%list_cell(icell)%w%vprim%v(1)*calc%msh%list_cell(icell)%w%vprim%v(2), &
                                     calc%msh%list_cell(icell)%w%vprim%v(5)
            enddo
          endif
          if(imodel_phy.eq.2)then
            do i=1,nx
                icell=calc%list_bloc(ib)%first_cell+i
                write(12,'(6e14.6)')calc%msh%list_cell(icell)%center%x, &
                                     calc%msh%list_cell(icell)%w%vprim%v(1), &
                                     calc%msh%list_cell(icell)%w%vprim%v(2), &
                                     calc%msh%list_cell(icell)%w%vprim%v(5)
            enddo
          endif

      END DO
  END DO
  
  close(12)
  
  
  

!===========================   FIN DE LA ROUTINE    ====================

CONTAINS

 SUBROUTINE ecrit_bloc(b)
  use geo
  IMPLICIT NONE
  type(bloc),intent(in) :: b
  integer in
!=========================== DEBUT DU CODE EXECUTABLE ==================
  write(13,'(6i10)')b%numbl, b%idom,b%nx,b%ny,b%nz,b%nrb
  DO in=1,8
      write(13,'(3e16.8)') b%s(in)%x,b%s(in)%y,b%s(in)%z
  END DO
  write(13,'(6i10)') b%cl
  write(13,'(6i10)') b%nrf
  write(13,'(6i10)') b%dom
  write(13,'(6i10)') b%first_cell, b%nb_cell, b%first_face, b%nb_face, b%first_vertex, b%nb_vertex
 END SUBROUTINE ecrit_bloc

   END PROGRAM cerf2tec
!DOCFIN