From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001
From: stainer_t <thomas.stainer@oecd-nea.org>
Date: Mon, 8 Sep 2025 13:48:49 +0200
Subject: Initial commit from Polytechnique Montreal

---
 Dragon/src/SYB33C.f | 44 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 44 insertions(+)
 create mode 100644 Dragon/src/SYB33C.f

(limited to 'Dragon/src/SYB33C.f')

diff --git a/Dragon/src/SYB33C.f b/Dragon/src/SYB33C.f
new file mode 100644
index 0000000..1fa6686
--- /dev/null
+++ b/Dragon/src/SYB33C.f
@@ -0,0 +1,44 @@
+*DECK SYB33C
+      SUBROUTINE SYB33C (PPLUS,TAUP)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Evaluation of the $D_i$ function in 1D cylindrical and 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   optical path.
+*
+*Parameters: output
+* PPLUS  value of the expression.
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      REAL PPLUS,TAUP
+*
+      IF (TAUP .EQ. 0.0) THEN
+         PPLUS=0.0
+      ELSE IF (TAUP .GT. 0.004) THEN
+         PPLUS=TAUP+TABKI(3,TAUP)-TABKI(3,0.0)
+      ELSE IF (TAUP .GT. 0.002) THEN
+         PPLUS=TAUP+TABKI(3,TAUP)-TABKI(3,0.0)
+         PQLUS= 0.5*TAUP*TAUP*TABKI(1,TAUP*0.5)
+         FACT=500.0*(TAUP-0.002)
+         PPLUS=PPLUS*FACT+PQLUS*(1.0-FACT)
+      ELSE
+         PPLUS=0.5*TAUP*TAUP*TABKI(1,TAUP*0.5)
+      ENDIF
+      RETURN
+      END
-- 
cgit v1.2.3