!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 
!  Copyright 2009 National Technology & Engineering Solutions of Sandia, LLC
!  (NTESS). Under the terms of Contract DE-NA0003525 with NTESS, the U.S.
!  Government retains certain rights in this software.
! 
!  BSD Open Source License
!  All rights reserved.
! 
!  Redistribution and use in source and binary forms, with or without
!  modification, are permitted provided that the following conditions are met:
! 
!    1. Redistributions of source code must retain the above copyright notice,
!       this list of conditions and the following disclaimer.
! 
!    2. Redistributions in binary form must reproduce the above copyright
!       notice, this list of conditions and the following disclaimer in the
!       documentation and/or other materials provided with the distribution.
! 
!    3. Neither the name of the copyright holder nor the names of its
!       contributors may be used to endorse or promote products derived from
!       this software without specific prior written permission.
! 
!  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
!  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
!  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
!  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
!  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!  POSSIBILITY OF SUCH DAMAGE.
! 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

! module that contains some various useful constants and definitions
module constants

    ! import modern fortran kinds (real32/64, int8/16/32, etc.)
    use, intrinsic :: iso_fortran_env

    ! turn off f77 "feature" forcing counter variables (ijklmn) to be int
    implicit none

    ! define various variable types
    integer, parameter :: SP = real32  ! single-precision floating point
    integer, parameter :: DP = real64  ! double-precision floating point
    integer, parameter :: I1 = int8    !  8 bit (1 byte)  integer
    integer, parameter :: I2 = int16   ! 16 bit (2 bytes) integer
    integer, parameter :: I4 = int32   ! 32 bit (4 bytes) integer

    ! pi
    real(DP), parameter :: PI_DP = 4._DP * atan (1._DP)  ! double-precision

    ! define some constants for converting between degrees<-->radians    
    real(DP), parameter :: DEG_PER_RAD = 180._DP / PI_DP  ! degrees per radian
    real(DP), parameter :: RAD_PER_DEG = PI_DP / 180._DP  ! radians per degree


end module constants


! module that contains useful error checking code
module error_checking

    ! import the useful constants we've defined
    use constants

    ! turn off f77 "feature" forcing counter variables (ijklmn) to be int
    implicit none

    ! declare some variables relevant to testing
    logical  :: PASSED         ! bool for whether all the tests passed (default true)
    real(DP) :: EPS = 1.e-6_DP ! small value to allow for machine error differences


    ! subroutine/function block
    contains

    ! function to check if two floats are equal to some high precision
    subroutine assertIsEqual(x,y,varname)

        ! define our input arguments
        real(DP),          intent(in) :: x, y
        character(len=*),  intent(in) :: varname

        ! stick varname into a character array of a specified length
        ! (roundabout way of left-justifying 'varname' for printing)
        character(len=21) :: lvarname
        lvarname = varname

        ! print status message
        write(*, fmt='(a21,a,f12.8,a,f12.8)', advance='no') lvarname, "  ", x, " == ", y

        ! if the two values are equal, exit with error
        if (abs(x-y) < EPS) then
            write(*, fmt='(a)') " OK"
        else
            write(*, fmt='(a)') " FAIL"
            PASSED = .FALSE.
        endif

    end subroutine assertIsEqual

    ! error catching function
    subroutine catch(errorCode)

        ! define errorCode as an integer and is an input variable
        integer(I4), intent(in) :: errorCode

        ! declare a character array to hold our error message
        character(len=1024) :: errorMsg

        ! check if there is an error code
        if (errorCode /= 0) then

            ! get the error message
            call slbm_get_error_message( errorMsg, sizeof(errorMsg) )

            ! print the error message
            print '(a,i0,a)', "ERROR ", errorCode, ":"
            print '(a)', errorMsg

            ! exit the program with error
            stop 1

        endif

    end subroutine catch
    
end module error_checking


! quick function to convert phase number to phase name
character*2 function getPhaseName(i)
    ! import the useful constants we've defined
    use constants

    ! turn off f77 "feature" forcing counter variables (ijklmn) to be int
    implicit none

    ! declare input variables
    integer(I4), intent(in) :: i  ! phase number

    ! declare what to do 
    select case (i)
        case (0)
            getPhaseName = "Pn"
        case (1)
            getPhaseName = "Sn"
        case (2)
            getPhaseName = "Pg"
        case (3)
            getPhaseName = "Lg"
    end select
end function getPhaseName


