-
Notifications
You must be signed in to change notification settings - Fork 0
/
19-field.f90
181 lines (142 loc) · 5.01 KB
/
19-field.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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
module mo_field
use mo_syst
type, public :: tpfield
integer :: num !the number of the points in the field
real(8) :: unit_d !the unit of length of the field, which will be 1, if the ra is normalized
logical :: ra_flag = .false.
logical :: af_flag = .false.
real(8), pointer, dimension(:) :: la => null() !the boundry condition of the field
real(8), pointer, dimension(:,:) :: ra => null()
contains
procedure :: init_field => init_field
procedure :: clean_field => clean_field
end type
type, extends(tpfield), public :: tpfield_vec
integer :: degree !the dimensionality of the field
real(8), allocatable, dimension(:) :: unit_f !the unit of the field, which will be 1, if vector is normalized
real(8), pointer, dimension(:,:) :: ary => null() !the field
contains
procedure :: init_field => init_field_vec
procedure :: clean_field => clean_field_vec
end type
type, extends(tpfield), public :: tpfield_sca
real(8) :: unit_f
real(8), pointer, dimension(:) :: ary => null()
contains
procedure :: init_field => init_field_sca
procedure :: clean_field => clean_field_sca
end type
contains
subroutine init_field( this, all_flag )
implicit none
! para list
class(tpfield), intent(inout) :: this
logical, optional, intent(in) :: all_flag
!local
integer :: i
this%ra_flag = .false.
if( present( all_flag ) .and. all_flag .eqv. .true.) then
this%ra_flag = .true.
allocate( this%la(free) )
allocate( this%ra(free, this%num) )
this%la = 0.d0
do i = 1, free
this%ra(:,i) = 0.d0
end do
endif
end subroutine
subroutine init_field_sca( this, all_flag )
implicit none
! para list
class(tpfield_sca), intent(inout) :: this
logical, optional, intent(in) :: all_flag
!local
integer :: i
this%ra_flag = .false.
this%af_flag = .true.
if( present( all_flag ) .and. all_flag .eqv. .true.) then
this%ra_flag = .true.
allocate( this%la(free) )
allocate( this%ra(free, this%num) )
this%la = 0.d0
do i = 1, free
this%ra(:,i) = 0.d0
end do
endif
allocate( this%ary(this%num) )
this%ary = 0.d0
this%unit_f = 0.d0
end subroutine
subroutine init_field_vec( this, all_flag )
implicit none
! para list
class(tpfield_vec), intent(inout) :: this
logical, optional, intent(in) :: all_flag
!local
integer :: i
this%ra_flag = .false.
this%af_flag = .true.
if( present( all_flag ) .and. all_flag .eqv. .true.) then
this%ra_flag = .true.
allocate( this%la(free) )
allocate( this%ra(free, this%num) )
this%la = 0.d0
do i = 1, free
this%ra(:,i) = 0.d0
end do
endif
allocate( this%ary(this%degree, this%num) )
do i = 1, this%degree
this%ary(:,i) = 0.d0
end do
allocate( this%unit_f(this%degree) )
this%unit_f = 0.d0
end subroutine
subroutine clean_field( this )
implicit none
! para list
class(tpfield), intent(inout) :: this
if(this%ra_flag .eqv. .true.) then
deallocate( this%la )
deallocate( this%ra )
else
this%la => null()
this%ra => null()
end if
end subroutine
subroutine clean_field_sca( this )
implicit none
! para list
class(tpfield_sca), intent(inout) :: this
if(this%ra_flag .eqv. .true.) then
deallocate( this%la )
deallocate( this%ra )
else
this%la => null()
this%ra => null()
end if
if(this%af_flag .eqv. .true.) then
deallocate( this%ary )
else
this%ary => null()
end if
end subroutine
subroutine clean_field_vec( this )
implicit none
! para list
class(tpfield_vec), intent(inout) :: this
if(this%ra_flag .eqv. .true.) then
deallocate( this%la )
deallocate( this%ra )
else
this%la => null()
this%ra => null()
end if
if(this%af_flag .eqv. .true.) then
deallocate( this%ary )
deallocate( this%unit_f )
else
this%ary => null()
end if
end subroutine
end module