text:
!> fpm test vdb_init --runner build\gfortran_2A42023B310FA28D\app\vdb.exe -- ARGS
program vdb

    use context, only: get_fpm_cmd, processing_json, vdb_clean
    use stdlib_string_type, only: string_type, write (formatted)
    implicit none
    type(string_type) :: app
    type(string_type), allocatable :: args(:)
    character(:), allocatable :: type

    print *, ""

    call get_fpm_cmd(app, args, type)

    select case (type)
    case ("build")
        call processing_json(app, args)
    case ("clean")

        call vdb_clean()

    end select

end program vdb

max_stars_repo_name: zoziha/vdb

max_issues_repo_name: zoziha/vdb

max_forks_repo_name: zoziha/vdb


text:
C
C	$Id: dashbd.f,v 1.5 2008-07-27 00:23:02 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE DASHBD
C
C Calling this do-nothing subroutine forces "ld" to load the following
C block data routine (but only if they are in the same ".f" file).
C
        RETURN
C
      END
CNOSPLIT
      BLOCKDATA DASHBDX
C
C DASHBDX IS USED TO INITIALIZE VARIABLES IN NAMED COMMON.
C
      COMMON/INTPR/IPAU,FPART,TENSN,NP,SMALL,L1,ADDLR,ADDTB,MLLINE,
     1    ICLOSE
      COMMON /DSHD/   ISL        ,L          ,IP(16)
      COMMON /DSHDA/  IFSTFL
      COMMON /DSHDC/ IXSTOR,IYSTOR
      COMMON /DSHDD/ IFCFLG, MASK
      SAVE
C
C ISL IS A FLAG FOR AN ALL SOLID PATTERN (+1) OR AN ALL GAP PATTERN (-1)
C
      DATA ISL /1/
C
C
C IFSTFL IS A FLAG TO CONTROL THAT FRSTD IS CALLED BEFORE VECTD IS
C CALLED ANY TIME WHEN DASHDB HAS BEEN CALLED.
C
      DATA IFSTFL /1/
C
C  INTERNAL PARAMETERS
C
      DATA IPAU/3/
      DATA FPART/1./
      DATA TENSN/2.5/
      DATA NP/150/
      DATA SMALL/128./
      DATA L1/70/
      DATA ADDLR/2./
      DATA ADDTB/2./
      DATA MLLINE/384/
      DATA ICLOSE/6/
C
C IFCFLG IS THE FIRST CALL FLAG FOR DASHDB.
C
      DATA IFCFLG /1/
C
C IXSTOR AND IYSTOR CONTAIN THE CURRENT PEN POSITION. THEY ARE
C INITIALIZED TO AN IMPOSSIBLE POSITION
C
      DATA IXSTOR,IYSTOR /-9999,-9999/
C
C
C REVISION HISTORY--------
C
C APRIL 1984        CONVERTED TO FORTRAN77 AND GKS.
C
C DECEMBER 1979     ADDED STATISTICS CALL AND REVISION HISTORY
C                   DID NOT CHANGE CARD COUNT
C
C------------------------------------------------------------
      END

ext: f

max_stars_repo_name: tenomoto/ncl

max_issues_repo_name: tenomoto/ncl

max_forks_repo_name: tenomoto/ncl


text:
module utils
contains
  subroutine seedRandomGenerator()
    use mtmod

    external ZBQLINI
    !!write (*,*) "DEBUG: seedRandomGenerator"
    call ZBQLINI(time())
    call sgrnd(time())
    call srand(time())
  end subroutine seedRandomGenerator

  integer function randomInt(upper)
    integer upper
    randomInt=int(generateRandomNumber()*upper)
  end function randomInt

  real function generateRandomNumber()
    use mtmod

    double precision ZBQLU01,ZBQLUAB, ZBQLEXP
    integer i

    !call seedRandomGenerator()

    !!write (*,*) "DEBUG: generateRandomNumber"
    !if(modulo(time(),2) == 0) then
    !   generateRandomNumber=grnd() !<- Ova implementacija Mersenne twistera je koma za ovu svrhu
    !else
    !   generateRandomNumber=ZBQLU01(i)
       !generateRandomNumber=rand()
    !endif
    generateRandomNumber=grnd()
    if (generateRandomNumber==1) generateRandomNumber=0 ! Računamo da se nikad ne dobije 1, jer bi to potrgalo sve
    return
  end function generateRandomNumber

  integer function generateZeroOne() result(rnd)
    real generated

    generated=generateRandomNumber()*99
    if(generated>49) then
       rnd=1
    else
       rnd=0
    endif
    return
  end function generateZeroOne

  subroutine increment(var,val)
    integer var,val
    var = var + val
    return
  end subroutine increment

  subroutine decrement(var,val)
    integer var,val
    var = var - val
    return
  end subroutine decrement
