projec.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE projec
!                       *****************
!
     &(x , y , zf , xrelv , yrelv , zrelv , nbat ,
     & nbor , nptfr , nfond , nbfond , fond , dm ,
     & fontri , cortri , maille,ngeo,kp1bor)
!
!***********************************************************************
! PROGICIEL : STBTEL V5.2         24/04/91    J-C GALLAND  (LNH)
!                                 09/11/94    P LANG / TRIGRID (LHF)
!                               07/96    P CHAILLET / FASTTABS (LHF)
!***********************************************************************
!
! FONCTION : INTERPOLATION DES FONDS SUR LE MAILLAGE
!
!----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________
! |      NOM       |MODE|                   ROLE
! |________________|____|______________________________________________
! |    X,Y         | -->|  COORDONNEES DES POINTS DU MAILLAGE
! |    ZF          |<-- |  COTES DU FOND
! |    XRELV,YRELV | -->|  COORDONNEES DES POINTS DE BATHY
! |    ZRELV       | -->|  COTES DES POINTS DE BATHY
! |    NBAT        | -->|  NOMBRE DE POINTS DE BATHY
! |    NBOR        | -->|  NUMEROTATION DES ELEMENTS DE BORD
! |    NPTFR       | -->|  NOMBRE DE POINTS FRONTIERE
! |    NFOND       | -->|  CANAUX DES FICHIERS DES FONDS
! |    NBFOND      | -->|  NOMBRE DE FICHIERS FONDS DONNES PAR
! |                |    |  L'UTILISATEUR (5 MAXI)
! |    FOND        | -->|  NOM DES FICHIERS DES FONDS
! |    DM          | -->|  DISTANCE MINIMALE A LA FRONTIERE
! |                |    |  POUR L'INTERPOLATION DES FONDS
! |    FONTRI      | -->|  INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
! |    CORTRI      | -->|  CORRECTION DES FONDS POUR TRIGRID
! |    MAILLE      | -->| NOM DU MAILLEUR UTILISE
! |                |    |
! | COMMON:        |    |
! |  GEO:          |    |
! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
! |                |    |
! |________________|____|______________________________________________
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!----------------------------------------------------------------------
!
! APPELE PAR : STBTEL
! APPEL DE : LECFON, FASP
!
!**********************************************************************
!
      USE declarations_special
      USE declarations_stbtel, ONLY: npoin
      USE interface_stbtel, ex_projec => projec
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: NPTFR, NBAT, NBFOND
      INTEGER, INTENT(IN) :: NFOND(*) , NBOR(nptfr,2)
      INTEGER, INTENT(IN) :: NGEO, KP1BOR(nptfr)
      DOUBLE PRECISION, INTENT(INOUT) :: XRELV(*) , YRELV(*) , ZRELV(*)
      DOUBLE PRECISION, INTENT(IN) :: X(*) , Y(*) , DM
      DOUBLE PRECISION, INTENT(IN) :: CORTRI
      DOUBLE PRECISION, INTENT(INOUT) :: ZF(*)
      CHARACTER(LEN=72), INTENT(IN) :: FOND(nbfond)
      CHARACTER(LEN=9), INTENT(IN) ::  MAILLE
      LOGICAL, INTENT(IN) :: FONTRI
!
      INTEGER I , NPT , IVOIS
      INTEGER NP(5)
      DOUBLE PRECISION DIST , DIST2
!
!=======================================================================
!  LECTURE DES FICHIERS DES FONDS
!=======================================================================
!
      CALL lecfon (xrelv,yrelv,zrelv,nbat,nfond,nbfond,np,npt,
     &             fontri,cortri,maille,ngeo)
!
      IF (.NOT.fontri) THEN
        IF (nbfond.NE.0) WRITE(lu,4000)
!
        DO i = 1,nbfond
          WRITE(lu,4100) i,fond(i),i,np(i)
        ENDDO
      ENDIF
!
!=======================================================================
!  DETERMINATION DE LA COTE DU FOND AU POINT I PAR INTERPOLATION
!  SUR LES POINTS NON EXTERIEURS AU DOMAINE
!=======================================================================
!
      CALL fasp (x,y,zf,npoin,xrelv,yrelv,zrelv,npt,nbor,kp1bor,
     &           nptfr,dm)
!
!=======================================================================
!  CERTAINS POINTS N'ONT PU ETRE TRAITES PAR FASP FAUTE DE DONNEES
!  LEUR PROFONDEUR A ETE MISE A -1.E6
!  ON AFFECTE A CES POINTS LA PROFONDEUR DE LEUR PLUS PROCHE VOISIN.
!=======================================================================
!
      DO i=1,npoin
        IF(zf(i).LT.-0.9d6) THEN
          dist = 1.d12
          DO ivois = 1 , npoin
            dist2 = ( x(i)-x(ivois) )**2 + ( y(i)-y(ivois) )**2
            IF(dist2.LT.dist.AND.zf(ivois).GT.-0.9d6) THEN
              dist = dist2
              zf(i) = zf(ivois)
            ENDIF
          ENDDO
          WRITE(lu,4200) i,x(i),y(i),zf(i)
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!
 4000 FORMAT(//,1x,'INTERPOLATION OF BOTTOM TOPOGRAPHY FROM :',/,
     &          1x,'-----------------------------------------',/)
 4100 FORMAT(1x,'BOTTOM ',i1,' : ',a72,/,
     &       1x,'NUMBER OF POINTS READ IN THE BOTTOM TOPOGRAPHY FILE ',
     &       i1,' : ',i6,/)
 4200 FORMAT('POINT : ',i5,' X = ',f10.1,' Y = ',f10.1,
     &       '  NO DATA , ZF : ',f8.2)
!
      RETURN
      END