cerf_input.f90

### TABLE OF CONTENTS

- 1. UTI/PRE/cerf_input

## 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