ROck Physics Toolbox  1.0
A microgeodynamics-based toolkit for rock physics.
 All Classes Files Functions Variables
regional.f90
Go to the documentation of this file.
1 
13 MODULE regional
14  USE global
16 
17  TYPE region
18  INTEGER::NGRID
19  TYPE(composition)::comp
20  TYPE(unit_cell),DIMENSION(:),POINTER::CELL
21  TYPE(melt)::MAGMA
22  REAL(sp),DIMENSION(:,:),POINTER::LOC
23  REAL(sp),DIMENSION(:,:),POINTER::TOPO
24  END TYPE region
25 
26 
27 CONTAINS
28 
29  FUNCTION load_seismo(c,dim,fname,depth_in)
30  IMPLICIT NONE
31  TYPE(composition),INTENT(in)::c
32  INTEGER,INTENT(in)::dim
33  CHARACTER(len=*)::fname
34  REAL(sp),INTENT(in),OPTIONAL::depth_in
35  REAL(sp)::z,impedance350
36  REAL(sp),DIMENSION(:,:),POINTER::data
37  REAL(sp),DIMENSION(:,:),POINTER::x
38  TYPE(region)::load_seismo
39  INTEGER::ii
40 
49 
50  load_seismo%comp=c
51  load_seismo%NGRID=27
52 
53  ALLOCATE(DATA(load_seismo%NGRID,11),x(load_seismo%NGRID,3))
54  OPEN(10,file=fname,status='unknown',form='formatted')
55  DO ii=1,load_seismo%NGRID
56  READ(10,'(11(1x,es10.3))'),DATA(ii,:)
57  END DO
58  CLOSE(10)
59 
60  ALLOCATE(load_seismo%CELL(load_seismo%NGRID),&
61  &load_seismo%LOC(load_seismo%NGRID,3),&
62  &load_seismo%TOPO(load_seismo%NGRID,2))
63 
65  DO ii=1,load_seismo%NGRID
66  ! Location in Lat,Lon,Depth(km)
67  load_seismo%LOC(ii,1:3)=DATA(ii,1:3)
68 
69  !Depth of top of LVL and 410 in (km)
70  load_seismo%TOPO(ii,1:2)=DATA(ii,3:4)
71 
74  load_seismo%CELL(ii)%temperature=dble(load_seismo%comp&
75  &%potential_temperature)+depth2dt(DATA(ii,4))
76 
79  load_seismo%CELL(ii)%vs_sol=temp2vs(load_seismo%CELL(ii)&
80  &%temperature,load_seismo%comp%basalt_fraction)
81 
84  load_seismo%CELL(ii)%vp_sol=temp2vp(load_seismo%CELL(ii)&
85  &%temperature,&
86  &load_seismo%comp%basalt_fraction)
87 
90  load_seismo%CELL(ii)%rho=temp2rho(load_seismo%CELL(ii)&
91  &%temperature,&
92  &load_seismo%comp%basalt_fraction)
93  !Calculate the corresponding solid K,G, and nu
94  CALL vel2mod(load_seismo%CELL(ii)%vs_sol,load_seismo%CELL(ii)&
95  &%vp_sol,&
96  &load_seismo%CELL(ii)%rho,load_seismo%CELL(ii)%G_sol,&
97  &load_seismo%CELL(ii)%K_sol,load_seismo%CELL(ii)%nu )
100  impedance350=DATA(ii,8)
101  !Calculate vs from that
102  load_seismo%CELL(ii)%vs_obs=load_seismo%CELL(ii)%vs_sol&
103  &/(1.0-impedance350)
104 
105  !Impedance contrast at 410
106  load_seismo%CELL(ii)%vp_obs=DATA(ii,8)
107  END DO
108 
109  data=>null()
110  x=>null()
111  END FUNCTION load_seismo
112 
113  FUNCTION melt_calculate(reg)
114  IMPLICIT NONE
115  TYPE(region),INTENT(in)::reg
116  TYPE(region):: melt_calculate
117  INTEGER::ii
118 
138  melt_calculate=reg
139  DO ii=1,melt_calculate%NGRID
140  !! Calculate elastic constants of the melt
141  melt_calculate%CELL(ii)%rhol=melt_calculate%MAGMA%rho0*1.3275_sp
142  CALL vinet(melt_calculate%MAGMA%K0,&
143  &melt_calculate%CELL(ii)%rhol,melt_calculate%MAGMA%Kp,&
144  &melt_calculate%MAGMA%rho0,&
145  &melt_calculate%CELL(ii)%pressure,melt_calculate&
146  &%CELL(ii)%Kl)
147  !! Calculate melt volume fraction from the known vs
148  melt_calculate%CELL(ii)%melt_fraction=nonlinear_solve(0.0001_sp,&
149  &0.45_sp,&
150  &1.0e-4_sp,&
151  &melt_calculate%CELL(ii),melt_calculate%MAGMA)
152  END DO
153  WRITE(*,'(a,1x,es10.3,es10.3)'),'Pressure (Pa), melt density (kg/m^3):',melt_calculate%CELL(melt_calculate%NGRID)%pressure,melt_calculate%CELL(melt_calculate%NGRID)%rhol
154  END FUNCTION melt_calculate
155 
156 
157  SUBROUTINE vtk_write(reg,mod)
158  IMPLICIT NONE
159  TYPE(region),INTENT(in)::reg
160  TYPE(mantle),INTENT(in)::mod
161  CHARACTER(len=18)::fname
162  INTEGER::ii,n,nnodes
163 
165  fname=filename(1,'reg')
166  n=reg%NGRID
167  OPEN(10,file=fname,form='formatted')
168  WRITE(10,'(''# vtk DataFile Version 2.0'')')
169  WRITE(10,'(''Seismology data'')')
170  WRITE(10,'(''ASCII'')')
171  WRITE(10,'('' '')')
172  WRITE(10,'(''DATASET UNSTRUCTURED_GRID'')')
173 
174  WRITE(10,'("POINTS",i7,1x "float")'),n
175  DO ii=1,n ! write the position of the vertices
176  WRITE(10,'(3(1x,f20.7))'), reg%LOC(ii,1),reg%LOC(ii,2),0.0_sp
177  END DO
178  WRITE(10,'('' '')')
179  WRITE(10,'("POINT_DATA",i7)'),n
180 
181  WRITE(10,'("SCALARS LVL float ")')
182  WRITE(10,'("LOOKUP_TABLE default")')
183  DO ii=1,n
184  WRITE(10,'(1x,f12.5)'),reg%TOPO(ii,1)
185  END DO
186  WRITE(10,'("SCALARS TZ float ")')
187  WRITE(10,'("LOOKUP_TABLE default")')
188  DO ii=1,n
189  WRITE(10,'(1x,f12.5)'),reg%TOPO(ii,2)
190  END DO
191  WRITE(10,'("SCALARS Temperature float ")')
192  WRITE(10,'("LOOKUP_TABLE default")')
193  DO ii=1,n
194  WRITE(10,'(1x,f12.5)'),reg%CELL(ii)%temperature
195  END DO
196  WRITE(10,'("SCALARS vs_obs float ")')
197  WRITE(10,'("LOOKUP_TABLE default")')
198  DO ii=1,n
199  WRITE(10,'(1x,f12.5)'),reg%CELL(ii)%vs_obs
200  END DO
201  WRITE(10,'("SCALARS vs_sol float ")')
202  WRITE(10,'("LOOKUP_TABLE default")')
203  DO ii=1,n
204  WRITE(10,'(1x,f12.5)'),reg%CELL(ii)%vs_sol
205  END DO
206  WRITE(10,'("SCALARS melt float ")')
207  WRITE(10,'("LOOKUP_TABLE default")')
208  DO ii=1,n
209  WRITE(10,'(1x,f12.5)'),reg%CELL(ii)%melt_fraction
210  END DO
211 
212  CLOSE(10)
213  END SUBROUTINE vtk_write
214 
215 
216 
217 END MODULE regional