lighting_module_test Subroutine

public subroutine lighting_module_test()

Unit tests for the listing module.

Arguments

None

Calls

proc~~lighting_module_test~~CallsGraph proc~lighting_module_test lighting_module_test proc~solar_fraction solar_fraction proc~lighting_module_test->proc~solar_fraction proc~solar_fraction_alt solar_fraction_alt proc~lighting_module_test->proc~solar_fraction_alt proc~solar_fraction_alt2 solar_fraction_alt2 proc~lighting_module_test->proc~solar_fraction_alt2 proc~unit unit proc~solar_fraction->proc~unit proc~solar_fraction_alt->proc~unit proc~solar_fraction_alt2->proc~unit

Source Code

    subroutine lighting_module_test()

    real(wp) :: rs, rp
    real(wp),dimension(3) :: d_s, d_p

    rs = 1.0_wp ! sun radius
    rp = 1.0_wp ! planet radius

    ! sun -- body -- sc  -> 0.0
    d_s = [-100.0_wp, 0.0_wp, 0.0_wp]
    d_p = [-10.0_wp, 0.0_wp, 0.0_wp]
    call go()

    ! sc -- sun -- body  -> 1.0
    d_s = [10.0_wp, 0.0_wp, 0.0_wp]
    d_p = [100.0_wp, 0.0_wp, 0.0_wp]
    call go()

    ! sc -- body -- sun  -> 0.0
    d_s = [100.0_wp, 0.0_wp, 0.0_wp]
    d_p = [10.0_wp, 0.0_wp, 0.0_wp]
    call go()

    ! sc -- body -- sun  -> penumbra
    d_s = [100.0_wp, 0.0_wp, 0.0_wp]
    d_p = [10.0_wp, 1.0_wp, 0.0_wp]
    call go()

    ! body -- sc -- sun
    d_s = [-100.0_wp, 0.0_wp, 0.0_wp]
    d_p = [100.0_wp, 0.0_wp, 0.0_wp]
    call go()

    !....................................
    ! sc -- body -- sun  -> antumbra
    rs = 100.0_wp
    d_s = [20000.0_wp, 0.0_wp, 0.0_wp]
    d_p = [400.0_wp,  0.0_wp, 0.0_wp]
    call go()

    rs = 100.0_wp  ! umbra
    d_s = [20000.0_wp, 0.0_wp, 0.0_wp]
    d_p = [100.0_wp,  0.0_wp, 0.0_wp]
    call go()

    ! realistic sun/earth case:
    !  sun -- earth -- sc
    rs = 696000.0_wp
    rp = 6378.0_wp
    d_s = [-149597870.7_wp, 0.0_wp, 0.0_wp]
    d_p = [-6778.0_wp, 6400.0_wp, 0.0_wp]
    call go()

    ! ! an edge case, a very small sun very close to the body on x-axis,
    ! ! sc on y-axis very close to body    .. i don't think any properly handle this .. .double check...
    ! rs = 0.0001_wp ! sun radius
    ! rp = 10.0_wp ! planet radius
    ! d_p = [0.0001_wp, -rp-0.01_wp, 0.0_wp]
    ! d_s = d_p + [-rp-0.01_wp, 0.0_wp, 0.0_wp]
    ! call go()

    contains

        subroutine go()
            real(wp) :: phi1, phi2, phi3
            character(len=:),allocatable :: info1, info2, info3
            print*, '----------------------------------'
            write(*,*) ''
            call solar_fraction(     d_s, rs, d_p, rp, phi1, info1)
            call solar_fraction_alt( d_s, rs, d_p, rp, phi2, info2)
            call solar_fraction_alt2(d_s, rs, d_p, rp, phi3, info3)
            write(*,*) 'phi1 = ', phi1, info1
            write(*,*) 'phi2 = ', phi2, info2
            write(*,*) 'phi3 = ', phi3, info3
            write(*,*) 'diff 1= ', abs(phi1-phi2) ! spherical vs circular
            write(*,*) 'diff 2= ', abs(phi2-phi3) ! two circular models
            if (abs(phi1-phi2)>1.0e-4_wp) error stop 'WARNING: large difference between models'
            print*, ''
        end subroutine go
    end subroutine lighting_module_test