MAKE_MECH_PROP_CASE_046.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	make_mech_prop_case_046 (rho, lambda, mu, gamma, qs, qp, xs, ys, zs, depth, zs_all)
	Makes not-honoring technique.

Function/Subroutine Documentation

make_mech_prop_case_046()

subroutine make_mech_prop_case_046	(	real*8, intent(out)	rho,
		real*8, intent(out)	lambda,
		real*8, intent(out)	mu,
		real*8, intent(out)	gamma,
		real*8, intent(out)	qs,
		real*8, intent(out)	qp,
		real*8, intent(in)	xs,
		real*8, intent(in)	ys,
		real*8, intent(in)	zs,
		real*8, intent(in)	depth,
		real*8, intent(in)	zs_all
	)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 25 of file MAKE_MECH_PROP_CASE_046.f90.

              
     real*8, intent(out) :: rho, lambda, mu, gamma, qs, qp
     real*8, intent(in)  :: xs, ys, zs, depth, zs_all
     real*8              :: ni, vs, vp, xabs, yabs         
     real*8, dimension(1) :: val1              
 
     ! Properties of bottom most velocity layer in this block
     ! Also Same properties are used near absorbing boundaries
     ! as poisson's ratio of top 3 layers is high
     rho    = 2600.d0;
     lambda = rho * (4000.d0**2.d0 - 2.d0*2200.d0**2.d0);
     mu     = rho * 2200.d0**2.d0;
     qs     = 400.d0;
     qp     = 680.d0;
     gamma  = 4.d0*datan(1.d0)*5.d0/qs;
     
    !-------------------------------------------------------------------
    ! Checking if node falls near Absorbing Boundaries,
    ! element size ~ 50m @ top. So buffer to Absorbing boundary is
    ! 18 elements (900m ~ 450m*2 larger elements at bottom)
    xabs = min((xs - 13000.d0), (66100.d0 - xs));
    yabs = min((ys - 23000.d0), (68900.d0 - ys));
 
                                        
    ! Material properties of top 3 layers are assigned based on 
    ! depth of node from topography surface.
    if ((depth .ge. 0.0d0) .and. (zs_all .ge. 0.0d0)) then     
      ! Node lies between topography surface (XYZ.out) and
      ! bottom surface (basin surface / ALL.out)
 
        if ((xabs .le. 900.d0) .or. (yabs .le. 900.d0) .or. (depth .gt. 300.0d0)) then 
          return
        endif
 
       if ((depth .ge. 0.0d0) .and. (depth .le. 50.0d0)) then 
            !Depth from Topography Surface  <= 50m
            vs = 500.d0;
            vp  = 1900.d0;
            rho = 1800.d0;
            lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
            mu = rho * vs**2.d0;
            qs = 100.d0;
            qp = 170.d0
            gamma = 4.d0*datan(1.d0)*5.d0/qs; 
 
       elseif ((depth .gt. 50.0d0) .and. (depth .le. 150.0d0)) then 
            !Depth from Topography Surface  50m to 150m
            vs = 900.d0;
            vp  = 2400.d0;
            rho = 2100.d0;
            lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
            mu = rho * vs**2.d0;
            qs = 180.d0;
            qp = 306.d0
            gamma = 4.d0*datan(1.d0)*5.d0/qs;       
             
       elseif ((depth .gt. 150.0d0) .and. (depth .le. 300.0d0)) then 
            !Depth from Topography Surface 150m to 300m
            vs = 1500.d0;
            vp  = 3400.d0;
            rho = 2500.d0;
            lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);
            mu = rho * vs**2.d0;
            qs = 300.d0;
            qp = 510.d0
            gamma = 4.d0*datan(1.d0)*5.d0/qs;
       endif
 
     endif
     

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: