 !Program to test calling the SLBM_Fort_shell interface from Fortran
program SLBMshell_ftest
	character (len = 80) model_name
	character (len = 80) data_file_name
	character (len = 1000) line
	character (len = 10) version
	character (len = 20) strLinear
	integer :: file_status
	character*2 phase
	integer :: iphase
	real*8 slat, slon, sdepth, rlat, rlon, rdepth
	real*8 distance0, distance, tt0, tt, tt_uncertainty0, tt_uncertainty
	real*8 slow0, slow
	real*8 val
	character*800 errmsg
	real*8  :: DEG_TO_RAD = 3.1415926535897932d0 / 180.0d0
	real*8  :: RAD_TO_DEG = 180.0d0 / 3.1415926535897932d0
	real*8  :: error_value = -999.d0
	real*8  :: tolerance = 0.01d0
	integer :: err, nrecords, ndifferent
	integer::argcount
	           
	argcount = iargc()
	if (argcount .NE. 2) then
		print *, "Must specify 2 parameters: name of model and data file containing regression data"
		STOP 0
	endif
	
	call getarg(1, model_name)
	call getarg(2, data_file_name)
	
	! Default constructor where Earth radius varies as function of latitude
	call slbm_create(err) 
	
	call slbm_get_version(version, len(version), err)
	write(6,*) 'SLBM Fortran Regression Test -- SLBM version ', trim(version)

	print *, 'Load velocity model ', trim(model_name)
	call slbm_load_velocity_model_binary( TRIM(model_name), LEN_TRIM(model_name), err )
	if ( err .ne. 0 ) then
		print *, 'ERROR in load_velocity_model_binary().'
		call slbm_get_error_message( errmsg )
		print *, errmsg
		print *
		print *, 'You must run the test from the main SLBM_Root directory.'
		STOP
	endif
	
	print *, 'Load regression data ', trim(data_file_name)
	OPEN (UNIT=11, FILE=data_file_name, STATUS='OLD', IOSTAT=file_status)
		
	IF (file_status /= 0) THEN
		print *, 'Unable to open file ' // data_file_name
		print *
		print *, 'You must run the test from the main SLBM_Root directory.'
		STOP
	endif
		
	strLinear = 'LINEAR'
	n = 6
	
	! read comment lines from the data file until an empty line is encountered
	READ(11,'(A)') line
	write(6,*) trim(line)
	if (index(trim(line), trim(strLinear)) .gt. 0 .and. len_trim(line) > 0) then
		call slbm_set_interpolator_type(strLinear, len_trim(strLinear), err)
	endif
      
	DO WHILE (LEN(TRIM(line)) .NE. 0)
		READ(11,'(A)', END=5) line
		write(6,*) trim(line)
	if (index(trim(line), trim(strLinear)) .gt. 0 .and. len_trim(line) > 0) then
		call slbm_set_interpolator_type(strLinear, len_trim(strLinear), err)
	endif
	END DO
	
     5  nrecords = 0
	ndifferent = 0
	
	! keep reading data until there is no more.
	DO WHILE (.TRUE.)
	
		READ(11, '(a2,2(1x,f10.6,1x,f11.6,1x,f7.3),4(1x,f8.3))', END=10) &
		    phase, slat, slon, sdepth, rlat, rlon, rdepth, distance0, &
		    tt0, tt_uncertainty0, slow0
		    
		if (phase .eq. 'Pn') then
			iphase = 0
		else if (phase .eq. 'Sn') then
			iphase = 1
		else if (phase .eq. 'Pg') then
			iphase = 2
		else if (phase .eq. 'Lg') then
			iphase = 3
		else
			iphase = -1
		endif
		
		! create a GreatCircle object at the requested location.
		! Note that source and receiver lat, lon are converted from degrees to radians
		call slbm_create_great_circle( iphase,	&
			slat*DEG_TO_RAD, slon*DEG_TO_RAD, sdepth, &
			rlat*DEG_TO_RAD, rlon*DEG_TO_RAD, rdepth, &
			err )
			
		if (err .ne. 0) then
			! an error occurred creating the great circle.  
			! Respond by setting all regression values for this record
			! to -999 and do not retrieve values for tt, slowness, etc.
			! Presumably the same error happened when the regression data were generated.
			distance = error_value
			tt = error_value
			tt_uncertainty = error_value
			slow = error_value
		else
			! make calls to retrieve distance, tt, tt_uncertainty and slowness.
			! if any of the function calls return a non-zero error code
			! set all the values to -999 and move on.
			call slbm_get_distance(distance, err)
			if (err .ne. 0) then
				distance = error_value
				tt = error_value
				tt_uncertainty = error_value
				slow = error_value
			else
				distance = distance * RAD_TO_DEG
				call slbm_get_travel_time(tt, err)
				if (err .ne. 0) then
					distance = error_value
					tt = error_value
					tt_uncertainty = error_value
					slow = error_value
				else
					call slbm_get_tt_uncertainty(tt_uncertainty, err)
					if (err .ne. 0) then
						distance = error_value
						tt = error_value
						tt_uncertainty = error_value
						slow = error_value
					else
						call slbm_get_slowness(slow, err)
						if (err .ne. 0) then
							distance = error_value
							tt = error_value
							tt_uncertainty = error_value
							slow = error_value
						else
							slow = slow * DEG_TO_RAD
						endif
					endif
				endif
			endif
		endif

		! count records
		nrecords = nrecords + 1
		
		! if previously stored travel time and new computed travel time don't 
		! agree, print a message
		if (dabs(distance - distance0) .gt. tolerance &
			.or. dabs(tt - tt0) .gt. tolerance &
			.or. dabs(tt_uncertainty - tt_uncertainty0) .gt. tolerance &
			.or. dabs(slow - slow0) .gt. 0.02d0) then
		
			ndifferent = ndifferent + 1
			
			write( *,'(a,a,f11.6,f12.6,f8.3,f11.6,f12.6,f8.3,8f9.3)') &
				' ',phase, slat, slon, sdepth, rlat, rlon, rdepth, &
				distance0, distance, tt0, tt, tt_uncertainty0, &
				tt_uncertainty, slow0, slow
				
		endif

	END DO
	
    10  write (*, '(a1,i4,a4,i4,a60)') ' ',ndifferent,' of ',nrecords, &
	    ' travel times differences exceeded tolerance of 0.01 seconds' 
	    
        if (ndifferent .eq. 0 .and. nrecords .gt. 0) then
            print *, 'PASSED'
        else
            print *, 'FAILED'
        endif
            
        print *
        
  ! iphase = 0
  ! slat = 10
  ! slon = 20
  ! sdepth = 5
  ! rlat = 15
  ! rlon = 25
  ! rdepth = -0.1
  ! call slbm_create_great_circle( iphase,	&
  ! 	slat*DEG_TO_RAD, slon*DEG_TO_RAD, sdepth, &
  ! 	rlat*DEG_TO_RAD, rlon*DEG_TO_RAD, rdepth, &
  ! 	err )
  ! 	
  ! call slbm_get_travel_time(val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_tt_uncertainty(val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_slowness(val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_sh_uncertainty(val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_dtt_dlat(val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_dtt_dlon(val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_dtt_ddepth(val, err)
  ! write (*, '(f12.4)') val      
  ! 
  ! call slbm_get_traveltime_uncertainty(0, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_traveltime_uncertainty(1, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_traveltime_uncertainty(2, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_traveltime_uncertainty(3, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val       
  ! 
  ! call slbm_get_slowness_uncertainty(0, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_slowness_uncertainty(1, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_slowness_uncertainty(2, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
  ! 
  ! call slbm_get_slowness_uncertainty(3, 9.5*DEG_TO_RAD, val, err)
  ! write (*, '(f12.4)') val*DEG_TO_RAD       
		
	end program SLBMshell_ftest
		
