interp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\interp.f
00002 !
00023                         SUBROUTINE INTERP
00024 !                       *****************
00025 !
00026      &(XINIT , YINIT , IKINIT , NPINIT , NEINIT ,
00027      & X , Y , NPOIN , NPMAX , SHP , ELT)
00028 !
00029 !***********************************************************************
00030 ! PROGICIEL : STBTEL  V5.2        24/04/91    J-C GALLAND  (LNH)
00031 !                               09/11/94    P LANG / TRIGRID (LHF)
00032 !***********************************************************************
00033 !
00034 ! FONCTION : INTERPOLATION DES FONDS SUR LE MAILLAGE
00035 !
00036 !----------------------------------------------------------------------
00037 !                             ARGUMENTS
00038 ! .________________.____.______________________________________________
00039 ! |      NOM       |MODE|                   ROLE
00040 ! |________________|____|______________________________________________
00041 ! |    X,Y         | -->|  COORDONNEES DES POINTS DU MAILLAGE
00042 ! |    ZF          |<-- |  COTES DU FOND
00043 ! |    XRELV,YRELV | -->|  COORDONNEES DES POINTS DE BATHY
00044 ! |    ZRELV       | -->|  COTES DES POINTS DE BATHY
00045 ! |    NBAT        | -->|  NOMBRE DE POINTS DE BATHY
00046 ! |    NBOR        | -->|  NUMEROTATION DES ELEMENTS DE BORD
00047 ! |    NPTFR       | -->|  NOMBRE DE POINTS FRONTIERE
00048 ! |    NFOND       | -->|  CANAUX DES FICHIERS DES FONDS
00049 ! |    NBFOND      | -->|  NOMBRE DE FICHIERS FONDS DONNES PAR
00050 ! |                |    |  L'UTILISATEUR (5 MAXI)
00051 ! |    FOND        | -->|  NOM DES FICHIERS DES FONDS
00052 ! |    DM          | -->|  DISTANCE MINIMALE A LA FRONTIERE
00053 ! |                |    |  POUR L'INTERPOLATION DES FONDS
00054 ! |    FONTRI      | -->|  INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
00055 ! |    CORTRI      | -->|  CORRECTION DES FONDS POUR TRIGRID
00056 ! |                |    |
00057 ! | COMMON:        |    |
00058 ! |  GEO:          |    |
00059 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00060 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00061 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00062 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00063 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00064 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00065 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00066 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00067 ! |                |    |
00068 ! |________________|____|______________________________________________
00069 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00070 !----------------------------------------------------------------------
00071 !
00072 ! APPELE PAR : STBTEL
00073 ! APPEL DE : LECFON, FASP
00074 !
00075 !**********************************************************************
00076 !
00077       IMPLICIT NONE
00078       INTEGER LNG,LU
00079       COMMON/INFO/LNG,LU
00080 !
00081       INTEGER IELEM , JELEM , NPINIT , NEINIT , IPOIN , NPOIN , NPMAX
00082       INTEGER IKINIT(NEINIT,3) , ELT(NPMAX)
00083 !
00084       DOUBLE PRECISION XINIT(NPINIT) , YINIT(NPINIT)
00085       DOUBLE PRECISION X(NPMAX) , Y(NPMAX) , SHP(NPMAX,3)
00086       DOUBLE PRECISION XP,YP,A1,A2,A3,C1,C2,X1,X2,X3,Y1,Y2,Y3
00087 !
00088 !=======================================================================
00089 !
00090       IF (LNG.EQ.1) WRITE(LU,2)
00091       IF (LNG.EQ.2) WRITE(LU,4)
00092 !
00093 2     FORMAT(//,1X,'INTERPOLATION DES DONNEES',/,
00094      &          1X,'-------------------------',/)
00095 4     FORMAT(//,1X,'DATA INTERPOLATION',/,
00096      &          1X,'------------------',/)
00097 !
00098       DO IPOIN = 1,NPOIN
00099 !
00100         XP = X(IPOIN)
00101         YP = Y(IPOIN)
00102         C1 = -999999.D0
00103 !
00104         DO IELEM = 1,NEINIT
00105           X1 = XINIT(IKINIT(IELEM,1))
00106           X2 = XINIT(IKINIT(IELEM,2))
00107           X3 = XINIT(IKINIT(IELEM,3))
00108           Y1 = YINIT(IKINIT(IELEM,1))
00109           Y2 = YINIT(IKINIT(IELEM,2))
00110           Y3 = YINIT(IKINIT(IELEM,3))
00111           A1 = (X3-X2)*(YP-Y2) - (Y3-Y2)*(XP-X2)
00112           A2 = (X1-X3)*(YP-Y3) - (Y1-Y3)*(XP-X3)
00113           A3 = (X2-X1)*(YP-Y1) - (Y2-Y1)*(XP-X1)
00114           IF (A1.GE.0.AND.A2.GE.0.AND.A3.GE.0) GOTO 30
00115           C2 = MIN(A1,A2,A3) / ((X3-X2)*(Y1-Y2)-(Y3-Y2)*(X1-X2))
00116           IF (C2.GT.C1) THEN
00117             C1 = C2
00118             JELEM = IELEM
00119           ENDIF
00120         ENDDO
00121 !
00122         IF (LNG.EQ.1) WRITE(LU,*) 'EXTRAPOLATION NECESSAIRE POUR ',
00123      &                            'LE POINT :',IPOIN
00124         IF (LNG.EQ.2) WRITE(LU,*) 'EXTRAPOLATION REQUIRED FOR ',
00125      &                            'THE NODE :',IPOIN
00126         IELEM = JELEM
00127         X1 = XINIT(IKINIT(IELEM,1))
00128         X2 = XINIT(IKINIT(IELEM,2))
00129         X3 = XINIT(IKINIT(IELEM,3))
00130         Y1 = YINIT(IKINIT(IELEM,1))
00131         Y2 = YINIT(IKINIT(IELEM,2))
00132         Y3 = YINIT(IKINIT(IELEM,3))
00133         A1 = (X3-X2)*(YP-Y2) - (Y3-Y2)*(XP-X2)
00134         A2 = (X1-X3)*(YP-Y3) - (Y1-Y3)*(XP-X3)
00135         A3 = (X2-X1)*(YP-Y1) - (Y2-Y1)*(XP-X1)
00136 !
00137 30      CONTINUE
00138         C1 = (X3-X2)*(Y1-Y2)-(Y3-Y2)*(X1-X2)
00139         SHP(IPOIN,1) = A1/C1
00140         SHP(IPOIN,2) = A2/C1
00141         SHP(IPOIN,3) = A3/C1
00142         ELT(IPOIN) = IELEM
00143 !
00144       ENDDO
00145 !
00146 !-----------------------------------------------------------------------
00147 !
00148       RETURN
00149       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0