fonstr.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE fonstr
!                   *****************
!
     &(h,zf,z,chestr,ngeo,fformat,nfon,nomfon,mesh,ffon,listin,
     & n_names_priv,names_prive,prive)
!
!***********************************************************************
! BIEF   V7P1
!***********************************************************************
!
!brief    LOOKS FOR 'BOTTOM' IN THE GEOMETRY FILE.
!+
!+            LOOKS FOR 'BOTTOM FRICTION' (COEFFICIENTS).
!
!note     THE NAMES OF THE VARIABLES HAVE BEEN DIRECTLY
!+         WRITTEN OUT AND ARE NOT READ FROM 'TEXTE'.
!+         THIS MAKES IT POSSIBLE TO HAVE A GEOMETRY FILE
!+         COMPILED IN ANOTHER LANGUAGE.
!
!history  J-M HERVOUET (LNH)
!+        17/08/94
!+        V5P6
!+   First version
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  R. KOPMANN (EDF R&D, LNHE)
!+        16/04/2013
!+        V6P3
!+   Adding the format FFORMAT
!
!history Y AUDOUIN (LNHE)
!+        25/05/2015
!+        V7P0
!+        Modification to comply with the hermes module
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        27/07/2015
!+        V7P1
!+   Now able to read user variables and put them in PRIVE arrays.
!
!history  R ATA (EDF LAB, LNHE)
!+        24/05/2016
!+        V7P2
!+   BID initialised for cases of selafin files without records.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CHESTR         |<--| FRICTION COEFFICIENT (DEPENDING ON FRICTION LAW)
!| FFON           |-->| FRICTION COEFFICIENT IF CONSTANT
!| H              |<--| WATER DEPTH
!| LISTIN         |-->| IF YES, WILL GIVE A REPORT
!| MESH           |-->| MESH STRUCTURE
!| N_NAMES_PRIV   |-->| NUMBER OF PRIVATE ARRAYS WITH GIVEN NAMES
!| NAMES_PRIV     |-->| NAMES OF PRIVATE ARRAYS GIVEN BY USER
!| NFON           |-->| LOGICAL UNIT OF BOTTOM FILE
!| NGEO           |-->| LOGICAL UNIT OF GEOMETRY FILE
!| NOMFON         |-->| NAME OF BOTTOM FILE
!| PRIVE          |<->| BLOCK OF PRIVATE ARRAYS
!| Z              |<--| FREE SURFACE ELEVATION
!| ZF             |-->| ELEVATION OF BOTTOM
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_fonstr => fonstr
      USE interface_hermes
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj), INTENT(INOUT) :: H,ZF,Z,CHESTR,PRIVE
      TYPE(bief_mesh), INTENT(IN)   :: MESH
      DOUBLE PRECISION, INTENT(IN)  :: FFON
      LOGICAL, INTENT(IN)           :: LISTIN
      INTEGER, INTENT(IN)           :: NGEO,NFON,N_NAMES_PRIV
      CHARACTER(LEN=72), INTENT(IN) :: NOMFON
      CHARACTER(LEN=32), INTENT(IN) :: NAMES_PRIVE(4)
      CHARACTER(LEN=8), INTENT(IN)  :: FFORMAT
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IERR,RECORD,I
!
      DOUBLE PRECISION BID
!
      LOGICAL CALFON,CALFRO,LUZF,LUH,LUZ
!
!-----------------------------------------------------------------------
!
!    INITIALISES
!
      luh    =.false.
      luz    =.false.
      luzf   =.false.
      calfro =.true.
      bid    =0.d0
      record =0
!
!-----------------------------------------------------------------------
!
!     LOOKS FOR THE FRICTION COEFFICIENT IN THE FILE
!
      IF(lng.EQ.lng_fr)
     &         CALL find_variable(fformat, ngeo,'FROTTEMENT      ',
     &                            chestr%R, mesh%NPOIN,
     &                            ierr,record=record,time_record=bid)
      IF(lng.EQ.lng_en)
     &         CALL find_variable(fformat, ngeo,'BOTTOM FRICTION ',
     &                            chestr%R, mesh%NPOIN,
     &                            ierr,record=record,time_record=bid)
