fasp.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\fasp.f
00002 !
00060                      SUBROUTINE FASP
00061 !                    ***************
00062 !
00063      &(X,Y,ZF,NPOIN,XRELV,YRELV,ZRELV,NP,NBOR,KP1BOR,NPTFR,DM)
00064 !
00065 !***********************************************************************
00066 ! BIEF   V6P1                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !| DM             |-->| MINIMUM DISTANCE TO BOUNDARY TO ACCEPT A POINT
00075 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00076 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00077 !| NP             |-->| NUMBER OF BATHYMETRY POINTS
00078 !| NPOIN          |-->| NUMBER OF POINTS IN THE MESH
00079 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00080 !| X,Y            |-->| MESH COORDINATES
00081 !| XRELV          |-->| ABCISSAE OF BATHYMETRY POINTS
00082 !| YRELV          |-->| ORDINATES OF BATHYMETRY POINTS
00083 !| ZF             |<--| INTERPOLATED BATHYMETRY
00084 !| ZRELV          |-->| ELEVATIONS OF BATHYMETRY POINTS
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !
00087       USE BIEF, EX_FASP => FASP
00088 !
00089       IMPLICIT NONE
00090       INTEGER LNG,LU
00091       COMMON/INFO/LNG,LU
00092 !
00093 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00094 !
00095       INTEGER, INTENT(IN) :: NPOIN,NP,NPTFR
00096       INTEGER, INTENT(IN) :: NBOR(NPTFR),KP1BOR(NPTFR)
00097       DOUBLE PRECISION, INTENT(IN)  :: X(NPOIN),Y(NPOIN),DM
00098       DOUBLE PRECISION, INTENT(IN)  :: XRELV(NP),YRELV(NP),ZRELV(NP)
00099       DOUBLE PRECISION, INTENT(OUT) :: ZF(NPOIN)
00100 !
00101 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00102 !
00103       INTEGER N,INUM,I
00104 !
00105       DOUBLE PRECISION DIST1,DIST2,DIST3,DIST4
00106       DOUBLE PRECISION ZCADR1,ZCADR2,ZCADR3,ZCADR4
00107       DOUBLE PRECISION DIFX,DIFY,DIST,X1,Y1,X2,Y2,X3,Y3,X4,Y4
00108       DOUBLE PRECISION ZNUM,ZDEN
00109 !
00110       LOGICAL OK1,OK2,OK3,OK4
00111 !
00112 !-----------------------------------------------------------------------
00113 !
00114 !  LOOP ON THE MESH NODES:
00115 !
00116       DO I = 1 , NPOIN
00117 !
00118 !     INTERPOLATES THE BOTTOM FROM 4 QUADRANTS
00119 !
00120 ! ---->  INITIALISES:
00121 !
00122       DIST1=1.D12
00123       DIST2=1.D12
00124       DIST3=1.D12
00125       DIST4=1.D12
00126 !
00127       OK1 = .FALSE.
00128       OK2 = .FALSE.
00129       OK3 = .FALSE.
00130       OK4 = .FALSE.
00131 !
00132       ZCADR1=0.D0
00133       ZCADR2=0.D0
00134       ZCADR3=0.D0
00135       ZCADR4=0.D0
00136 !
00137 ! --------->  LOOP ON THE SET OF POINTS (THERE ARE NP):
00138       DO N=1,NP
00139         DIFX = XRELV(N)-X(I)
00140         DIFY = YRELV(N)-Y(I)
00141         DIST = DIFX*DIFX + DIFY*DIFY
00142 !
00143         IF ( DIST.LT.1.D-6 ) DIST=1.D-6
00144 ! ->QUADRANT 1 :
00145           IF( DIFX.LE.0.D0.AND.DIFY.LE.0.D0) THEN
00146             IF(DIST.LE.DIST1)THEN
00147                  X1=XRELV(N)
00148                  Y1=YRELV(N)
00149                  DIST1=DIST
00150                  ZCADR1=ZRELV(N)
00151                  OK1 = .TRUE.
00152             ENDIF
00153 ! ->QUADRANT 2 :
00154         ELSE IF( DIFX.GE.0.D0.AND.DIFY.LE.0.D0) THEN
00155            IF(DIST.LE.DIST2)THEN
00156                 X2=XRELV(N)
00157                 Y2=YRELV(N)
00158                 DIST2=DIST
00159                 ZCADR2=ZRELV(N)
00160                 OK2 = .TRUE.
00161            ENDIF
00162 ! ->QUADRANT 3 :
00163         ELSE IF( DIFX.GE.0.D0.AND.DIFY.GE.0.D0) THEN
00164            IF(DIST.LE.DIST3)THEN
00165                 X3=XRELV(N)
00166                 Y3=YRELV(N)
00167                 DIST3=DIST
00168                 ZCADR3=ZRELV(N)
00169                 OK3 = .TRUE.
00170            ENDIF
00171 ! ->QUADRANT 4 :
00172         ELSE IF( DIFX.LE.0.D0.AND.DIFY.GE.0.D0) THEN
00173            IF(DIST.LE.DIST4)THEN
00174                 X4=XRELV(N)
00175                 Y4=YRELV(N)
00176                 DIST4=DIST
00177                 ZCADR4=ZRELV(N)
00178                 OK4 = .TRUE.
00179            ENDIF
00180         ENDIF
00181       ENDDO ! N
00182 !
00183 ! --------->  END OF LOOP ON THE SET OF POINTS
00184 !
00185       IF(OK1) CALL CROSFR(X(I),Y(I),X1,Y1,X,Y,NPOIN,NBOR,KP1BOR,
00186      &                    NPTFR,DM,OK1)
00187       IF(OK2) CALL CROSFR(X(I),Y(I),X2,Y2,X,Y,NPOIN,NBOR,KP1BOR,
00188      &                    NPTFR,DM,OK2)
00189       IF(OK3) CALL CROSFR(X(I),Y(I),X3,Y3,X,Y,NPOIN,NBOR,KP1BOR,
00190      &                    NPTFR,DM,OK3)
00191       IF(OK4) CALL CROSFR(X(I),Y(I),X4,Y4,X,Y,NPOIN,NBOR,KP1BOR,
00192      &                    NPTFR,DM,OK4)
00193 !
00194       ZNUM = 0.D0
00195       ZDEN = 0.D0
00196       INUM = 0
00197       IF(OK1) THEN
00198         ZNUM = ZNUM + ZCADR1/DIST1
00199         ZDEN = ZDEN + 1.D0/DIST1
00200         INUM = INUM + 1
00201       ENDIF
00202       IF(OK2) THEN
00203         ZNUM = ZNUM + ZCADR2/DIST2
00204         ZDEN = ZDEN + 1.D0/DIST2
00205         INUM = INUM + 1
00206       ENDIF
00207       IF(OK3) THEN
00208         ZNUM = ZNUM + ZCADR3/DIST3
00209         ZDEN = ZDEN + 1.D0/DIST3
00210         INUM = INUM + 1
00211       ENDIF
00212       IF(OK4) THEN
00213         ZNUM = ZNUM + ZCADR4/DIST4
00214         ZDEN = ZDEN + 1.D0/DIST4
00215         INUM = INUM + 1
00216       ENDIF
00217 !
00218       IF(INUM.NE.0) THEN
00219 !       ZF : WATER DEPTH AT THE POINT
00220         ZF(I)=ZNUM/ZDEN
00221       ELSE
00222         ZF(I) = -1.D6
00223       ENDIF
00224 !
00225       ENDDO ! I
00226 !
00227 !-----------------------------------------------------------------------
00228 !
00229       RETURN
00230       END

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