bornes.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\bornes.f
00002 !
00059                      SUBROUTINE BORNES
00060 !                    *****************
00061 !
00062      &( B     , N     , A     , XM    , X0    , X1    )
00063 !
00064 !***********************************************************************
00065 ! TOMAWAC   V6P1                                   08/06/2011
00066 !***********************************************************************
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !| A              |-->| PARAMETER A OF THE FUNCTION TO INTGRATE
00075 !| B              |-->| PARAMETER B OF THE FUNCTION TO INTGRATE
00076 !| N              |-->| EXPONENT N OF THE FUNCTION TO INTGRATE
00077 !| X0             |<--| LOWER BOUND OF THE INTERVAL
00078 !| X1             |<--| UPPER BOUND OF THE INTERVAL
00079 !| XM             |-->| PARAMETER XM OF THE FUNCTION TO INTGRATE
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !
00082       IMPLICIT NONE
00083 !
00084       INTEGER LNG,LU
00085       COMMON/INFO/ LNG,LU
00086 !
00087 !     VARIABLES IN ARGUMENT
00088 !     """""""""""""""""""""
00089       INTEGER  N
00090       DOUBLE PRECISION B     , A     , XM    , X0    , X1
00091 !
00092 !     LOCAL VARIABLES
00093 !     """"""""""""""""""
00094       INTEGER  I0    , I1    , II    , JJ    , IMAX  , INP
00095       DOUBLE PRECISION X(11) , Y(11) , EPS   , EPS1  , DX
00096 !
00097 !.....EXTERNAL FUNCTIONS
00098 !     """"""""""""""""""
00099       DOUBLE PRECISION  FONCRO
00100       EXTERNAL          FONCRO
00101 !
00102 !
00103       I1  = 11
00104       I0  = 1
00105       X(I0)= 0.D0
00106       X(I1)= 20.D0
00107       Y(1) = 0.D0
00108       EPS1 = 0.01D0
00109       EPS  = 0.0001D0
00110       INP  = 0
00111 !
00112       DO II=1,20
00113         DX = (X(I1)-X(I0))/10.D0
00114         X(1) = X(I0)
00115         IMAX = 0
00116         I0   = 1
00117         I1   = 11
00118         DO JJ=2,11
00119           X(JJ)=X(JJ-1)+DX
00120           Y(JJ)=FONCRO(X(JJ),B,N,A,XM)
00121           IF(Y(JJ).EQ.0.D0.AND.JJ.EQ.2.AND.INP.EQ.0D0) THEN
00122             X(I1) = X(I1)/10.D0
00123             INP   = 1
00124             GOTO 10
00125           END IF
00126           IF(Y(JJ).LT.Y(JJ-1)) THEN
00127             IF(IMAX.EQ.0) THEN
00128               IMAX = JJ-1
00129               EPS  = EPS1*Y(IMAX)
00130             END IF
00131             IF (Y(JJ).LT.EPS) THEN
00132               I1 = JJ
00133               EXIT
00134             END IF
00135           ELSEIF(IMAX.EQ.0.AND.Y(JJ).LT.EPS.AND.JJ.NE.2) THEN
00136             I0 = JJ
00137           END IF
00138         END DO
00139         IF((I1-I0).GT.2) EXIT
00140    10   CONTINUE
00141       ENDDO ! II
00142 !
00143       X0 = X(I0)
00144       X1 = X(I1)
00145 !
00146       RETURN
00147       END

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