MAKE_MECH_PROP_CASE_021.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	make_mech_prop_case_021 (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_021()

subroutine make_mech_prop_case_021	(	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 24 of file MAKE_MECH_PROP_CASE_021.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         
              
     rho    = 0.d0;
     lambda = 0.d0;
     mu     = 0.d0;
     gamma  = 0.d0;
     qs     = 0.d0;
     qp     = 0.d0
     
     if(zs .lt. -2000) then
           vs = 2100 
           vp = 3500
           rho = 2200   
           lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
           mu = rho * vs**2.d0;
           qs = 0.1d0*vs;
           gamma = 4.d0*datan(1.d0)/qs;
     else
           if( vs30 .gt. 600.d0) then
               vs = vs30 + 5*dsqrt(depth)
               vp = vs*1.6d0
               rho = 1800.d0 + 5.d0*dsqrt(depth);  
               lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
               mu = rho * vs**2.d0;
               qs = 0.1d0*vs;
               gamma = 4.d0*datan(1.d0)/qs;
               
           elseif( vs30 .le. 600.d0 .and. zs_all .ge. 0.d0) then 
               vs = vs30 + 10*dsqrt(depth);
               vp = vs*1.6d0
               rho = 1530.d0 + 5.d0*dsqrt(depth);              
               mu = rho * vs**2.d0;
               qs = 0.1d0*vs;
               gamma = 4.d0*datan(1.d0)/qs;
               
           elseif( vs30 .le. 600.d0 .and. zs_all .lt. 0.d0) then 
               vs = 800 + 10*dsqrt(depth);
               vp  = 2000.d0 + 15.d0*dsqrt(depth);       
               rho = 1800.d0 +  5.d0*dsqrt(depth);             
               mu = rho * vs**2.d0;
               qs = 0.1d0*vs;
               gamma = 4.d0*datan(1.d0)/qs;
           endif
      endif     
 
     !left
     if(dabs(xs - 415552) .le. 2000.d0) then 
           vs = 2100 
           vp = 3500
           rho = 2200   
           lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
           mu = rho * vs**2.d0;
           qs = 0.1d0*vs;
           gamma = 4.d0*datan(1.d0)/qs;
!     !right
     elseif(dabs(xs - 484516) .le. 2000.d0) then 
           vs = 2100 
           vp = 3500
           rho = 2200   
           lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
           mu = rho * vs**2.d0;
           qs = 0.1d0*vs;
           gamma = 4.d0*datan(1.d0)/qs;
!     !up
     elseif(dabs(ys - 4447869) .le. 2000.d0) then 
           vs = 2100 
           vp = 3500
           rho = 2200   
           lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
           mu = rho * vs**2.d0;
           qs = 0.1d0*vs;
           gamma = 4.d0*datan(1.d0)/qs;
!     !down
     elseif(dabs(ys - 4379160) .le. 2000.d0) then 
           vs = 2100 
           vp = 3500
           rho = 2200   
           lambda = rho * (vp**2.d0 - 2.d0*vs**2.d0);       
           mu = rho * vs**2.d0;
           qs = 0.1d0*vs;
           gamma = 4.d0*datan(1.d0)/qs;
     endif      
     !if (check_case .eq. 1)   write(1000,*) xs,ys,zs, VS, VP       
     
 
         
              
              

Referenced by make_eltensor_for_cases().

Here is the caller graph for this function: