Newer
Older
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ||===\\ |
! || \\ |
! || || //==\\ || || //==|| ||/==\\ |
! || || || || || || || || || || |
! || // || || || || || || || |
! ||===// \\==// \\==\\ \\==\\ || |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
! |
! ROUTINE Nov. 2006 |
! |
!------------------------------------------------------------------------------|
!------------------------------------------------------------------------------|
subroutine strain_history (params,os,cl)
use definitions
!use mpi
include 'mpif.h'
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
!------------------------------------------------------------------------------|
!(((((((((((((((( 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
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
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
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------