MAKE_MECH_PROP_CASE_060.f90 File Reference

Go to the source code of this file.

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

Function/Subroutine Documentation

make_mech_prop_case_060()

subroutine make_mech_prop_case_060	(	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,
		real*8, intent(in)	vs30,
		real*8, intent(in)	thickness,
		integer*4	sub_tag_all
	)

Makes not-honoring technique.

Mechanical properties given node by node.

Definition at line 23 of file MAKE_MECH_PROP_CASE_060.f90.

            
     real*8, intent(out) :: rho, lambda, mu, gamma, qs, qp
     real*8, intent(in)  :: xs, ys, zs, depth, zs_all, vs30, thickness
     integer*4           :: sub_tag_all                                                 
     real*8              :: ni, VS, VP, Depth_real, xLeft, xRight, yUp, yDown 
!     real*8, parameter   :: bufferLayer  = 6000.0d0   
            
     rho    = 0.d0;
     lambda = 0.d0;
     mu     = 0.d0;
     gamma  = 0.d0;
     qs     = 0.d0;
     qp     = 0.d0
     
     !left  top    629160.875000  9354624.000000   -32.000000
     !left  down   628957.563000  9262946.000000   443.000000
     !right top    739448.625000  9354298.000000   -28.000000
     !right down   739071.438000  9262575.000000   406.000000 
     
     xleft  = dabs(xs -  628957.563d0)
     xright = dabs(xs -  739448.625d0)
     yup    = dabs(ys - 9354624.000d0)
     ydown  = dabs(ys - 9262575.000d0)
 
                                
      if ((depth .ge. 0.0d0).and.(zs_all .ge. 0.0d0)) then
                                        if( (xleft.le.6000) .or. (xright.le.6000) .or. (yup.le.6000) .or. (ydown.le.6000) ) then
                                                        ! MATERIAL INSIDE THE BASIN MODIFIED AS OUTCROPPING BEDROCK 
                               vs  = 2300.d0
                                           vp  = 4100.d0
                                           rho = 2000.d0
                                           qs  = 150
                                           qp  = 283 
                                        else    
                                        ! MATERIAL INSIDE THE BASIN 
                                   vs  = 582.d0
                                   vp  = 1600.d0 
                           rho = 1200.d0            
                           qs  = 25
                           qp  = 44  
                        endif      
       else  
       ! OUTCROPPING BEDROCK 
              vs  = 2300.d0
              vp  = 4100.d0
              rho = 2000.d0
              qs  = 150
              qp  = 283            
      endif     
      
      lambda = rho * (vp**2 - 2*vs**2)
      mu = rho * vs**2 
      gamma = (3.1415*(2.d0/3.d0))/qs     
 

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: