cerf2tec.f90

### TABLE OF CONTENTS

- 1. UTI/cerf2tec

## UTI/cerf2tec [ Modules ]

[ Top ] [ Modules ]

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

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