TABLE OF CONTENTS

UTI/PRE/cerf_input [ Modules ]

[ Top ] [ Modules ]

NOM

 cerf_input

DESCRIPTION

 Programme permettant la lecture d un fichier de donnees  
 pour le convertir en (un ou plusieurs) fichier binaire au format CERF

 Program for reading a data file  
 to convert it into (one or more) binary files in CERF format

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
  use, intrinsic :: iso_fortran_env, only: real64
  IMPLICIT NONE
!.2-----  Declaration
  type(calcul)                                     :: calc 
  character(30)                                    :: fichinp
  character(4)                                     :: entete
  integer                                          :: icode,iarg
  integer                                          :: nzonei
  real(kind=kind(0.d0)),allocatable,dimension(:,:) :: zone,zonei
  real(kind=kind(0.d0)),allocatable,dimension(:)   :: crit
  integer,allocatable,dimension(:,:)               :: nzone  
  logical                                          :: fichexist
  integer                                          :: argc, ios=0,ios2, i,j
  character(len=256)                               :: iomsg,ligne
!=========================== DEBUT DU CODE EXECUTABLE ==================

! Recupuration et ouverture du fichier de donnees
 argc = command_argument_count()
 if (argc < 1) call print_err('CERF_INPUT','No data file specified !!!')
 call get_command_argument(1,fichinp)
 fichinp = trim(fichinp)
 inquire(file=fichinp,exist=fichexist)

 if (.not. fichexist) call print_err('CERF_INPUT','Data file does not exist at the specified location !')

 write(*,*)achar(27)//'[34m**********************************************************'
 write(*,*) fdate()
 write(*,*)'CERF_INPUT Data file :'// fichinp 
 write(*,*)'**********************************************************' //achar(27)//'[0m'

! Ouverture du fichier de donnees
  OPEN(33,file=fichinp,status='old',action='read',iostat=ios,iomsg=iomsg)
  if (ios /= 0) call print_err('CERF_INPUT','Could not open file: '//trim(iomsg))
  CALL empty_mesh(calc%msh,1,0)
 10 continue

! Recherche de l entete
  !read(33,'(a4,2i5)',iostat=ios)entete,icode,iarg
  entete='bbbb'
  read(33,'(A)',iostat=ios) ligne
  if (ios == 0) then
    read(ligne,*,iostat=ios2) entete, icode, iarg
  end if
  
  if(ios .gt.0) goto 10
  if(ios .lt.0) goto 800
  
  SELECT CASE (entete)
!-----------------------------------------------------------------------
! Lecture des parametres physiques
!-----------------------------------------------------------------------
      CASE('PHYS')
          CALL read_phys()
!-----------------------------------------------------------------------
! Lecture des conditions aux limites
!-----------------------------------------------------------------------
      CASE('COND')
          CALL read_cond(calc%list_bloc,icode,iarg,calc%nb_bloc)
 
!-----------------------------------------------------------------------
! Lecture de l Initialisation
!-----------------------------------------------------------------------
      CASE('INIT')
          CALL read_init(icode,iarg,zonei,nzonei)
          
 !-----------------------------------------------------------------------
! Lecture de la bathymetrie
!-----------------------------------------------------------------------
      CASE('BATH')
          CALL read_bath(icode,iarg)
         
          if(ibathy.eq.-2)then ! on cree le fichier des sommet de la base des blocs
            open(17,file=fich_bathy,status='new')
            do i=1,calc%nb_bloc
              do j=1,4
                 write(17,'(2e13.5)')calc%list_bloc(i)%s(j)%x,calc%list_bloc(i)%s(j)%y
               enddo
            enddo
            close(17)
            write(*,*)'Bottom of the Blocks written in file:',fich_bathy
            stop
          endif
    
!-----------------------------------------------------------------------
! Lecture des obstacles
!-----------------------------------------------------------------------
      CASE('OBST')
          CALL read_obst(calc,iarg)

!-----------------------------------------------------------------------
! Lecture ou creation du maillage maitre
!-----------------------------------------------------------------------
      CASE('MAME')
         CALL read_mame(calc,icode,iarg)

!-----------------------------------------------------------------------
! Lecture des parametres numeriques
!-----------------------------------------------------------------------
      CASE('NUME')
         CALL read_nume(calc)

!-----------------------------------------------------------------------
! Lecture des parametres de maillage AMR
!-----------------------------------------------------------------------
      CASE('MESH')
         CALL read_mesh(calc,nzone,zone)

  END SELECT
  GOTO 10
!-----------------------------------------------------------------------
! Fin de lecture, constitution des calculs et sauvegarde sur fichier binaire
!-----------------------------------------------------------------------

 800   continue

!-----------------------------------------------------------------------
! Sauvegarde et extraction des domaines

  calc%msh%numdom=0
  close(33,iostat=ios)
  CALL block2mesh(calc,nzone,zone,nzonei,zonei)
  call print_avert('CERF_INPUT','Save the blocks ')
  CALL save_calc(calc)
  allocate(crit(calc%nb_bloc))
  crit=0.d0
  CALL amr2tec(calc%list_bloc,crit,calc%nb_bloc) 
  deallocate(crit)


  if(allocated(nzone))deallocate(nzone)
  if(allocated(zone)) deallocate(zone)
  if(allocated(zonei))deallocate(zonei)
!===========================   FIN DE LA ROUTINE    ====================

  END PROGRAM cerf_input