! main progran
program main

    ! import statements
    use constants       ! some useful constants we've defined
    use error_checking  ! error checking functions

    ! turn off f77 "feature" forcing counter variables (ijklmn) to be int
    implicit none

    ! declare a whole bunch of variables
    integer(I4)        :: errorCode  ! integer error code
    character(len=80)  :: modelPath  ! /path/to/model_file
    integer(I4)        :: phase      ! phase id
    real(DP) :: srcLatDeg, srcLonDeg, srcDepKm,  &  ! source location
                rcvLatDeg, rcvLonDeg, rcvDepKm      ! receiver location
    real(DP) :: srcLatRad, srcLonRad,  &  ! source location (radians)
                rcvLatRad, rcvLonRad      ! source location (radians)
    real(DP) :: distDeg, distRad,      &  ! source <--> receiver distance
                travelTimeSec,         &  ! travel time (sec) from source --> receiver
                travelTimeUncertSec,   &  ! path-dependent travel time uncertainty (sec)
                travelTime1DUncertSec     ! old-style 1D travel time uncertainty (sec)
    character(len=2) :: getPhaseName  ! defines return type of getPhaseName()
    
    ! arbitrary source (Meteor Crater, AZ)
    srcLatDeg =   35.0274_DP  ! latitude (degrees)
    srcLonDeg = -111.0228_DP  ! longitude (degrees)
    srcDepKm  =    1.2345_DP  ! depth (km)

    ! ! arbitrary receiver (Albuquerque, NM)
    rcvLatDeg =   35.1053_DP  ! latitude (degrees)
    rcvLonDeg = -106.6294_DP  ! longitude (degrees)
    rcvDepKm  =   -1.6000_DP  ! depth (km)

    ! convert lat/lon from degrees to radians
    srcLatRad = srcLatDeg * rad_per_deg
    srcLonRad = srcLonDeg * rad_per_deg
    rcvLatRad = rcvLatDeg * rad_per_deg
    rcvLonRad = rcvLonDeg * rad_per_deg

    ! print a quick message
    print '(a)', "======================================================"
    print '(a)', "Performing Fortran tests..."
    print '(a)', "------------------------------------------------------"
    print '(a)', "Variable                 Calculated       Reference"
    print '(a)', "------------------------------------------------------"

    ! instantiate an RSTT object
    call slbm_create(errorCode)
    call catch(errorCode)  ! check if the previous function returned an error

    ! load the velocity model
    modelPath = "models/unittest.geotess"
    call slbm_load_velocity_model(trim(modelPath), len_trim(modelPath), errorCode)
    call catch(errorCode)  ! check if the previous function returned an error

    ! loop over each type of phase (Pn=0, Sn=1, Pg=2, or Lg=3)
    PASSED = .TRUE.  ! start off by assuming tests will pass
    do phase=0,3

        ! print status message
        if (phase > 0) then
            print '(a)', ""
        endif
        print '(a,a,a)', "Computing values for ", getPhaseName(phase), " phase..."

        ! create a great circle from source to the receiver
        call slbm_create_great_circle(phase,  &
            srcLatRad, srcLonRad, srcDepKm,   & 
            rcvLatRad, rcvLonRad, rcvDepKm,   &
            errorCode)
        call catch(errorCode)  ! check if the previous function returned an error

        ! get the distance, travel time, and uncertainties from source --> receiver
        call slbm_get_distance(distRad, errorCode)
        call catch(errorCode)
        call slbm_get_travel_time(travelTimeSec, errorCode)
        call catch(errorCode)
        call slbm_get_tt_uncertainty(travelTimeUncertSec, errorCode)
        call catch(errorCode)
        call slbm_get_tt_uncertainty1d(travelTime1DUncertSec, errorCode)
        call catch(errorCode)

        ! make sure all the values are correct
        select case (phase)
            case (0)
                call assertIsEqual(distRad,                0.06290927_DP, "distRad")
                call assertIsEqual(travelTimeSec,         56.88549071_DP, "travelTimeSec")
                call assertIsEqual(travelTimeUncertSec,    3.12378957_DP, "travelTimeUncertSec")
                call assertIsEqual(travelTime1DUncertSec,  1.15423530_DP, "travelTime1DUncertSec")
            case (1)
                call assertIsEqual(distRad,                0.06290927_DP, "distRad")
                call assertIsEqual(travelTimeSec,         98.95213093_DP, "travelTimeSec")
                call assertIsEqual(travelTimeUncertSec,    6.29314026_DP, "travelTimeUncertSec")
                call assertIsEqual(travelTime1DUncertSec,  2.47666863_DP, "travelTime1DUncertSec")
            case (2)
                call assertIsEqual(distRad,                0.06290927_DP, "distRad")
                call assertIsEqual(travelTimeSec,         70.40335768_DP, "travelTimeSec")
                call assertIsEqual(travelTimeUncertSec,   15.58790453_DP, "travelTimeUncertSec")
                call assertIsEqual(travelTime1DUncertSec,  1.61320256_DP, "travelTime1DUncertSec")
            case (3)
                call assertIsEqual(distRad,                0.06290927_DP, "distRad")
                call assertIsEqual(travelTimeSec,        119.65236722_DP, "travelTimeSec")
                call assertIsEqual(travelTimeUncertSec,   20.08714726_DP, "travelTimeUncertSec")
                call assertIsEqual(travelTime1DUncertSec,  1.98573827_DP, "travelTime1DUncertSec")
        end select
    end do

    ! return
    if (PASSED .EQV. .TRUE.) then
        print '(a)', "------------------------------------------------------"
        print '(a)', "Fortran tests PASSED."
        print '(a)', "======================================================"
        return
    else
        print '(a)', "------------------------------------------------------"
        print '(a)', "Fortran tests FAILED."
        print '(a)', "======================================================"
        stop 1
    endif

end program main
