calcqb.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE calcqb
!                   *****************
!
     &(q1,q2,q3)
!
!***********************************************************************
! ARTEMIS   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    COMPUTES THE SQUARE ROOT OF THE TRANSCENDENT EQUATION
!+               IN QB, WHICH IS THE RATE OF BREAKING OR BROKEN WAVES.
!+
!
!history  D. AELBRECHT (LNH)
!+        04/06/1999
!+        V5P1
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| Q1             |-->| INITIAL LEFT EXTREMITY OF THE SEGMENT
!| Q2             |-->| INITIAL RIGTH EXTREMITY OF THE SEGMENT
!| Q3             |<--| APPROXIMATION FOR QB
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      DOUBLE PRECISION Q1,Q2,Q3,FQ1,FQ2,FQ3,EPSIQB,RAP
!
      epsiqb = 1.d-4
      rap = q2
!
      IF(q2.GE.1.d0) THEN
        q3 = 1.d0
      ELSE
        fq3 = 1000.d0
!
! 10      FQ1 = (1.D0-Q1)+RAP*LOG(Q1)
 10     fq1 = (1.d0-q1)+rap*log(abs(q1))
        fq2 = (1.d0-q2)+rap*log(abs(q2))
!         FQ2 = (1.D0-Q2)+RAP*LOG(Q2)
        IF (fq1.GE.0.d0) THEN
          q3 = q1
          fq3 = epsiqb/10.d0
        ELSE
          q3 = q1 - fq1*(q2-q1)/(fq2-fq1)
          fq3 = (1.d0-q3)+rap*log(abs(q3))
!            FQ3 = (1.D0-Q3)+RAP*LOG(Q3)
          IF ((fq3*fq1).GT.0.d0) THEN
            q1 = q3
          ELSE
            q2 = q3
          ENDIF
        ENDIF
        IF(abs(fq3).GE.epsiqb) GOTO 10
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END