inclu2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\inclu2.f
00002 !
00047                      LOGICAL FUNCTION INCLU2
00048 !                    ***********************
00049 !
00050      &( C1 , C2 )
00051 !
00052 !***********************************************************************
00053 ! BIEF   V6P1                                   21/08/2010
00054 !***********************************************************************
00055 !
00056 !
00057 !
00058 !
00059 !
00060 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00061 !| C1             |-->| LIST OF WORDS SEPARATED BY A CHARACTER ELSE THAN
00062 !|                |   | A-Z AND 0-9
00063 !| C2             |-->| WORD LOOKED FOR IN C1
00064 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00065 !
00066       IMPLICIT NONE
00067       INTEGER LNG,LU
00068       COMMON/INFO/LNG,LU
00069 !
00070       CHARACTER*(*) C1 , C2
00071 !
00072       INTEGER I,IC1,LC1,LC2,IMAX
00073 !
00074       LOGICAL FLAG
00075 !
00076       INTRINSIC LEN
00077 !
00078 !-----------------------------------------------------------------------
00079 !
00080       INCLU2 = .FALSE.
00081 !
00082       LC1 = LEN(C1)
00083       LC2 = LEN(C2)
00084       IMAX = LC1-LC2
00085 !
00086       IF(IMAX.GE.0) THEN
00087 !
00088         DO I = 0,IMAX
00089           IF(C1(I+1:I+LC2).EQ.C2(1:LC2)) THEN
00090             FLAG = .TRUE.
00091             IF (I.NE.0) THEN
00092               IC1 = ICHAR(C1(I:I))
00093               IF ((IC1.GE.48.AND.IC1.LE.57).OR.
00094      &            (IC1.GE.65.AND.IC1.LE.90)) FLAG = .FALSE.
00095             ENDIF
00096             IF (I.NE.IMAX) THEN
00097               IC1 = ICHAR(C1(I+LC2+1:I+LC2+1))
00098               IF ((IC1.GE.48.AND.IC1.LE.57).OR.
00099      &            (IC1.GE.65.AND.IC1.LE.90)) FLAG = .FALSE.
00100             ENDIF
00101             INCLU2 = INCLU2.OR.FLAG
00102           ENDIF
00103         ENDDO ! I
00104 !
00105       ENDIF
00106 !
00107 !-----------------------------------------------------------------------
00108 !
00109       RETURN
00110       END

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