12 real,
pointer:: radii(:,:,:)
13 real,
pointer:: temperature(:,:,:)
14 real:: initial_temperature=1.0
15 real:: outside_temperature=2.0
20 procedure:: boundary_condition
28 SUBROUTINE init (self)
30 integer:: m(6), i1, i2, i3, it
32 call trace%begin(
'solver_t%init')
40 call self%patch_t%init
41 self%temperature => self%mem(:,:,:,1,1,1)
42 self%temperature = self%initial_temperature
48 allocate (self%radii(m(1),m(2),m(3)))
56 self%radii(i1,i2,i3) = sqrt((self%mesh(1)%p + self%mesh(1)%r(i1))**2 + &
57 (self%mesh(2)%p + self%mesh(2)%r(i2))**2 + &
58 (self%mesh(3)%p + self%mesh(3)%r(i3))**2)
65 call self%boundary_condition (1)
72 SUBROUTINE boundary_condition (self, it)
75 real,
pointer,
contiguous:: f(:,:,:)
77 call trace%begin(
'solver_t%boundary_condition')
79 f => self%mem(:,:,:,1,it,1)
80 where (self%radii > self%radius)
81 f = self%outside_temperature
84 END SUBROUTINE boundary_condition
89 SUBROUTINE update (self)
91 real,
pointer,
contiguous:: v(:,:,:)
92 real,
allocatable:: d2f(:,:,:)
93 integer:: m(3), i1, i2, i3
94 integer,
save:: itimer=0
96 call trace%begin(
'solver_t%update', itimer=itimer)
101 v => self%mem(:,:,:,1,self%new,1)
102 v = self%mem(:,:,:,1,self%it ,1)
103 call self%boundary_condition (self%new)
108 allocate (d2f(m(1),m(2),m(3)))
113 do i3=self%mesh(3)%li,self%mesh(3)%ui
114 do i2=self%mesh(2)%li,self%mesh(2)%ui
115 do i1=self%mesh(1)%li,self%mesh(1)%ui
116 d2f(i1,i2,i3) = v(i1+1,i2 ,i3 ) &
129 self%dtime = self%courant
130 v = v + self%dtime*d2f
131 call self%boundary_condition (self%new)
136 call self%counter_update
137 call trace%end (itimer)
138 END SUBROUTINE update
This module contains all experiment specific information necessary to solve the heat diffusion proble...