ieps.f90 2.5 KB
Newer Older
ulrich_y's avatar
ulrich_y committed
1 2 3 4 5 6 7 8 9 10 11 12

MODULE ieps
  use globals
  implicit none
  type inum
    complex(kind=prec) :: c
    integer(8) :: i0
  end type inum

  integer(8), parameter :: di0 = +1

  type(inum), parameter :: izero=inum( 0.,di0)
ulrich_y's avatar
ulrich_y committed
13
  type(inum), parameter :: marker=inum(0.,5)
ulrich_y's avatar
ulrich_y committed
14 15 16 17 18


  interface abs
    module procedure absinum, absinumv
  end interface abs
ulrich_y's avatar
ulrich_y committed
19

ulrich_y's avatar
ulrich_y committed
20 21 22
  interface toinum
    module procedure toinum_cmplx, toinum_real, toinum_int
  end interface toinum
ulrich_y's avatar
ulrich_y committed
23 24 25
  interface tocmplx
    module procedure tocmplxv, tocmplxs
  end interface tocmplx
26 27 28
  interface real
    module procedure realis, realiv
  end interface real
ulrich_y's avatar
ulrich_y committed
29 30 31
  interface aimag
    module procedure imags, imagv
  end interface aimag
ulrich_y's avatar
ulrich_y committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
CONTAINS
  FUNCTION ABSINUM(n1)
  implicit none
  type(inum), intent(in) :: n1
  real(kind=prec) :: absinum
  absinum = sqrt(real(n1%c)**2+aimag(n1%c)**2)
  END FUNCTION ABSINUM

  FUNCTION ABSINUMV(n1)
  implicit none
  type(inum), intent(in) :: n1(:)
  real(kind=prec) :: absinumv(size(n1))
  absinumv = abs(n1%c)
  END FUNCTION ABSINUMV

  FUNCTION TOINUM_cmplx(z, s)
  complex(kind=prec) :: z(:)
  type(inum) :: toinum_cmplx(size(z))
  integer(8),optional :: s
  integer(8) :: ss
  integer i
  if (present(s)) then
    ss = s
  else
    ss = di0
  endif
  do i=1,size(z)
    toinum_cmplx(i) = inum(z(i), ss)
  enddo
  END FUNCTION TOINUM_cmplx
ulrich_y's avatar
ulrich_y committed
62

ulrich_y's avatar
ulrich_y committed
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
  FUNCTION TOINUM_real(z, s)
  real(kind=prec) :: z(:)
  type(inum) :: toinum_real(size(z))
  integer(8),optional :: s
  integer(8) :: ss
  integer i
  if (present(s)) then
    ss = s
  else
    ss = di0
  endif
  do i=1,size(z)
    toinum_real(i) = inum(z(i), ss)
  enddo
  END FUNCTION TOINUM_real


  FUNCTION TOINUM_int(z, s)
  integer :: z(:)
  type(inum) :: toinum_int(size(z))
  integer(8),optional :: s
  integer(8) :: ss
  integer i
  if (present(s)) then
    ss = s
  else
    ss = di0
  endif
  do i=1,size(z)
    toinum_int(i) = inum(z(i), ss)
  enddo
  END FUNCTION TOINUM_int

ulrich_y's avatar
ulrich_y committed
96 97 98 99 100 101 102 103 104 105 106
  FUNCTION TOCMPLXv(z)
  type(inum) :: z(:)
  complex(kind=prec) tocmplxv(size(z))
  tocmplxv = z%c
  END FUNCTION
  FUNCTION TOCMPLXs(z)
  type(inum) :: z
  complex(kind=prec) tocmplxs
  tocmplxs = z%c
  END FUNCTION

ulrich_y's avatar
ulrich_y committed
107

108 109 110 111 112 113 114 115 116 117 118
  FUNCTION REALIV(z)
  type(inum) :: z(:)
  real(kind=prec) realiv(size(z))
  realiv = real(z%c)
  END FUNCTION
  FUNCTION REALIS(z)
  type(inum) :: z
  real(kind=prec) realis
  realis = real(z%c)
  END FUNCTION

ulrich_y's avatar
ulrich_y committed
119 120 121 122 123 124 125 126 127 128 129
  FUNCTION IMAGV(z)
  type(inum) :: z(:)
  real(kind=prec) imagv(size(z))
  imagv = aimag(z%c)
  END FUNCTION
  FUNCTION IMAGS(z)
  type(inum) :: z
  real(kind=prec) imags
  imags = aimag(z%c)
  END FUNCTION

ulrich_y's avatar
ulrich_y committed
130
END MODULE IEPS