source: LMDZ5/trunk/tools/Max_diff_nc_with_lib/Jumble/Numerical/quadrat.f90 @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 913 bytes
Line 
1module quadrat_m
2
3  implicit none
4
5contains
6
7  subroutine quadrat(a, b, c, delta, root)
8
9    ! This subroutine computes the real roots of a quadratic equation
10    ! with real coefficients. If there is a double root, it appears in
11    ! double in the output array. If there are two distinct roots,
12    ! they are output in increasing order. If there is no real root,
13    ! the output array is undefined.
14
15    real, intent(in):: a, b, c
16    real, intent(out):: delta
17    real, intent(out):: root(:) ! (2)
18
19    ! Variables local to the procedure
20    real q
21
22    !---------------
23
24    delta = b**2 - 4. * a * c
25    if (delta == 0.) then
26       root = - b / 2 / a
27    else if (delta > 0.) then
28       q = - (b + sign(sqrt(delta), b)) / 2
29       root(1) = q / a
30       root(2) = c / q
31       ! Sort the roots:
32       if (root(1) > root(2)) root = root(2:1:-1)
33    end if
34
35  end subroutine quadrat
36
37end module quadrat_m
Note: See TracBrowser for help on using the repository browser.