 !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