end module utils

max_stars_repo_name: krvoje/ca-bibd-generator

max_issues_repo_name: krvoje/ca-bibd-generator

max_forks_repo_name: krvoje/ca-bibd-generator


! ##################################################################################################################################
! Begin MIT license text.
! _______________________________________________________________________________________________________

! Copyright 2019 Dr William R Case, Jr (dbcase29@gmail.com)

! Permission is hereby granted, free of charge, to any person obtaining a copy of this software and
! associated documentation files (the "Software"), to deal in the Software without restriction, including
! without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to
! the following conditions:

! The above copyright notice and this permission notice shall be included in all copies or substantial
! portions of the Software and documentation.

! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
! OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
! _______________________________________________________________________________________________________

! End MIT license text.

      SUBROUTINE PARTITION_VEC ( NDOF_X, CSET_X, CSET_1, CSET_2, PART_VEC )

! Creates a partitioning vector, PART_VEC, containing 1's and 2's in a vector for displ set CSET_X:
!   The 1's are for the DOF's belonging to displ set CSET_1 (a subset of CSET_X)
!   The 2's are for the DOF's belonging to displ set CSET_2 (the compliment of CSET_1 in CSET_X)

      USE PENTIUM_II_KIND, ONLY       :  BYTE, LONG, DOUBLE
      USE IOUNT1, ONLY                :  WRT_ERR, WRT_LOG, ERR, F04, F06
      USE SCONTR, ONLY                :  BLNK_SUB_NAM, FATAL_ERR, NDOFG
      USE TIMDAT, ONLY                :  TSEC
      USE SUBR_BEGEND_LEVELS, ONLY    :  PARTITION_VEC_BEGEND
      USE DOF_TABLES, ONLY            :  TDOFI

      USE PARTITION_VEC_USE_IFs

      IMPLICIT NONE

      CHARACTER(LEN=LEN(BLNK_SUB_NAM)):: SUBR_NAME = 'PARTITION_VEC'
      CHARACTER(LEN=*), INTENT(IN )   :: CSET_X            ! Char description of displ set (e.g. 'A ' or 'SG')
      CHARACTER(LEN=*), INTENT(IN )   :: CSET_1            ! Char description of displ set (e.g. 'A ' or 'SG')
      CHARACTER(LEN=*), INTENT(IN )   :: CSET_2            ! Char description of displ set (e.g. 'A ' or 'SG')

      INTEGER(LONG), INTENT(IN )      :: NDOF_X            ! No. DOF's in CSET_X displ set
      INTEGER(LONG), INTENT(OUT)      :: PART_VEC(NDOF_X)  ! The partitioning vector described above
      INTEGER(LONG)                   :: I                 ! DO loop index
      INTEGER(LONG)                   :: IDOF              ! Internal DOF no. for a DOF in CSET_X
      INTEGER(LONG)                   :: SET_X             ! Col no. in array TDOFI where the DOF list is for CSET_X
      INTEGER(LONG)                   :: SET_1             ! Col no. in array TDOFI where the DOF list is for CSET_1
      INTEGER(LONG)                   :: SET_2             ! Col no. in array TDOFI where the DOF list is for CSET_2
      INTEGER(LONG), PARAMETER        :: SUBR_BEGEND = PARTITION_VEC_BEGEND

! **********************************************************************************************************************************
      IF (WRT_LOG >= SUBR_BEGEND) THEN
         CALL OURTIM
         WRITE(F04,9001) SUBR_NAME,TSEC
 9001    FORMAT(1X,A,' BEGN ',F10.3)
      ENDIF

! **********************************************************************************************************************************
! Initialize outputs

      DO I=1,NDOF_X
         PART_VEC(I) = 0
      ENDDO

! Get TDOF column numbers

      CALL TDOF_COL_NUM ( CSET_X, SET_X )
      CALL TDOF_COL_NUM ( CSET_1, SET_1 )
      CALL TDOF_COL_NUM ( CSET_2, SET_2 )

! Create partitioning vector

      DO I=1,NDOFG

         IDOF = TDOFI(I,SET_X)
         IF (IDOF > 0) THEN
            IF      (TDOFI(I,SET_1) > 0) THEN
               PART_VEC(IDOF) = 1
            ELSE IF (TDOFI(I,SET_2) > 0) THEN
               PART_VEC(IDOF) = 2
            ELSE
               WRITE(ERR,931) SUBR_NAME, CSET_X, CSET_1, CSET_2
               WRITE(F06,931) SUBR_NAME, CSET_X, CSET_1, CSET_2
               FATAL_ERR = FATAL_ERR + 1
               CALL OUTA_HERE ( 'Y' )                            ! Coding error (2 sets not complimentary), so quit
            ENDIF
         ENDIF

      ENDDO

