esputr1993_test.f90

Go to the documentation of this file.

!    Copyright (c) 2016  Forschungszentrum Juelich GmbH
!                        Markus Brenneis, Vladislav Kotov 
!
!    This file is part of ESPUTR.
!
!    ESPUTR is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    ESPUTR is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with ESPUTR.  If not, see <http://www.gnu.org/licenses/>.
!

module esputr1993_test
    use esputr
    use esputr1993
    use esputr_test
    
    implicit none
    public esputr1993_test_compare
    public esputr1993_test_wrong_file
    public esputr1993_test_wrong_ids
    public esputr1993_test_th
    public esputr1993_test_double_init
    public esputr1993_test_call_uninitialized
    public esputr1993_test_unknown_elements
    public esputr1993_test_wrong_angle
    public esputr1993_test_eth
    public esputr1993_test_initialized
    
    private
    
    integer :: i_
    character(*), parameter :: sputer1993_fitvalues_file = "../data/SPUTER"
    integer, parameter :: n_e0 = 38
    integer, parameter :: n_combinations = 8
    real(kind=ESPUTR_DP), dimension(N_E0), parameter :: e0 = (/ (i_, i_=0,200,10), (i_, i_=300,900,100), (i_, i_=1000,10000,1000) /)
    character(10), dimension(3, N_COMBINATIONS), parameter :: combinations = reshape (&
        (/ &
        "D         ", "Be        ", "Beryllium ", &
        "T         ", "Be        ", "Beryllium ", &
        "D         ", "Fe        ", "Iron      ", &
        "T         ", "Fe        ", "Iron      ", &
        "D         ", "Mo        ", "Molybdenum", &
        "T         ", "Mo        ", "Molybdenum", &
        "D         ", "W         ", "Tungsten  ", &
        "T         ", "W         ", "Tungsten  "  &
        /), (/ 3, n_combinations/) )
    
    real(kind=ESPUTR_DP), dimension(N_E0, N_COMBINATIONS), parameter :: expected1993 = reshape (&
        (/ &
        ! D->Be
         0.000000000e+00, 0.000000000e+00, 1.104103489e-03, 5.412871941e-03, 9.865317449e-03, & 
         1.362015231e-02, 1.666145691e-02, 1.911097532e-02, 2.109086932e-02, 2.270029556e-02, & 
         2.401582971e-02, 2.509606869e-02, 2.598604652e-02, 2.672069140e-02, 2.732738324e-02, & 
         2.782781747e-02, 2.823936384e-02, 2.857606414e-02, 2.884937187e-02, 2.906870654e-02, & 
         2.924187358e-02, 2.947274709e-02, 2.854958532e-02, 2.733847992e-02, 2.609905503e-02, & 
         2.491692942e-02, 2.381836251e-02, 2.280755068e-02, 2.188037090e-02, 1.574763130e-02, & 
         1.251330226e-02, 1.048765264e-02, 9.084401421e-03, 8.047182373e-03, 7.245108871e-03, & 
         6.603895290e-03, 6.078020749e-03, 5.637921894e-03, & 
        ! T->Be
         0.000000000e+00, 0.000000000e+00, 6.163481396e-04, 4.972985113e-03, 1.020839541e-02, & 
         1.488585322e-02, 1.880155249e-02, 2.202962229e-02, 2.468817158e-02, 2.688523383e-02, & 
         2.870915201e-02, 3.022989306e-02, 3.150250386e-02, 3.257042361e-02, 3.346816812e-02, & 
         3.422339168e-02, 3.485844337e-02, 3.539153839e-02, 3.583764297e-02, 3.620914723e-02, & 
         3.651638116e-02, 3.744791982e-02, 3.664606240e-02, 3.533663840e-02, 3.390936958e-02, & 
         3.250448541e-02, 3.117319558e-02, 2.993157952e-02, 2.878118075e-02, 2.097715208e-02, & 
         1.676289492e-02, 1.409672877e-02, 1.223877094e-02, 1.085992900e-02, 9.790536375e-03, & 
         8.933666020e-03, 8.229639207e-03, 7.639555433e-03, & 
        ! D->Fe
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 1.737185437e-04, & 
         1.046539046e-03, 2.422094274e-03, 4.030510991e-03, 5.711258056e-03, 7.379122837e-03, & 
         8.991161166e-03, 1.052732180e-02, 1.197988020e-02, 1.334770838e-02, 1.463313703e-02, & 
         1.584021883e-02, 1.697376134e-02, 1.803879011e-02, 1.904025543e-02, 1.998287882e-02, & 
         2.087107955e-02, 2.750974373e-02, 3.158309658e-02, 3.425578892e-02, 3.608011706e-02, & 
         3.735185130e-02, 3.824445425e-02, 3.886676439e-02, 3.929068098e-02, 3.899753173e-02, & 
         3.659592588e-02, 3.413323981e-02, 3.191246470e-02, 2.996087981e-02, 2.825036739e-02, & 
         2.674482709e-02, 2.541138231e-02, 2.422248563e-02, & 
        ! T->Fe
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 2.748668824e-04, 1.978833967e-03, & 
         4.540618007e-03, 7.352042125e-03, 1.013825575e-02, 1.278839828e-02, 1.526410109e-02, & 
         1.755873052e-02, 1.967924827e-02, 2.163797159e-02, 2.344878690e-02, 2.512542918e-02, & 
         2.668074192e-02, 2.812640767e-02, 2.947290264e-02, 3.072955382e-02, 3.190463841e-02, & 
         3.300549564e-02, 4.106738031e-02, 4.588454289e-02, 4.898419565e-02, 5.105844087e-02, & 
         5.247045440e-02, 5.343087730e-02, 5.407097567e-02, 5.447706650e-02, 5.327729815e-02, & 
         4.976522363e-02, 4.631552934e-02, 4.324915487e-02, 4.057314004e-02, 3.823704097e-02, & 
         3.618611411e-02, 3.437278813e-02, 3.275805393e-02, & 
        ! D->Mo
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 6.113259122e-06, & 
         7.256358164e-05, 2.328358848e-04, 4.843020824e-04, 8.127826662e-04, 1.202061715e-03, & 
         1.637256384e-03, 2.105787324e-03, 2.597431521e-03, 3.104056130e-03, 3.619274123e-03, & 
         4.138114139e-03, 9.004279744e-03, 1.287372049e-02, 1.586171980e-02, 1.819622945e-02, & 
         2.005041866e-02, 2.154526339e-02, 2.276543450e-02, 2.377136679e-02, 2.807671072e-02, & 
         2.860035619e-02, 2.811293568e-02, 2.729748580e-02, 2.638574083e-02, 2.546821410e-02, & 
         2.458203050e-02, 2.374178809e-02, 2.295196529e-02, & 
        ! T->Mo
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 3.483440885e-06, 1.336728845e-04, 5.030419358e-04, 1.081139055e-03, & 
         1.810072022e-03, 2.638605804e-03, 3.527705732e-03, 4.449189325e-03, 5.383205890e-03, & 
         6.315982847e-03, 7.238094468e-03, 8.143200825e-03, 9.027147694e-03, 9.887328317e-03, & 
         1.072223098e-02, 1.769168653e-02, 2.265536772e-02, 2.629792875e-02, 2.905732991e-02, & 
         3.120086984e-02, 3.289801991e-02, 3.426108595e-02, 3.536748555e-02, 3.971780570e-02, & 
         3.979104264e-02, 3.878776201e-02, 3.747362096e-02, 3.610013916e-02, 3.476071376e-02, & 
         3.349023361e-02, 3.229963977e-02, 3.118960080e-02, & 
        ! D->W
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 3.821267303e-04, 1.685035389e-03, 3.317431861e-03, 4.955715436e-03, & 
         6.486075150e-03, 7.877297587e-03, 9.129000154e-03, 1.025163704e-02, 1.691922670e-02, & 
         1.966598612e-02, 2.092588409e-02, 2.148623487e-02, 2.167495227e-02, 2.165167616e-02, & 
         2.150239271e-02, 2.127675440e-02, 2.100489733e-02, & 
        ! T->W
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, & 
         0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 0.000000000e+00, 2.818904489e-07, & 
         1.177025344e-05, 5.166389668e-05, 1.273855286e-04, 2.403441647e-04, 3.888649309e-04, & 
         5.698063547e-04, 3.414252549e-03, 6.724809397e-03, 9.761714767e-03, 1.240583179e-02, & 
         1.468313276e-02, 1.664705632e-02, 1.834942033e-02, 1.983412462e-02, 2.803833028e-02, & 
         3.109099865e-02, 3.232680327e-02, 3.273624940e-02, 3.271953512e-02, 3.246788833e-02, & 
         3.208271143e-02, 3.162164526e-02, 3.111906787e-02 /), (/ n_e0, n_combinations /) )
    
    contains
    
    logical function esputr1993_test_wrong_file()
        integer, dimension(4) :: err
        call esputr1993_init("/__FOO_test_wrong_file_1993", err(1))
        call esputr1993_deallocate(err(2))
        call esputr1993_init("../data/ECKSTEIN2007N" , err(3))
        call esputr1993_deallocate(err(4))
        print *, "esputr1993_test_wrong_file:", err
        esputr1993_test_wrong_file = all(err(:) == (/300, 0, 300, 0/))
    end function esputr1993_test_wrong_file
    
    logical function esputr1993_test_wrong_ids()
        integer, dimension(6) :: err
        real(kind=ESPUTR_DP) :: crap
        call esputr1993_init(sputer1993_fitvalues_file, err(1))
        crap = esputr1993_yn(0.d0, 2, -42, err(2))
        crap = esputr1993_yn(0.d0, -42, 2, err(3))
        crap = esputr1993_yn(0.d0, 2, 1337, err(4))
        crap = esputr1993_yn(0.d0, 1337, 2, err(5))
        call esputr1993_deallocate(err(6))
        print *, "esputr1993_test_wrong_ids:", err
        esputr1993_test_wrong_ids = all(err == (/0, 100, 100, 100, 100, 0/))
    end function esputr1993_test_wrong_ids
    
    logical function esputr1993_test_double_init()
        integer, dimension(5) :: err
        call esputr1993_init(sputer1993_fitvalues_file, err(1))
        call esputr1993_init("Foo", err(2))
        call esputr1993_deallocate(err(3))
        call esputr1993_init(sputer1993_fitvalues_file, err(4))
        call esputr1993_deallocate(err(5))
        print *, "esputr1993_test_double_init:", err
        esputr1993_test_double_init = all(err == (/0, 100, 0, 0, 0/))
    end function esputr1993_test_double_init
    
    logical function esputr1993_test_call_uninitialized()
        integer, dimension(3) :: err
        integer :: icrap
        real(kind=ESPUTR_DP) :: rcrap
        icrap = esputr1993_getprojectileid("D", err(1))
        icrap = esputr1993_gettargetid("Beryllium", err(2))
        rcrap = esputr1993_yn(0.d0, 1, 1, err(3))
        print *, "esputr1993_test_call_uninitialized:", err
        esputr1993_test_call_uninitialized = all(err == 50)
    end function esputr1993_test_call_uninitialized
    
    logical function esputr1993_test_unknown_elements()
        integer, dimension(4) :: err
        integer :: icrap
        call esputr1993_init(sputer1993_fitvalues_file, err(1))
        icrap = esputr1993_getprojectileid("Ä", err(2))
        icrap = esputr1993_gettargetid("Ä", err(3))
        call esputr1993_deallocate(err(4))
        print *, "esputr1993_test_unknown_elements:", err
        esputr1993_test_unknown_elements = all(err == (/0, 101, 102, 0/))
    end function esputr1993_test_unknown_elements
    
    logical function esputr1993_test_wrong_angle()
        integer, dimension(5) :: err
        real(kind=ESPUTR_DP) :: crap
        call esputr1993_init(sputer1993_fitvalues_file, err(1))
        crap = esputr1993_yth(-.1d0, err(2))
        crap = esputr1993_yth(1.6d0, err(3))
        crap = esputr1993_yth(0.6d0, err(4))
        call esputr1993_deallocate(err(5))
        print *, "esputr1993_test_wrong_angle", err
        esputr1993_test_wrong_angle = all(err == (/0, 103, 103, 0, 0/))
    end function esputr1993_test_wrong_angle
    
    logical function esputr1993_test_compare()
        logical, dimension(N_COMBINATIONS) :: results
        integer :: i,err
        call esputr1993_init(sputer1993_fitvalues_file, err)
        if (err /=0 ) then
            print *, "FAILURE in esputr1993_test_compare: unexpected err value", err
            esputr1993_test_compare = .false.
            return
        end if
        do i = 1, n_combinations
            results(i) = test_1993(expected1993(:,i), combinations(1,i), combinations(3,i))
        end do
        call esputr1993_deallocate(err)
        if (err /=0 ) then
            print *, "FAILURE in esputr1993_test_compare: unexpected err value", err
            esputr1993_test_compare = .false.
            return
        end if
        print *, "esputr1993_test_compare: ", results         
        esputr1993_test_compare = all(results)
        
        contains
        
        logical function test_1993(expected, proj, targ)
            real(kind=ESPUTR_DP), dimension(N_E0), intent(in) :: expected
            character(*), intent(in) :: proj, targ
            integer :: projId, targId, err
            real(kind=ESPUTR_DP), dimension(N_E0) :: Y
            logical, dimension(N_E0) :: passed
            integer :: i
            
            projid = esputr1993_getprojectileid(proj,err)
            if(err /= 0) goto 1000
            targid = esputr1993_gettargetid(targ,err)
            if(err /= 0) goto 1000
            do i = 1, n_e0
                y(i) = esputr1993_yn(e0(i), projid, targid, err)
                if(err /= 0) goto 1000
            end do
            
            ! Compare calculated Y with the reference 'expected'
            passed = ispassed(expected, y)
            call printfailed(expected, y, passed)
            test_1993 = all(passed)
            return
