forked from arnelg/qutipf90mc
/
qutraj_general.f90
132 lines (112 loc) · 3.04 KB
/
qutraj_general.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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
62
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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
module qutraj_general
!
! Global constants and general purpose subroutines
!
use qutraj_precision
implicit none
!
! Constants
!
! error params
integer, parameter :: blas_error_param = -23
! imaginary unit
complex(wp), parameter :: ii = (0._wp,1._wp)
!
! Interfaces
!
interface new
module procedure int_array_init
module procedure int_array_init2
module procedure wp_array_init
module procedure wp_array_init2
end interface
interface finalize
module procedure int_array_finalize
module procedure wp_array_finalize
end interface
contains
!
! Initializers and finalizers
!
subroutine int_array_init(this,n)
integer, allocatable, intent(inout) :: this(:)
integer, intent(in) :: n
integer :: istat
if (allocated(this)) then
deallocate(this,stat=istat)
endif
allocate(this(n),stat=istat)
if (istat.ne.0) then
call fatal_error("int_array_init: could not allocate.",istat)
endif
end subroutine
subroutine int_array_init2(this,val)
integer, allocatable, intent(inout) :: this(:)
integer, intent(in), dimension(:) :: val
call int_array_init(this,size(val))
this = val
end subroutine
subroutine wp_array_init(this,n)
real(wp), allocatable, intent(inout) :: this(:)
integer, intent(in) :: n
integer :: istat
if (allocated(this)) then
deallocate(this,stat=istat)
endif
allocate(this(n),stat=istat)
if (istat.ne.0) then
call fatal_error("sp_array_init: could not allocate.",istat)
endif
end subroutine
subroutine wp_array_init2(this,val)
real(wp), allocatable, intent(inout) :: this(:)
real(wp), intent(in), dimension(:) :: val
call wp_array_init(this,size(val))
this = val
end subroutine
subroutine int_array_finalize(this)
integer, allocatable, intent(inout) :: this(:)
integer :: istat=0
if (allocated(this)) then
deallocate(this,stat=istat)
endif
if (istat.ne.0) then
call error("int_array_finalize: could not deallocate.",istat)
endif
end subroutine
subroutine wp_array_finalize(this)
real(wp), allocatable, intent(inout) :: this(:)
integer :: istat=0
if (allocated(this)) then
deallocate(this,stat=istat)
endif
if (istat.ne.0) then
call error("wp_array_finalize: could not deallocate.",istat)
endif
end subroutine
!
! Error handling
!
subroutine error(errormsg,ierror)
character(len=*), intent(in), optional :: errormsg
integer, intent(in), optional :: ierror
if (present(errormsg)) then
write(*,*) 'error: ',errormsg
endif
if (present(ierror)) then
write(*,*) 'error flag=',ierror
endif
end subroutine
subroutine fatal_error(errormsg,ierror)
character(len=*), intent(in), optional :: errormsg
integer, intent(in), optional :: ierror
if (present(errormsg)) then
write(*,*) 'fatal error: ',errormsg
endif
if (present(ierror)) then
write(*,*) 'error flag=',ierror
endif
write(*,*) 'halting'
stop 1
end subroutine
end module