! **********************************************************************************************************************************
      IF (WRT_LOG >= SUBR_BEGEND) THEN
         CALL OURTIM
         WRITE(F04,9002) SUBR_NAME,TSEC
 9002    FORMAT(1X,A,' END  ',F10.3)
      ENDIF

      RETURN

! **********************************************************************************************************************************
  931 FORMAT(' *ERROR   931: PROGRAMMING ERROR IN SUBROUTINE ',A                                                                   &
                    ,/,14X,' ATTEMPT TO CREATE PARTITIONING VECTOR FROM 2 SETS THAT ARE NOT COMPLIMENTARY TO THE OUTPUT SET'       &
                    ,/,14X,' THE SET TO PARTITION IS "',A,'". THE SETS TO PARTITION IT INTO ARE "',A,'" AND "',A,'"')

! **********************************************************************************************************************************

      END SUBROUTINE PARTITION_VEC


!//=========================================================================
!// Oslo CTM3
!//=========================================================================
!// Ole Amund Sovde, April 2015
!//=========================================================================
!// Mineral dust.
!//=========================================================================
module dust_oslo
  !// ----------------------------------------------------------------------
  !// MODULE: dust_oslo
  !// DESCRIPTION: DUMMY
  !//
  !// Ole Amund Sovde, October 2009
  !// ----------------------------------------------------------------------
  use cmn_precision, only: r8
  !// ----------------------------------------------------------------------
  implicit none
  !// ----------------------------------------------------------------------
  integer   :: dust_trsp_idx(1)
  character(len=*), parameter, private :: f90file = 'dust_oslo.f90 (DUMMY)'
  !// ----------------------------------------------------------------------