1000        print *, "FAILURE in esputr1993_test_compare: unexpected err value", err
            test_1993 = .false.
            return
        end function test_1993
    end function esputr1993_test_compare
    
    logical function esputr1993_test_th()
        real(kind=ESPUTR_DP) :: Y
        integer :: err
        real(kind=ESPUTR_DP), parameter :: TH_OPT = 75.*esputr_pi/180., y_th_opt = 3.390205
        call esputr1993_init(sputer1993_fitvalues_file, err)
        if(err /= 0) goto 2500
        y = esputr1993_yth(0d0, err)
        if(err /= 0) goto 2500
        if(.not.ispassed(y,1.0d0)) then
          print *, "FAILURE in esputr1993_test_TH: expected 1, got ", y
          goto 1500
        end if
        y = esputr1993_yth(th_opt, err)
        if(err /= 0) goto 2500
        if(.not.ispassed(y,y_th_opt)) then
          print *, "FAILURE in esputr1993_test_TH: expected", y_th_opt, ", got ", y
          goto 1500
        end if
        y = esputr1993_yth(esputr_pi/2, err)
        if(err /= 0) goto 2500
        if(.not.ispassed(y,0.d0)) then
          print *, "FAILURE in esputr1993_test_TH: expected", 0., ", got ", y
          goto 1500
        end if
        if(err /= 0) goto 2500
        call esputr1993_deallocate(err)
        if(err /= 0) goto 2500
        print *, "esputr1993_test_1993_TH:", .true.
        esputr1993_test_th = .true.
        return
