Blame view

fvn_fnlib/ze1.f90 1.35 KB
26c292bb6   wdaniau   Contribution de S...
1
2
3
4
5
6
7
8
9
10
  function  ze1(z)
  !
  !       ====================================================
  !       Purpose: Compute complex exponential integral E1(z)
  !       Input :  z   --- Argument of E1(z)
  !       Output:  CE1 --- E1(z)
  !       ====================================================
  !
  ! Déclaration des variables en passage de paramètre
  !
8d883e8a1   wdaniau   Integration of ki...
11
  use fvn_common
26c292bb6   wdaniau   Contribution de S...
12
  implicit none
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
13
14
  complex(kind=dp_kind), intent(in) :: z
  complex(kind=dp_kind) :: ze1
26c292bb6   wdaniau   Contribution de S...
15
16
17
  !
  !  Déclaration des variables locales
  !
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
18
  integer(kind=ip_kind) :: k
8d883e8a1   wdaniau   Integration of ki...
19
  real(kind=dp_kind) :: x,a0
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
20
  complex(kind=dp_kind) :: cr,ct0,ct
8d883e8a1   wdaniau   Integration of ki...
21

26c292bb6   wdaniau   Contribution de S...
22
23
24
25
26
27
  !
  ! traitement en fonction des différents cas
  ! - Z nul entraîne E1 infini
  ! - module de Z inférieur à 10 ou 20 : formule log+gam+somme
  ! - module de Z supérieur à 10 ou 20 : formule asymptotique
  !
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
28
29
   x=real(z)
   a0=abs(z)
26c292bb6   wdaniau   Contribution de S...
30
   if (a0==0.0D0) then
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
31
     ze1 = cmplx(1.0D+300,0.0D0,dp_kind)
26c292bb6   wdaniau   Contribution de S...
32
   else if ((a0 <= 10.D0).or.(x <= 0.D0.and.a0 <= 20.D0)) then
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
33
34
     ze1 = cmplx(1.0D0,0.0D0,dp_kind)
     cr = cmplx(1.0D0,0.0D0,dp_kind)
26c292bb6   wdaniau   Contribution de S...
35
     k=0
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
36
     do while (abs(cr)>=abs(ze1)*1.0D-15)
26c292bb6   wdaniau   Contribution de S...
37
38
39
40
       k = k+1
       cr = -cr*k*z/(k+1.0D0)**2
       ze1 = ze1+cr
     end do
8d883e8a1   wdaniau   Integration of ki...
41
     ze1 = -fvn_el-log(z)+z*ze1
26c292bb6   wdaniau   Contribution de S...
42
   else
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
43
     ct0 = cmplx(0.0D0,0.0D0,dp_kind)
26c292bb6   wdaniau   Contribution de S...
44
45
46
47
     do k=120,1,-1
        ct0 = k/(1.0D0+k/(z+ct0))
     end do
     ct = 1.0D0/(z+ct0)
f6bacaf83   cwaterkeyn   ChW 11/09: ANSI c...
48
     ze1 = exp(-z)*ct
8d883e8a1   wdaniau   Integration of ki...
49
     if (x <= 0.D0 .AND. aimag(z) == 0.0d0) ze1 = ze1-fvn_pi*cmplx(0.D0,1.D0,dp_kind)
26c292bb6   wdaniau   Contribution de S...
50
51
52
53
   end if
  !
   return
  end function