! copyright (c) 2008 Swedish Defence Research Agency (FOI) 
! may not be copied or distributed without written permission from FOI



C	this is a "standard shell" only,   fsubmodel & fsubaniso

C	Sven Ivansson 1990




	SUBROUTINE FSUBMODEL ( IFSMTYPLOK,ZLOK, UA2LOK,UB2LOK,RHOLOK )
C	input:    ifsmtyplok  model type, parameter continuity within each 
C                             model type is assumed
C	          zlok        depth in km
C	output:   ua2         "squared P-slowness" in (s/km)**2
C	          ub2         "squared S-slowness" in (s/km)**2
C	          rho         density in "10**12 kg"/(km**3)

	USE INMODELa

	IMPLICIT NONE

	INCLUDE 'RPPARAMETER.INC'
C	nol <= noldim

C	possible checks could be (using the usual layer index id) : 
C	  ifsmtyplok = ifsmtyp(id) > 0
C	  zd(id-1) <= zlok <= zd(id)
C	  nss < id <= nsw  --->  ub2lok := (0.0d0,0.0d0)

	INTEGER IFSMTYPLOK
	REAL*8 ZLOK

	REAL*8 RHOLOK
	COMPLEX*16 UA2LOK,UB2LOK

C	real*8 qfakt, aa,bb,dbla,dblb, slask
C	complex*16 cslask
C	qfakt = 20 * 3.141592653589793d0 * dlog10(dexp(1.0d0))
C
C	slask = (zlok-z0) / (z1-z0)
C	aa = (1-slask)*aa0 + slask*aa1
C	dbla = (1-slask)*dbla0 + slask*dbla1
C	cslask = dcmplx ( 1.0d0 , 0.5d0*dbla/qfakt ) / aa
C	ua2lok = cslask * cslask
C	bb = (1-slask)*bb0 + slask*bb1
C	dblb = (1-slask)*dblb0 + slask*dblb1
C	cslask = dcmplx ( 1.0d0 , 0.5d0*dblb/qfakt ) / bb
C	ub2lok = cslask * cslask
C	rholok = (1-slask)*rholok0 + slask*rholok1
C

	IF (IFSMTYPLOK.EQ.1) THEN
	  UA2LOK = DCMPLX ( 1/2.25D0 , 0.0D0 )    ! 1/1.5**2
	  UB2LOK = (0.0D0,0.0D0)
	  RHOLOK = 1.0D0
	ELSE IF (IFSMTYPLOK.EQ.2) THEN
	  UA2LOK = DCMPLX ( 1/9.0D0 , 0.0D0 )     ! 1/3.0**2
	  UB2LOK = DCMPLX ( 1/3.0D0 , 0.0D0 )     ! 1/(3.0/SQRT(3.0))**2
	  RHOLOK = 2.0D0
	ELSE
	  STOP 760
	END IF

	CALL U2AZIM ( UA2LOK, UA2LOK )
	CALL U2AZIM ( UB2LOK, UB2LOK )

ccc	%%% NOTE !!! NO TEST WITH U2TEST IS DONE !!! BEWARE OF THIS !!!
ccc	             TO BE "SAFE": RUN "RMPLOT" WHERE THIS TEST IS DONE

	RETURN
	END



	SUBROUTINE FSUBANISO ( IFSMTYPLOK,ZLOK, UA2LOK,UB2LOK,RHOLOK, 
     $	UC2LOK,UF2LOK )
C	input:    ifsmtyplok  model type, parameter continuity within each 
C                             model type is assumed
C	          zlok        depth in km
C	output:   ua2         "squared P-slowness" in (s/km)**2
C	          ub2         "squared S-slowness" in (s/km)**2
C	          rho         density in "10**12 kg"/(km**3)
C	          uc2         "squared C-slowness" in (s/km)**2
C	          uf2         "squared F-slowness" in (s/km)**2
C	( see White "Underground Sound" )

	USE INMODELa

	IMPLICIT NONE

	INCLUDE 'RPPARAMETER.INC'
C	nol <= noldim

C	possible checks could be (using the usual layer index id) : 
C	  ifsmtyplok = ifsmtyp(id) > 0
C	  zd(id-1) <= zlok <= zd(id)
C	  nss < id <= nsw  --->  ub2lok := (0.0d0,0.0d0)

	INTEGER IFSMTYPLOK
	REAL*8 ZLOK

	REAL*8 RHOLOK
	COMPLEX*16 UA2LOK,UB2LOK, UC2LOK,UF2LOK

	IF (IFSMTYPLOK.EQ.1) THEN
	  UA2LOK = DCMPLX ( 1/2.25D0 , 0.0D0 )    ! 1/1.5**2
	  UB2LOK = (0.0D0,0.0D0)
	  RHOLOK = 1.0D0
	  UC2LOK = UA2LOK
	  UF2LOK = UA2LOK
	ELSE IF (IFSMTYPLOK.EQ.2) THEN
	  UA2LOK = DCMPLX ( 1/9.0D0 , 0.0D0 )     ! 1/3.0**2
	  UB2LOK = DCMPLX ( 1/3.0D0 , 0.0D0 )     ! 1/(3.0/SQRT(3.0))**2
	  RHOLOK = 2.0D0
	  UC2LOK = UA2LOK
	  UF2LOK = 1/UA2LOK - 2/UB2LOK
	ELSE
	  STOP 760
	END IF

	CALL U2AZIM ( UA2LOK, UA2LOK )
	CALL U2AZIM ( UB2LOK, UB2LOK )
	CALL U2AZIM ( UC2LOK, UC2LOK )
	CALL U2AZIM ( UF2LOK, UF2LOK )

ccc	%%% NOTE !!! NO TEST WITH U2TEST IS DONE !!! BEWARE OF THIS !!!
ccc	             TO BE "SAFE": RUN "RMPLOT" WHERE THIS TEST IS DONE

	RETURN
	END