2500    print *, "FAILURE in esputr1993_test_TH: unexpected err value", err
1500    esputr1993_test_th = .false.
        call esputr1993_deallocate(err)
        return
    end function esputr1993_test_th
    
    logical function esputr1993_test_eth()
        integer :: err, proj_id, targ_id
        real(kind=ESPUTR_DP) :: Eth
        esputr1993_test_eth = .false.
        call esputr1993_init(sputer1993_fitvalues_file, err)
        if(err /= 0) goto 5100
        proj_id = esputr1993_getprojectileid("H", err)
        if(err /= 0) goto 5100
        targ_id = esputr1993_gettargetid("Lithium", err)
        if(err /= 0) goto 5100
        eth = esputr1993_eth(proj_id, targ_id, err)
        if(err /= 0) goto 5100
        if(ispassed(eth, 6.22d0)) then
            esputr1993_test_eth = .true.
        else
            print *, "FAILURE in esputr1993_test_ETH: ", eth
        end if
        call esputr1993_deallocate(err)
        if(err /= 0) goto 5100
        return
5100    print *, "FAILURE in esputr1993_test_ETH: unexpected err value", err
        call esputr1993_deallocate(err)
    end function esputr1993_test_eth

    logical function esputr1993_test_initialized()
        integer :: err
        logical :: initialized
        esputr1993_test_initialized = .false.
        initialized = esputr1993_if_initialized()
        if(initialized) goto 7100
        call esputr1993_init("../data/ECKSTEIN2007", err)
        if(err == 0) goto 7100
        initialized = esputr1993_if_initialized()
        if(initialized) goto 7100
        call esputr1993_init(sputer1993_fitvalues_file, err)
        if(err /= 0) goto 7100
        initialized = esputr1993_if_initialized()
        if(.not. initialized) goto 7100
        call esputr1993_deallocate(err)
        if(err /= 0) goto 7100
        esputr1993_test_initialized = .true.
        return
