calcqb.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\calcqb.f
00002 !
00044                      SUBROUTINE CALCQB
00045 !                    *****************
00046 !
00047      &(Q1,Q2,Q3)
00048 !
00049 !***********************************************************************
00050 ! ARTEMIS   V6P1                                   21/08/2010
00051 !***********************************************************************
00052 !
00053 !
00054 !
00055 !
00056 !
00057 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00058 !| Q1             |-->| INITIAL LEFT EXTREMITY OF THE SEGMENT
00059 !| Q2             |-->| INITIAL RIGTH EXTREMITY OF THE SEGMENT
00060 !| Q3             |<--| APPROXIMATION FOR QB
00061 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00062 !
00063       IMPLICIT NONE
00064 !
00065       DOUBLE PRECISION Q1,Q2,Q3,FQ1,FQ2,FQ3,EPSIQB,RAP
00066 !
00067       EPSIQB = 1.D-4
00068       RAP = Q2
00069 !
00070       IF(Q2.GE.1.D0) THEN
00071         Q3 = 1.D0
00072       ELSE
00073         FQ3 = 1000.D0
00074 !
00075 ! 10      FQ1 = (1.D0-Q1)+RAP*LOG(Q1)
00076  10     FQ1 = (1.D0-Q1)+RAP*LOG(ABS(Q1))
00077         FQ2 = (1.D0-Q2)+RAP*LOG(ABS(Q2))
00078 !         FQ2 = (1.D0-Q2)+RAP*LOG(Q2)
00079         IF (FQ1.GE.0.D0) THEN
00080           Q3 = Q1
00081           FQ3 = EPSIQB/10.D0
00082         ELSE
00083           Q3 = Q1 - FQ1*(Q2-Q1)/(FQ2-FQ1)
00084           FQ3 = (1.D0-Q3)+RAP*LOG(ABS(Q3))
00085 !            FQ3 = (1.D0-Q3)+RAP*LOG(Q3)
00086           IF ((FQ3*FQ1).GT.0.D0) THEN
00087             Q1 = Q3
00088           ELSE
00089             Q2 = Q3
00090           ENDIF
00091         ENDIF
00092         IF(ABS(FQ3).GE.EPSIQB) GOTO 10
00093 !
00094       ENDIF
00095 !
00096 !-----------------------------------------------------------------------
00097 !
00098       RETURN
00099       END

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