diff options
| author | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
|---|---|---|
| committer | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
| commit | 7dfcc480ba1e19bd3232349fc733caef94034292 (patch) | |
| tree | 03ee104eb8846d5cc1a981d267687a729185d3f3 /Dragon/src/SYB32C.f | |
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Dragon/src/SYB32C.f')
| -rw-r--r-- | Dragon/src/SYB32C.f | 55 |
1 files changed, 55 insertions, 0 deletions
diff --git a/Dragon/src/SYB32C.f b/Dragon/src/SYB32C.f new file mode 100644 index 0000000..f091425 --- /dev/null +++ b/Dragon/src/SYB32C.f @@ -0,0 +1,55 @@ +*DECK SYB32C + SUBROUTINE SYB32C (PPLUS,TAUP,POPI,M) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Evaluation of the $E_i$ function in 2D geometry. +* +*Copyright: +* Copyright (C) 2002 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version +* +*Author(s): A. Hebert +* +*Parameters: input +* TAUP initial optical path. +* POPI delta optical path. +* M order of the Bickley function (equal to M+1). +* +*Parameters: output +* PPLUS value of the difference. +* +*----------------------------------------------------------------------- +* +*---- +* SUBROUTINE ARGUMENTS +*---- + REAL PPLUS,TAUP,POPI + INTEGER M +*---- +* LOCAL VARIABLES +*---- + PARAMETER (MKI3=600) + COMMON /BICKL3/BI3(0:MKI3),BI31(0:MKI3),BI32(0:MKI3),PAS3,XLIM3,L3 +* + TAUQ=TAUP+POPI + IF(TAUP.GE.XLIM3) THEN + PPLUS=0. + ELSE IF(TAUQ.GE.XLIM3) THEN + PPLUS=TABKI(M+1,TAUP) + ELSE IF(POPI.LE.0.002) THEN + PPLUS=(TABKI(M,TAUP)+TABKI(M,TAUQ))*POPI*0.5 + ELSE IF(POPI.LT.0.004) THEN + PQLUS=(TABKI(M,TAUP)+TABKI(M,TAUQ))*POPI*0.5 + PRLUS=TABKI(M+1,TAUP)-TABKI(M+1,TAUQ) + FACT=500.0*(POPI-0.002) + PPLUS=PRLUS*FACT+PQLUS*(1.0-FACT) + ELSE + PPLUS=TABKI(M+1,TAUP)-TABKI(M+1,TAUQ) + ENDIF + RETURN + END |