contains

  !// ----------------------------------------------------------------------
  subroutine dust_init(NDAY,DT_DUST)
    !// --------------------------------------------------------------------
    !// DUMMY
    !//
    !// Ole Amund Sovde, October 2009
    !// --------------------------------------------------------------------
    implicit none
    !// --------------------------------------------------------------------
    !// Input
    integer, intent(in) :: NDAY
    real(r8), intent(in) :: DT_DUST
    !// --------------------------------------------------------------------
    return
    !// --------------------------------------------------------------------
  end subroutine dust_init
  !// ----------------------------------------------------------------------

  !// ----------------------------------------------------------------------
  subroutine dust_globalupdate(NDAY)
    !// --------------------------------------------------------------------
    !// DUMMY
    !//
    !// Ole Amund Sovde, October 2009
    !// --------------------------------------------------------------------
    !// --------------------------------------------------------------------
    Implicit NONE
    !// --------------------------------------------------------------------
    !// Input
    integer, intent(in) :: NDAY
    !// --------------------------------------------------------------------
    return
    !// --------------------------------------------------------------------
  end subroutine dust_globalupdate
  !// ----------------------------------------------------------------------

  !// ----------------------------------------------------------------------
  subroutine dust_master(BTT, AIRB, BTEM, DTCHM, NOPS, MP)
    !// --------------------------------------------------------------------
    !// Master interaction between Oslo CTM3 and DEAD.
    !// Called from oc_master in oc_main.f
    !//
    !//
    !// Ole Amund Sovde, October 2009
    !// --------------------------------------------------------------------
    use cmn_size, only: NPAR, JPAR, LPAR, IDBLK, JDBLK
    !// --------------------------------------------------------------------
    Implicit NONE
    !// --------------------------------------------------------------------
    !// Input
    integer, intent(in)   :: NOPS, MP
    real(r8), intent(in)  :: DTCHM
    real(r8), intent(in), dimension(LPAR,IDBLK,JDBLK) :: AIRB, BTEM
    real(r8), intent(in), dimension(LPAR,NPAR,IDBLK,JDBLK) :: BTT
    !// --------------------------------------------------------------------
    return
    !// --------------------------------------------------------------------
  end subroutine dust_master
  !// ----------------------------------------------------------------------

  !// ----------------------------------------------------------------------
  subroutine dustbdg2file(NDAY, NDAYI, NDAY0)
    !// --------------------------------------------------------------------
    !// DUMMY.
    !//
    !// Ole Amund Sovde, March 2016
    !// --------------------------------------------------------------------
    implicit none
    !// --------------------------------------------------------------------
    !// Input
    !// --------------------------------------------------------------------
    integer, intent(in) :: NDAY, NDAYI, NDAY0
    !// --------------------------------------------------------------------
    !character(len=*), parameter :: subr = 'dustbdg2file'
    !// --------------------------------------------------------------------
    return
    !// --------------------------------------------------------------------
  end subroutine dustbdg2file
  !// ----------------------------------------------------------------------

  !// ----------------------------------------------------------------------
  subroutine dustInstBdg(NDAY,NDAY0,NMET,NOPS,DTOPS)
    !// --------------------------------------------------------------------
    !// DUMMY.
    !// Should never be called due to LDUST test, but it is needed for
    !// compilation.
    !//
    !// Ole Amund Sovde, February 2015
    !// --------------------------------------------------------------------
    implicit none
    !// --------------------------------------------------------------------
    integer, intent(in) :: NDAY,NDAY0,NMET,NOPS
    real(r8), intent(in) :: DTOPS
    !// --------------------------------------------------------------------
    !character(len=*), parameter :: subr = 'dustInstBdg'
    !// --------------------------------------------------------------------
    return
    !// --------------------------------------------------------------------
  end subroutine dustInstBdg
  !// ----------------------------------------------------------------------

  !//-----------------------------------------------------------------------
  subroutine dust_set_ssrd(r8data)
    !//---------------------------------------------------------------------
    !// DUMMY.
    !//
    !// Ole Amund Sovde, January 2016
    !//---------------------------------------------------------------------
    use cmn_size, only: IPAR, JPAR
    !//---------------------------------------------------------------------
    implicit none
    !//---------------------------------------------------------------------
    !// Input
    real(r8), intent(in) :: r8data(ipar,jpar)
    !//---------------------------------------------------------------------
    return
    !//---------------------------------------------------------------------
  end subroutine dust_set_ssrd
  !//-----------------------------------------------------------------------

  !//-----------------------------------------------------------------------
  subroutine dust_set_strd(r8data)
    !//---------------------------------------------------------------------
    !// DUMMY.
    !//
    !// Ole Amund Sovde, January 2016
    !//---------------------------------------------------------------------
    use cmn_size, only: IPAR, JPAR
    !//---------------------------------------------------------------------
    implicit none
    !//---------------------------------------------------------------------
    !// Input
    real(r8), intent(in) :: r8data(ipar,jpar)
    !//---------------------------------------------------------------------
    return
    !//---------------------------------------------------------------------
  end subroutine dust_set_strd
  !//-----------------------------------------------------------------------

  !//-----------------------------------------------------------------------
  subroutine dust_set_SWVL1(r8data)
    !//---------------------------------------------------------------------
    !// DUMMY.
    !//
    !// Ole Amund Sovde, January 2016
    !//---------------------------------------------------------------------
    use cmn_size, only: IPAR, JPAR
    !//---------------------------------------------------------------------
    implicit none
    !//---------------------------------------------------------------------
    !// Input
    real(r8), intent(in) :: r8data(ipar,jpar)
    !//---------------------------------------------------------------------
    return
    !//---------------------------------------------------------------------
  end subroutine dust_set_SWVL1
  !//-----------------------------------------------------------------------

  !//-----------------------------------------------------------------------
  subroutine dust_set_mbl_name_ff(name,fudgefactor)
    !//---------------------------------------------------------------------
    !// DUMMY.
    !//
    !// Ole Amund Sovde, March 2016
    !//---------------------------------------------------------------------
    implicit none
    !//---------------------------------------------------------------------
    !// Input
    character(len=*), intent(in) :: name
    real(r8), intent(in) :: fudgefactor
    !//---------------------------------------------------------------------
    character(len=*), parameter :: subr = 'dust_set_mbl_name'
    !// --------------------------------------------------------------------
    write(6,'(a)') f90file//':'//subr// &
         ': DUST not included; skip defining mobilisation variable name'// &
         ' and fudge factor'
    !//---------------------------------------------------------------------
  end subroutine dust_set_mbl_name_ff
  !//-----------------------------------------------------------------------

  !// ----------------------------------------------------------------------
end module dust_oslo
!//=========================================================================


text:
module crosssection
    use main
    use constants
    use transition
    contains
    function diffCrossSection(v, q)
        ! Computes the differential cross section per recoil energy ds/dEr
        implicit none
        real(kind=8) :: diffCrossSection
        real(kind=8) :: v ! velocity of DM particle in lab frame
        real(kind=8) :: q

        diffCrossSection = (nuc_target%mass*mN/(2d0*pi*v*v)) * transition_probability(v, q)

    end function diffCrossSection
end module

max_stars_repo_name: ogorton/dmfortfactor

max_issues_repo_name: ogorton/dmfortfactor

max_forks_repo_name: ogorton/dmfortfactor