esputr_cgi.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/>.
!

program esputr_cgi

    use cgi_protocol
    use esputr
    use esputr2001
    use esputr1993
    use esputr_interfaces
    implicit none
    integer                    :: unit
    type(dict_struct), pointer :: dict => null()
    character(*), parameter    :: HEADER = "Content-type: text/csv; charset=utf-8"//char(10)//&
                             "Content-Disposition: attachment; filename=data.csv"//char(10)
    integer, parameter :: MAX_POINTS = 1000000
    
    integer, parameter :: MAX_PARAM_LENGTH = 20
    integer, parameter :: TMP_UNIT = 142
    character(DICT_VALUE_LENGTH) :: input = ""
    character(MAX_PARAM_LENGTH), dimension(:), allocatable :: inputs
    character(MAX_PARAM_LENGTH), dimension(:), allocatable :: projs
    integer :: n_projs
    character(MAX_PARAM_LENGTH), dimension(:), allocatable :: targs
    integer :: n_targs
    character(MAX_PARAM_LENGTH), dimension(:), allocatable :: versions
    integer :: n_versions = 0
    integer :: n_combinations
    integer :: err, i, c, p, t, v, th, e
    real(kind=ESPUTR_DP) :: E0min = 10.
    real(kind=ESPUTR_DP) :: E0max = 10000.
    integer :: n_E0s = 1001
    real(kind=ESPUTR_DP) :: deltaE0 = 10.
    real(kind=ESPUTR_DP) :: thMin = 0
    real(kind=ESPUTR_DP) :: thMax = 1.57
    integer :: n_Ths = 0
    real(kind=ESPUTR_DP) :: deltaTh = .1
    real(kind=ESPUTR_DP), dimension(:), allocatable :: E0s
    real(kind=ESPUTR_DP), dimension(:), allocatable :: Ths
    real(kind=ESPUTR_DP), dimension(:,:), allocatable :: Ys
    real(kind=ESPUTR_DP) :: epsfilter=0.
    integer :: ilast
    logical :: lskip
    character(MAX_PARAM_LENGTH) :: ver

    intrinsic floor,transfer,count,max,index

    open(tmp_unit, iostat=err, status='scratch', action='readwrite')
    esputr_unit = tmp_unit
    
    call get_environment_variable("QUERY_STRING", input)
    if(index(input, '=') == 0) then
        call sendavailablecombinations()
    end if
    
    call cgi_begin(output_no_header, dict, unit)
    
    input = ""
    call cgi_get(dict, "projectiles", input)
    if(input == "") call cgi_error("esputr_cgi: no projectiles provided")
    call split(input, projs)
    n_projs = size(projs)
    
    input = ""
    call cgi_get(dict, "targets", input)
    if(input == "") call cgi_error("esputr_cgi: no targets provided")
    call split(input, targs)
    n_targs = size(targs)
    
    if ( dict_has_key( dict, "thdelta" ) .or. &
         dict_has_key( dict, "thmin" ) .or.  &
         dict_has_key( dict, "thmax" ) ) then
     call cgi_get(dict, "thdelta", deltath)
     if(deltath < .001) deltath = .001d0
     call cgi_get(dict, "thmin", thmin)
     if(thmin < 0) thmin = 0
     if(thmin > 1.57079d0) thmin = 1.57079d0
     call cgi_get(dict, "thmax", thmax)
     if(thmax > 1.57079d0) thmax = 1.57079d0
     if(thmax < thmin) thmax = thmin + deltath
     n_ths = floor((thmax-thmin) / deltath + 1.)
     if(thmin >= 41) n_ths = 0
    else 
     n_ths=0
    end if 

    input = ""
    call cgi_get(dict, "versions", input)
    if(input == "") call cgi_error("esputr_cgi: the models are not specified")
    call split(input, versions)
    n_versions = size(versions)
    
    call cgi_get(dict, "edelta", deltae0)
    if(deltae0 < 0.) deltae0 = 0.
    call cgi_get(dict, "emin", e0min)
    if(e0min < 0.) e0min = 0.
    call cgi_get(dict, "emax", e0max)
    if(e0max < e0min) e0max = e0min + deltae0
    call cgi_get(dict, "epsfilter", epsfilter)
    input = ""
    call cgi_get(dict, "e0s", input)
    if(input /= "") then
        call split(input, inputs)
        call toreal8(inputs, e0s)
        n_e0s = size(e0s)
    else
     if(deltae0>0.) then
       n_e0s = floor( (e0max-e0min) / deltae0 + 1. )
     else 
       n_e0s=1
     end if
     allocate(e0s(n_e0s), stat=err)   
     if(err /= 0) call cgi_error("esputr_cgi: memory allocation eror")
     if (n_e0s>1) then
      deltae0 = (e0max-e0min)/(n_e0s-1)
      e0s(1)=e0min
      do i=2,n_e0s-1
       e0s(i)=e0s(i-1)+deltae0
      end do
      e0s(n_e0s)=e0max
     else 
      e0s=e0min
     end if 
    end if
    
    if(n_e0s*max(n_projs, n_targs, n_versions)*max(1, n_ths) > max_points) &
        call cgi_error("esputr_cgi: too many data points are requested")
    
    allocate(ths(n_ths), stat=err)   
    if(err /= 0) call cgi_error("esputr_cgi: memory allocation eror")
    ths = (/ (i*deltath+thmin, i = 0, n_ths-1) /)
    
    call initesputr()
    
    if(n_ths == 0) then
        n_combinations = max(n_projs, n_targs, n_versions)
        allocate(ys(n_combinations,n_e0s), stat=err)
        if(err /= 0) call cgi_error("esputr_cgi: allocation error")
    
        foreachcombi: do c = 1, n_combinations
            p = min(n_projs, c)
            t = min(n_targs, c)
            v = min(n_versions, c)
            ver=versions(v)
            if (index(ver,'2007')>0) ver='2001' 
            call esputr_yn(e0s, n_e0s, projs(p), targs(t), ver, ys(c,:), err)
            if(err /= 0) call cgi_error("esputr_cgi: error while calculating the sputtering yield, check your input"&
                                       //getlastmessage())
        end do foreachcombi
        
        write(unit, '(A)') header
        
        write(unit, '(A)', advance='no') "Energy [eV]"
        foreachcombi1: do c = 1, n_combinations
            p = min(n_projs, c)
            t = min(n_targs, c)
            v = min(n_versions, c)
            write(unit, '(6A)', advance='no') ", Y_",trim(projs(p)),"_on_",trim(targs(t)),"_",trim(versions(v))
        end do foreachcombi1
        write(unit, *) ""
        ilast=1
        do i = 1, n_e0s
          !filter out nodes with almost equal (withing given accuracy epsfilter)
          !sputtering yields
          if(epsfilter>0.) then
           if (i>1.and.i<n_e0s) then 
            lskip=.true.
            do c = 1, n_combinations
            if( abs(ys(c,i)-ys(c,ilast) ) > &
                0.5*epsfilter*( abs(ys(c,i))+abs(ys(c,ilast)) ) ) then              
              lskip=.false.
              exit          
             end if
            end do 
            if(lskip) then
              cycle 
            else
             ilast=i
            end if
           end if  !if (i>1.and.i<nE0s) then 
          end if !if(epsfilter>0.) then 
          write(unit, '(E12.5)', advance='no') e0s(i)
          foreachcombi2: do c = 1, n_combinations
              write(unit, '(A,E12.5)', advance='no') ",",ys(c,i)
          end do foreachcombi2
          write(unit, *) ""
        end do
    else
        n_combinations = max(n_projs, n_targs, n_versions, n_e0s)
        allocate(ys(n_combinations,n_ths), stat=err)
        if(err /= 0) call cgi_error("esputr_cgi: allocation error")
        foreachcombith: do c = 1, n_combinations
            p = min(n_projs, c)
            t = min(n_targs, c)
            v = min(n_versions, c)
            e = min(n_e0s, c)
            ver=versions(v)
            if (index(ver,'2007')>0) ver='2001' 
            call esputr_yth(ths, n_ths, (/e0s(e)/), 1, projs(p), targs(t), ver, ys(c,:), err)
            if(err /= 0) call cgi_error("esputr_cgi: error while calculating the angular factor, check your input"//&
                " (no data for this energy?)"//getlastmessage())
        end do foreachcombith
        
        write(unit, '(A)') header
        
        write(unit, '(A)', advance='no') "theta [radian]"
        foreachcombith1: do c = 1, n_combinations
            p = min(n_projs, c)
            t = min(n_targs, c)
            v = min(n_versions, c)
            e = min(n_e0s, c)
            if (index(versions(v),'1993') > 0) then 
             write(unit, '(1A)', advance='no') ', Y(theta)/Y(0)_1993'
            else
             write(unit, '(5A,E12.5,2A)', advance='no') ", Y(theta)/Y(0)_",trim(projs(p)),"_on_",&
                trim(targs(t)),"_E=_",e0s(e),"_eV_",trim(versions(v))
            end if
        end do foreachcombith1
        write(unit, *) ""
        do th = 1, n_ths
            write(unit, '(E12.5)', advance='no') ths(th)
            foreachcombith2: do c = 1, n_combinations
                write(unit, '(A,E12.5)', advance='no') ",",ys(c, th)
            end do foreachcombith2
            write(unit, *) ""
        end do
    end if
        
    call esputr1993_deallocate(err)
    call esputr2001_deallocate(err)
    deallocate(e0s, ys, projs, targs, versions, ths)
    
    call cgi_end()
    
    contains
    
    subroutine split(csvString, array)
        character(DICT_VALUE_LENGTH), intent(in) :: csvString
        character(MAX_PARAM_LENGTH), dimension(:), allocatable, intent(inout) :: array
        integer :: nCommas
        ncommas = count(transfer(csvstring, 'a', dict_value_length) == ",")
        allocate(array(ncommas + 1))
        read(csvstring, *) array(1:ncommas+1)
    end subroutine split
    
    subroutine toreal8(strArr, realArr)
        character(MAX_PARAM_LENGTH), dimension(:), intent(in) :: strArr
        real(kind=8), dimension(:), allocatable, intent(inout) :: realArr
        integer :: i, err
        allocate(realarr(size(strarr)))
        do i = 1, size(strarr)
            read(strarr(i), *, iostat=err) realarr(i)
            if(err/=0) call cgi_error("esputr_cgi: invalid real value")
        end do
    end subroutine
    
    subroutine sendavailablecombinations()
        character(ESPUTR2001_MAX_NAME_LENGTH), dimension(:,:), allocatable :: combinations_2001_N
        character(ESPUTR2001_MAX_NAME_LENGTH*2), dimension(:,:), allocatable :: combinations_2001_TH
        !TODO get rid of constants 11, 16
        character(ESPUTR1993_FIRST_COL_WIDTH), dimension(:,:), allocatable :: combinations_1993
        integer :: err
        character(*), parameter :: JSON_HEADER = "Content-type: application/json; charset=utf-8"//char(10)//&
                    "Content-Disposition: attachment; filename=combinations.json"//char(10)
        
        unit = 6
        
        call initesputr()
        
        call esputr2001_availablecombinationsn(combinations_2001_n, err)
        if(err /= 0) call cgi_error("esputr_cgi: error retreiving data")
        call esputr2001_availablecombinationsth(combinations_2001_th, err)
        if(err /= 0) call cgi_error("esputr_cgi: error retreiving data")
        call esputr1993_availablecombinations(combinations_1993, err)
        if(err /= 0) call cgi_error("esputr_cgi: error retreiving data")

        write(unit, '(A)') json_header
        write(unit, *) '{'
        call writejsonarray("1993", combinations_1993)
        write(unit, *) ','
        call writejsonarray("2007N", combinations_2001_n)
        write(unit, *) ','
        call writejsonarray("2007TH", combinations_2001_th)
        write(unit, *) '}'
        
        call cgi_end()
    end subroutine sendavailablecombinations

    subroutine writejsonarray(name, arr)
        character(*), intent(in) :: name
        character(*), dimension(:,:), intent(in) :: arr
        integer :: i, iMax, err, indLo, indUp, pid, tid, ptid
        real(kind=ESPUTR_DP) :: eMin, eMax, e_Th
        write(unit, '(3A)') '"', name, '": ['
        imax = size(arr, 1)
        do i = 1, imax
            write(unit, '(A)', advance='no') '{'
            write(unit, '(3A)', advance='no') '"projectile":"', trim(arr(i, 1)), '",'
            write(unit, '(3A)', advance='no') '"target":"',     trim(arr(i, 2)), '"'
            if(index(name, "TH") > 0) then
                call esputr2001_getprojectiletargetidsth(arr(i, 1), arr(i, 2), indlo, indup, err)
                if(err /= 0) call cgi_error("esputr_cgi: error while retrieving ids")
                call esputr2001_getavailableenergyrange(indlo, indup, emin, emax, err)
                if(err /= 0) call cgi_error("esputr_cgi: error while retrieving energy information")
                write(unit, '(A,E12.5,A,E12.5,A)', advance='no') ',"energyRange":[',emin,',',emax,']'
            else
                if(index(name, "1993") > 0) then
                    pid = esputr1993_getprojectileid(arr(i, 1), err)
                    if(err /= 0) call cgi_error("esputr_cgi: error while retrieving projectile id")
                    tid = esputr1993_gettargetid(arr(i, 2), err)
                    if(err /= 0) call cgi_error("esputr_cgi: error while retrieving target id")
                    e_th = esputr1993_eth(pid, tid, err)
                    if(err /= 0) call cgi_error("esputr_cgi: error while retrieving E_th")
                else
                    ptid = esputr2001_getprojectiletargetidn(arr(i, 1), arr(i, 2), err)
                    if(err /= 0) call cgi_error("esputr_cgi: error while retrieving projectile-target id")
                    e_th = esputr2001_eth(ptid, err)
                    if(err /= 0) call cgi_error("esputr_cgi: error while retrieving E_th")
                end if
                write(unit, '(A,E12.5)', advance='no') ',"E_th":',e_th
            end if
            write(unit, '(A)', advance='no') '}'
            if(i < imax) write(unit, '(A)') ','
        end do
        write(unit, *) "]"
    end subroutine writejsonarray
    
    subroutine initesputr()
        call esputr1993_init("../data/SPUTER", err)
        if(err /= 0) call cgi_error("esputr_cgi: initialization error")
        call esputr2001_init("../data/ECKSTEIN2007N", "../data/ECKSTEIN2007TH", err)
        if(err /= 0) call cgi_error("esputr_cgi: initialization error")
    end subroutine initesputr

    character(DICT_VALUE_LENGTH*2) function getlastmessage()
        getlastmessage = ""
        backspace(tmp_unit, iostat=err)
        backspace(tmp_unit, iostat=err)
        read(tmp_unit, '(A)') getlastmessage(1:dict_value_length)
        read(tmp_unit, '(A)') getlastmessage(len_trim(getlastmessage)+1:dict_value_length*2)
    end function

end program esputr_cgi