!     CASE OF A GEOMETRY FILE IN ANOTHER LANGUAGE
      IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_fr) THEN
        CALL find_variable(fformat, ngeo,'BOTTOM FRICTION ',
     &                  chestr%R, mesh%NPOIN,
     &                 ierr,record=record,time_record=bid)
      ENDIF
      IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_en) THEN
        CALL find_variable(fformat, ngeo, 'FROTTEMENT      ',
     &                 chestr%R,mesh%NPOIN,
     &                 ierr,record=record,time_record=bid)
      ENDIF
      IF(ierr.EQ.0) THEN
        calfro = .false.
        WRITE(lu,6)
6       FORMAT(1x,'FONSTR : FRICTION COEFFICIENTS READ IN THE',/,
     &         1x,'         GEOMETRY FILE')
      ENDIF
!
!     LOOKS FOR THE BOTTOM ELEVATION IN THE FILE
!
      IF(lng.EQ.lng_fr)
     &         CALL find_variable(fformat, ngeo,'FOND            ',
     &                            zf%R, mesh%NPOIN,
     &                            ierr,record=record,time_record=bid)
      IF(lng.EQ.lng_en) CALL find_variable(fformat, ngeo,
     &                            'BOTTOM          ',zf%R, mesh%NPOIN,
     &                            ierr,record=record,time_record=bid)
      IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_fr) THEN
        CALL find_variable(fformat, ngeo,
     &                 'BOTTOM          ', zf%R,mesh%NPOIN,
     &                 ierr,record=record,time_record=bid)
      ENDIF
      IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_en) THEN
        CALL find_variable(fformat, ngeo,
     &                 'FOND            ', zf%R,mesh%NPOIN,
     &                 ierr,record=record,time_record=bid)
      ENDIF
!     MESHES FROM BALMAT ?
      IF(ierr.EQ.hermes_var_unknown_err)
     &                   CALL find_variable(fformat, ngeo,
     &                   'ALTIMETRIE      ', zf%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)
!     TOMAWAC IN FRENCH ?
      IF(ierr.EQ.hermes_var_unknown_err)
     &                   CALL find_variable(fformat, ngeo,
     &                   'COTE_DU_FOND    ', zf%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)
!     TOMAWAC IN ENGLISH ?
      IF(ierr.EQ.hermes_var_unknown_err)
     &                   CALL find_variable(fformat, ngeo,
     &                   'BOTTOM_LEVEL    ', zf%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)
      luzf = ierr.EQ.0
!
      IF(.NOT.luzf) THEN
!       LOOKS FOR WATER DEPTH AND FREE SURFACE ELEVATION
        IF(lng.EQ.lng_fr) CALL find_variable(fformat, ngeo,
     &                              'HAUTEUR D''EAU   ', h%R,mesh%NPOIN,
     &                              ierr,record=record,time_record=bid)
        IF(lng.EQ.lng_en) CALL find_variable(fformat, ngeo,
     &                              'WATER DEPTH     ', h%R,mesh%NPOIN,
     &                              ierr,record=record,time_record=bid)
        IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_fr) THEN
          CALL find_variable(fformat, ngeo,
     &                   'WATER DEPTH     ', h%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)

        ENDIF
        IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_en) THEN
          CALL find_variable(fformat, ngeo,
     &                   'HAUTEUR D''EAU   ', h%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)
        ENDIF
        luh = ierr.EQ.0
        IF(lng.EQ.lng_fr) CALL find_variable(fformat, ngeo,
     &                              'SURFACE LIBRE   ', z%R,mesh%NPOIN,
     &                              ierr, record=record,time_record=bid)
        IF(lng.EQ.lng_en) CALL find_variable(fformat, ngeo,
     &                              'FREE SURFACE    ',z%R, mesh%NPOIN,
     &                              ierr, record=record,time_record=bid)
        IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_fr) THEN
          CALL find_variable(fformat, ngeo,
     &                   'FREE SURFACE    ', z%R,mesh%NPOIN,
     &                   ierr, record=record,time_record=bid)
        ENDIF
        IF((ierr.EQ.hermes_var_unknown_err).AND.lng.EQ.lng_en) THEN
          CALL find_variable(fformat, ngeo,
     &                   'SURFACE LIBRE   ', z%R,mesh%NPOIN,
     &                   ierr, record=record,time_record=bid)
        ENDIF
        luz = ierr.EQ.0
      ENDIF
