crosfr.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\crosfr.f
00002 !
00053                      SUBROUTINE CROSFR
00054 !                    *****************
00055 !
00056      &(X,Y,XR,YR,XMAIL,YMAIL,NPMAX,NBOR,KP1BOR,NPTFR,DM,OK)
00057 !
00058 !***********************************************************************
00059 ! BIEF   V6P1                                   21/08/2010
00060 !***********************************************************************
00061 !
00062 !
00063 !
00064 !
00065 !
00066 !
00067 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00068 !| DM             |-->| MINIMUM DISTANCE TO THE BOUNDARY
00069 !| KP1BOR         |-->| RANK OF THE NEXT POINT ALONG THE BOUNDARY
00070 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY NODES
00071 !| NPMAX          |-->| MAXIMUM NUMBER OF POINTS IN THE MESH
00072 !| NPTFR          |-->| NUMBER OF BOUNDARY NODES
00073 !| OK             |<--| IF YES, NO CROSSING OF BOUNDARY
00074 !|                |   | IF NO, POINT OUTSIDE THE DOMAIN
00075 !| X              |-->| ABSCISSA OF POINT WHERE TO INTERPOLATE
00076 !| Y              |   | ORDINATE OF POINT WHERE TO INTERPOLATE
00077 !| XMAIL          |-->| ABSCISSAE OF POINTS IN THE MESH
00078 !| YMAIL          |-->| ORDINATES OF POINTS IN THE MESH
00079 !| XR             |-->| ABSCISSA OF POINT TO BE USED FOR INTERPOLATION
00080 !| XR,YR          |-->| ORDINATE OF POINT TO BE USED FOR INTERPOLATION
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       IMPLICIT NONE
00084       INTEGER LNG,LU
00085       COMMON/INFO/LNG,LU
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       DOUBLE PRECISION, INTENT(IN) :: X,Y,XR,YR,DM
00090       INTEGER, INTENT(IN)          :: NPTFR,NPMAX
00091       DOUBLE PRECISION, INTENT(IN) :: XMAIL(NPMAX),YMAIL(NPMAX)
00092       INTEGER, INTENT(IN)          :: NBOR(NPTFR),KP1BOR(NPTFR)
00093       LOGICAL, INTENT(INOUT)       :: OK
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER KA
00098 !
00099       DOUBLE PRECISION DM2,XA,YA,XB,YB,DET,ALFA,BETA,EPS,DISTA2,DISTB2
00100 !
00101 !-----------------------------------------------------------------------
00102 !
00103 !     DOES NOT CONSIDER POINTS TOO CLOSE TO THE BOUNDARY
00104 !     DM     : MINIMUM DISTANCE
00105       DM2 = DM**2
00106 !
00107       DO KA=1,NPTFR
00108 !
00109 ! INTERSECTION OF A BOUNDARY SEGMENT AND THE SEGMENT
00110 ! FORMED BY THE POINTS (X,Y) AND (XR,YR)
00111 !
00112         XA = XMAIL(NBOR(KA))
00113         YA = YMAIL(NBOR(KA))
00114         XB = XMAIL(NBOR(KP1BOR(KA)))
00115         YB = YMAIL(NBOR(KP1BOR(KA)))
00116 !
00117         DET = (XR-X)*(YA-YB) - (YR-Y)*(XA-XB)
00118 !
00119         IF(ABS(DET).LT.1.D-6) CYCLE
00120 !
00121         ALFA = ( (XA-X)*(YA-YB) - (YA-Y)*(XA-XB) ) / DET
00122         BETA = ( (XR-X)*(YA-Y ) - (YR-Y)*(XA-X ) ) / DET
00123 !
00124         EPS=0.05D0
00125         IF(ALFA.GE.EPS.AND.ALFA.LE.1.D0-EPS.AND.
00126      &     BETA.GE.EPS.AND.BETA.LE.1.D0-EPS) THEN
00127           OK = .FALSE.
00128           EXIT
00129         ENDIF
00130 !
00131 ! ALSO ELIMINATES THE POINTS TOO CLOSE TO THE BOUNDARY
00132 !
00133         DISTA2 = (XR-XA)**2 + (YR-YA)**2
00134         DISTB2 = (XR-XB)**2 + (YR-YB)**2
00135         IF(DISTA2.LT.DM2.OR.DISTB2.LT.DM2) THEN
00136           OK = .FALSE.
00137           EXIT
00138         ENDIF
00139 !
00140       ENDDO ! KA
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       RETURN
00145       END

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