fasp.f

Go to the documentation of this file.

!                   ***************
                    SUBROUTINE fasp
!                   ***************
!
     &(x,y,zf,npoin,xrelv,yrelv,zrelv,np,nbor,kp1bor,nptfr,dm)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    INTERPOLATES THE BOTTOM ELEVATIONS FROM A SET OF
!+                POINTS ON THE MESH NODES.
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DM             |-->| MINIMUM DISTANCE TO BOUNDARY TO ACCEPT A POINT
!| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| NP             |-->| NUMBER OF BATHYMETRY POINTS
!| NPOIN          |-->| NUMBER OF POINTS IN THE MESH
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| X,Y            |-->| MESH COORDINATES
!| XRELV          |-->| ABCISSAE OF BATHYMETRY POINTS
!| YRELV          |-->| ORDINATES OF BATHYMETRY POINTS
!| ZF             |<--| INTERPOLATED BATHYMETRY
!| ZRELV          |-->| ELEVATIONS OF BATHYMETRY POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_fasp => fasp
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN,NP,NPTFR
      INTEGER, INTENT(IN) :: NBOR(nptfr),KP1BOR(nptfr)
      DOUBLE PRECISION, INTENT(IN)  :: X(npoin),Y(npoin),DM
      DOUBLE PRECISION, INTENT(IN)  :: XRELV(np),YRELV(np),ZRELV(np)
      DOUBLE PRECISION, INTENT(OUT) :: ZF(npoin)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER N,INUM,I
!
      DOUBLE PRECISION DIST1,DIST2,DIST3,DIST4
      DOUBLE PRECISION ZCADR1,ZCADR2,ZCADR3,ZCADR4
      DOUBLE PRECISION DIFX,DIFY,DIST,X1,Y1,X2,Y2,X3,Y3,X4,Y4
      DOUBLE PRECISION ZNUM,ZDEN
!
      LOGICAL OK1,OK2,OK3,OK4
!
!-----------------------------------------------------------------------
!
!  LOOP ON THE MESH NODES:
!
      DO i = 1 , npoin
!
!     INTERPOLATES THE BOTTOM FROM 4 QUADRANTS
!
! ---->  INITIALISES:
!
      dist1=1.d12
      dist2=1.d12
      dist3=1.d12
      dist4=1.d12
!
      ok1 = .false.
      ok2 = .false.
      ok3 = .false.
      ok4 = .false.
!
      zcadr1=0.d0
      zcadr2=0.d0
      zcadr3=0.d0
      zcadr4=0.d0
!
! --------->  LOOP ON THE SET OF POINTS (THERE ARE NP):
      DO n=1,np
        difx = xrelv(n)-x(i)
        dify = yrelv(n)-y(i)
        dist = difx*difx + dify*dify
!
        IF ( dist.LT.1.d-6 ) dist=1.d-6
! ->QUADRANT 1 :
          IF( difx.LE.0.d0.AND.dify.LE.0.d0) THEN
            IF(dist.LE.dist1)THEN
              x1=xrelv(n)
              y1=yrelv(n)
              dist1=dist
              zcadr1=zrelv(n)
              ok1 = .true.
            ENDIF
! ->QUADRANT 2 :
        ELSE IF( difx.GE.0.d0.AND.dify.LE.0.d0) THEN
          IF(dist.LE.dist2)THEN
            x2=xrelv(n)
            y2=yrelv(n)
            dist2=dist
            zcadr2=zrelv(n)
            ok2 = .true.
          ENDIF
! ->QUADRANT 3 :
        ELSE IF( difx.GE.0.d0.AND.dify.GE.0.d0) THEN
          IF(dist.LE.dist3)THEN
            x3=xrelv(n)
            y3=yrelv(n)
            dist3=dist
            zcadr3=zrelv(n)
            ok3 = .true.
          ENDIF
! ->QUADRANT 4 :
        ELSE IF( difx.LE.0.d0.AND.dify.GE.0.d0) THEN
          IF(dist.LE.dist4)THEN
            x4=xrelv(n)
            y4=yrelv(n)
            dist4=dist
            zcadr4=zrelv(n)
            ok4 = .true.
          ENDIF
        ENDIF
      ENDDO ! N
!
! --------->  END OF LOOP ON THE SET OF POINTS
!
      IF(ok1) CALL crosfr(x(i),y(i),x1,y1,x,y,npoin,nbor,kp1bor,
     &                    nptfr,dm,ok1)
      IF(ok2) CALL crosfr(x(i),y(i),x2,y2,x,y,npoin,nbor,kp1bor,
     &                    nptfr,dm,ok2)
      IF(ok3) CALL crosfr(x(i),y(i),x3,y3,x,y,npoin,nbor,kp1bor,
     &                    nptfr,dm,ok3)
      IF(ok4) CALL crosfr(x(i),y(i),x4,y4,x,y,npoin,nbor,kp1bor,
     &                    nptfr,dm,ok4)
!
      znum = 0.d0
      zden = 0.d0
      inum = 0
      IF(ok1) THEN
        znum = znum + zcadr1/dist1
        zden = zden + 1.d0/dist1
        inum = inum + 1
      ENDIF
      IF(ok2) THEN
        znum = znum + zcadr2/dist2
        zden = zden + 1.d0/dist2
        inum = inum + 1
      ENDIF
      IF(ok3) THEN
        znum = znum + zcadr3/dist3
        zden = zden + 1.d0/dist3
        inum = inum + 1
      ENDIF
      IF(ok4) THEN
        znum = znum + zcadr4/dist4
        zden = zden + 1.d0/dist4
        inum = inum + 1
      ENDIF
!
      IF(inum.NE.0) THEN
!       ZF : WATER DEPTH AT THE POINT
        zf(i)=znum/zden
      ELSE
        zf(i) = -1.d6
      ENDIF
!
      ENDDO ! I
!
!-----------------------------------------------------------------------
!
      RETURN
      END