7100    print *, "FAILURE in esputr1993_test_initialized"
        call esputr1993_deallocate(err)
    end function esputr1993_test_initialized
       
end module esputr1993_test

program test1993
    use esputr1993_test
    use esputr
    implicit none    

    esputr_unit = 0
    
    if(.not.esputr1993_test_wrong_file()) stop " ERROR detected in esputr1993_test_wrong_file"
    if(.not.esputr1993_test_wrong_ids()) stop " ERROR detected in esputr1993_test_wrong_ids"
    if(.not.esputr1993_test_double_init()) stop " ERROR detected in esputr1993_test_double_init"
    if(.not.esputr1993_test_call_uninitialized()) stop " ERROR detected in esputr1993_test_call_uninitialized"
    if(.not.esputr1993_test_unknown_elements()) stop " ERROR detected in esputr1993_test_unknown_elements"
    if(.not.esputr1993_test_wrong_angle()) stop " ERROR detected in esputr1993_test_wrong_angle"
    if(.not.esputr1993_test_compare()) stop " ERROR detected in esputr1993_test_compare"
    if(.not.esputr1993_test_th()) stop " ERROR detected in esputr1993_test_TH"
    if(.not.esputr1993_test_eth()) stop " ERROR detected in esputr1993_test_ETH"
    if(.not.esputr1993_test_initialized()) stop " ERROR detected in esputr1993_test_initialized"
    print *, "ESPUTR1993_TEST COMPLETED"
end program test1993