fond.f

Go to the documentation of this file.

!                   ***************
                    SUBROUTINE fond
!                   ***************
!
     &(zf  ,x,y,npoin,nfon,nbor,kp1bor,nptfr)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    INITIALISES THE BOTTOM ELEVATION.
!
!history  J-M HERVOUET (LNHE)
!+        20/03/08
!+        V5P9
!+
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| NFON           |-->| LOGICAL UNIT OF FILE FOR BOTTOM BATHYMETRY
!| NPOIN          |-->| NUMBER OF POINTS
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| X              |-->| ABSCISSAE OF POINTS IN THE MESH
!| Y              |-->| ORDINATES OF POINTS IN THE MESH
!| ZF             |-->| ELEVATION OF BOTTOM
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_fond => fond
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NFON,NPOIN,NPTFR
      DOUBLE PRECISION, INTENT(OUT) :: ZF(npoin)
      DOUBLE PRECISION, INTENT(IN)  :: X(npoin),Y(npoin)
      INTEGER, INTENT(IN) :: NBOR(nptfr),KP1BOR(nptfr)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NP,ERR
!
      DOUBLE PRECISION BID
!
      CHARACTER(LEN=1) C
!
      DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: XRELV,YRELV,COTE
!
!-----------------------------------------------------------------------
!                    READS THE DIGITISED POINTS
!                      FROM LOGICAL UNIT NFON
!-----------------------------------------------------------------------
!
!  ASSESSES THE EXTENT OF DATA
!
      np = 0
20    READ(nfon,120,end=24,err=124) c
120   FORMAT(a1)
      IF(c(1:1).NE.'C'.AND.c(1:1).NE.'B') THEN
        backspace( unit = nfon )
        np = np + 1
        READ(nfon,*) bid,bid,bid
      ENDIF
      GO TO 20
124   CONTINUE
      WRITE(lu,19) np
19    FORMAT(1x,'FOND (BIEF)'
     &      ,/,1x,'ERROR IN THE BOTTOM FILE'
     &      ,/,1x,'AT LINE ',i7)
      CALL plante(1)
      stop
24    CONTINUE
!
!  DYNAMICALLY ALLOCATES THE ARRAYS
!
      ALLOCATE(xrelv(np),stat=err)
      ALLOCATE(yrelv(np),stat=err)
      ALLOCATE(cote(np) ,stat=err)
!
      IF(err.NE.0) THEN
        WRITE(lu,11) np
11      FORMAT(1x,'FOND (BIEF)'
     &      ,/,1x,'ERROR DURING ALLOCATION OF 3 ARRAYS'
     &      ,/,1x,'OF SIZE ',i7)
        CALL plante(1)
        stop
      ENDIF
!
!  READS THE DATA
!
      rewind(nfon)
      np = 0
23    READ(nfon,120,end=22,err=122) c
      IF(c(1:1).NE.'C'.AND.c(1:1).NE.'B') THEN
        backspace( unit = nfon )
        np = np + 1
        READ(nfon,*) xrelv(np) , yrelv(np) , cote(np)
      ENDIF
      GO TO 23
!
122   CONTINUE
      WRITE(lu,13) np
13    FORMAT(1x,'FOND (BIEF)'
     &      ,/,1x,'ERROR IN THE BOTTOM FILE'
     &      ,/,1x,'AT LINE ',i7)
      CALL plante(1)
      stop
!
22    CONTINUE
!
      WRITE(lu,113) np
113   FORMAT(1x,'FOND (BIEF):'
     &      ,/,1x,'NUMBER OF POINTS IN THE BOTTOM FILE: ',i7)
!
!-----------------------------------------------------------------------
!   THE BOTTOM ELEVATION IS COMPUTED BY INTERPOLATION ONTO THE
!                      DOMAIN INTERIOR POINTS
!-----------------------------------------------------------------------
!
      CALL fasp(x,y,zf,npoin,xrelv,yrelv,cote,np,nbor,kp1bor,nptfr,0.d0)
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(xrelv)
      DEALLOCATE(yrelv)
      DEALLOCATE(cote)
!
!-----------------------------------------------------------------------
!
      RETURN
      END