!
!     INITIALISES THE BOTTOM ELEVATION
!
      IF(luzf) THEN
!
        calfon = .false.
!
      ELSE
!
        IF (luz.AND.luh) THEN
!
          CALL os( 'X=Y-Z   ',x=zf,y=z,z=h)
          WRITE(lu,25)
25        FORMAT(1x,'FONSTR (BIEF): ATTENTION, THE BOTTOM RESULTS',/,
     &              '               FROM DEPTH AND SURFACE ELEVATION',
     &            /,'               FOUND IN THE GEOMETRY FILE')
          calfon = .false.
!
        ELSE
!
          calfon = .true.
!
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!
! BUILDS THE BOTTOM IF IT WAS NOT IN THE GEOMETRY FILE
!
      IF(nomfon(1:1).NE.' ') THEN
!       A BOTTOM FILE WAS GIVEN, (RE)COMPUTES THE BOTTOM ELEVATION
        IF(listin) THEN
          WRITE(lu,2224) nomfon
          IF(.NOT.calfon) THEN
            WRITE(lu,2226)
          ENDIF
        ENDIF
2224    FORMAT(/,1x,'FONSTR (BIEF): BATHYMETRY GIVEN IN FILE : ',a72)
2226    FORMAT(  1x,'               BATHYMETRY FOUND IN THE',/,
     &           1x,'               GEOMETRY FILE IS IGNORED',/)
!
        CALL fond(zf%R,mesh%X%R,mesh%Y%R,mesh%NPOIN,nfon,
     &            mesh%NBOR%I,mesh%KP1BOR%I,mesh%NPTFR)
!
      ELSEIF(calfon) THEN
        IF(listin) THEN
          WRITE(lu,2228)
        ENDIF
2228    FORMAT(/,1x,'FONSTR (BIEF): NO BATHYMETRY IN THE GEOMETRY FILE',
     &         /,1x,'               AND NO BATHYMETRY FILE. THE BOTTOM',
     &         /,1x,'               LEVEL IS FIXED TO ZERO BUT STILL',
     &         /,1x,'               CAN BE MODIFIED IN CORFON.',
     &         /,1x)
        CALL os( 'X=0     ',x=zf)
      ENDIF
!
!-----------------------------------------------------------------------
!
! LOOKING FOR THE USER VARIABLES
!
      IF(n_names_priv.GT.0) THEN
        DO i=1,n_names_priv
          CALL find_variable(fformat,ngeo,names_prive(i)(1:16),
     &                   prive%ADR(i)%P%R,mesh%NPOIN,
     &                   ierr,record=record,time_record=bid)
          IF(ierr.EQ.0) THEN
            WRITE(lu,*) 'VARIABLE ',names_prive(i)(1:32),
     &                                   ' FOUND IN THE GEOMETRY FILE'
          ELSE
            WRITE(lu,*) 'VARIABLE ',names_prive(i)(1:32),
     &                               ' NOT FOUND IN THE GEOMETRY FILE'
          ENDIF
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!
! COMPUTES THE BOTTOM FRICTION COEFFICIENT
!
      IF(calfro) THEN
        CALL os('X=C     ', x=chestr, c=ffon)
      ENDIF
      CALL strche
!
!-----------------------------------------------------------------------
!
      RETURN
      END