hydromap.f

Go to the documentation of this file.

!                   *******************
                    SUBROUTINE hydromap
!                   *******************
!
     &(cn,x,y,npoin,ncn,nbor,kp1bor,nptfr)
!
!***********************************************************************
! BIEF   V7P2
!***********************************************************************
!
!brief    INTERPOLATE CN (CURVE NUMBER, RUNOFF PARAMETER) ON THE MESH
!         (INSPIRED FROM SUBROUTINE FOND (BIEF))
!
!history  RIADH ATA (LNHE)
!+        29/06/16
!+        V7P2
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
!| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
!| NCN            |-->| LOGICAL UNIT OF FILE FOR CN VALUES
!| NPOIN          |-->| NUMBER OF POINTS
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| X              |-->| ABSCISSAE OF POINTS IN THE MESH
!| Y              |-->| ORDINATES OF POINTS IN THE MESH
!| CN             |<--| INTERPOLATED CN VALUES
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_hydromap => hydromap
      USE declarations_special
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN)    :: NCN,NPOIN,NPTFR
      DOUBLE PRECISION, INTENT(INOUT) :: CN(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,LUCN
!
!-----------------------------------------------------------------------
!                    READS THE DIGITISED POINTS
!                      FROM LOGICAL UNIT NCN
!-----------------------------------------------------------------------
!
      CALL ov('X=C     ',x=cn, c=0.d0, dim1=npoin)
!
!  ASSESSES THE EXTENT OF DATA
!
      np = 0
20    READ(ncn,120,end=24,err=124) c
120   FORMAT(a1)
      IF(c(1:1).NE.'#') THEN
        backspace( unit = ncn )
        np = np + 1
        READ(ncn,*) bid,bid,bid
      ENDIF
      GO TO 20
124   CONTINUE
      WRITE(lu,19) np
19    FORMAT(1x,'HYDROMAP (BIEF):'
     &      ,/,1x,'ERROR IN THE CURVE NUMBERS 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(lucn(np) ,stat=err)
!
      IF(err.NE.0) THEN
        WRITE(lu,11) np
11      FORMAT(1x,'HYDROMAP (BIEF):'
     &      ,/,1x,'ERROR DURING ALLOCATION OF 3 ARRAYS'
     &      ,/,1x,'OF SIZE ',i7)
        CALL plante(1)
        stop
      ENDIF
!
!  READS THE DATA
!
      rewind(ncn)
      np = 0
23    READ(ncn,120,end=22,err=122) c
      IF(c(1:1).NE.'#') THEN
        backspace( unit = ncn )
        np = np + 1
        READ(ncn,*) xrelv(np) , yrelv(np) , lucn(np)
      ENDIF
      GO TO 23
!
122   CONTINUE
      WRITE(lu,13) np
13    FORMAT(1x,'HYDROMAP (BIEF):'
     &      ,/,1x,'ERROR IN THE CURVE NUMBERS FILE'
     &      ,/,1x,'AT LINE ',i7)
      CALL plante(1)
      stop
!
22    CONTINUE
!
      WRITE(lu,113) np
113   FORMAT(1x,'HYDROMAP (BIEF):'
     &      ,/,1x,'NUMBER OF POINTS IN THE CURVE NUMBERS FILE:',i7
     &      ,/,1x,'INTERPOLATING ........')
!
!-----------------------------------------------------------------------
!   THE BOTTOM ELEVATION IS COMPUTED BY INTERPOLATION ONTO THE
!                      DOMAIN INTERIOR POINTS
!-----------------------------------------------------------------------
!
      CALL fasp(x,y,cn,npoin,xrelv,yrelv,lucn,np,nbor,kp1bor,nptfr,0.d0)
!
!-----------------------------------------------------------------------
!
!     VERIFICATION
!      DO NP=1,10
!        WRITE(LU,*)'DANS HYDROMAP:',CN(NP),LUCN(NP)
!      ENDDO
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(xrelv)
      DEALLOCATE(yrelv)
      DEALLOCATE(lucn)
!
!-----------------------------------------------------------------------
!
      RETURN
      END