Newer
Older
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
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ROUTINE Nov. 2006 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine strain_history (params,os,cl)
use definitions
implicit none
!------------------------------------------------------------------------------|
!(((((((((((((((( Purpose of the routine ))))))))))))))))))))))))))))))))))))))
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine arguments ))))))))))))))))))))
!------------------------------------------------------------------------------|
type (parameters) params
type (octreesolve) os
type (cloud) cl
!------------------------------------------------------------------------------|
!(((((((((((((((( declaration of the subroutine internal variables )))))))))))))
!------------------------------------------------------------------------------|
integer i,iproc,nproc,ierr,ni,nr
double precision dxyz,height
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
INCLUDE 'mpif.h'
call mpi_comm_size (mpi_comm_world,nproc,ierr)
call mpi_comm_rank (mpi_comm_world,iproc,ierr)
select case(trim(params%infile))
case('input.model1')
dxyz=2.d0**(-6)
do i=1,size(cl%x)
! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz ) cl%strain(i)=3.d0
if (abs(cl%y(i)-0.5d0)<dxyz/2.d0 .and. cl%z(i)<dxyz ) cl%strain(i)=3.d0
! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)<0.5d0) cl%strain(i)=3.5d0
! if (abs(cl%y(i)-(0.5d0-3.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)>0.5d0 .and. cl%x(i)<0.75d0) cl%strain(i)=3.5d0
! if (abs(cl%y(i)-(0.5d0+5.d0*dxyz/2.d0))<dxyz/2.d0 .and. cl%z(i)<dxyz .and. cl%x(i)>0.75d0) cl%strain(i)=3.5d0
end do
call update_cloud_structure (cl,os,params,ni,nr,0)
case('input.model2')
dxyz=1.2d0*2.d0**(-5)
height=7.d-2
do i=1,size(cl%x)
if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. &
cl%z(i).ge.height .and. &
cl%z(i).le.0.5d0*dxyz+height ) cl%strain(i)=4.5d0
! if (abs(cl%y(i)-(0.5d0+3.d0*dxyz/2.d0))<dxyz/2.d0 .and. &
! cl%z(i).ge.height .and. &
! cl%z(i).le.dxyz+height .and. &
! cl%x(i)<0.5d0 ) cl%strain(i)=3.5d0
! if (abs(cl%y(i)-(0.5d0-3.d0*dxyz/2.d0))<dxyz/2.d0 .and. &
! cl%z(i).ge.height .and. &
! cl%z(i).le.dxyz+height .and. &
! cl%x(i)>0.5d0 .and. &
! cl%x(i)<0.75d0 ) cl%strain(i)=3.5d0
! if (abs(cl%y(i)-(0.5d0+5.d0*dxyz/2.d0))<dxyz/2.d0 .and. &
! cl%z(i).ge.height .and. &
! cl%z(i).le.dxyz+height .and. &
! cl%x(i)>0.75d0 ) cl%strain(i)=3.5d0
end do
call update_cloud_structure (cl,os,params,ni,nr,0)
end select
end subroutine
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------