From 56b7c71df99cc14f2de789bf2a2b84f62af42532 Mon Sep 17 00:00:00 2001
From: HEBERT Alain <alain.hebert@polymtl.ca>
Date: Thu, 23 Oct 2025 10:31:44 -0400
Subject: Resolve "Correct SFR geometry issues in module SALT:"

---
 Dragon/src/EXCELP.f | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

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

diff --git a/Dragon/src/EXCELP.f b/Dragon/src/EXCELP.f
index 77a9fab..9781c59 100644
--- a/Dragon/src/EXCELP.f
+++ b/Dragon/src/EXCELP.f
@@ -85,18 +85,18 @@
 *----
 *  LOCAL VARIABLES
 *----
-      INTEGER           IOUT, ICPALL, ICPEND, MXGAUS, NSTATE
+      INTEGER           IOUT, ICPALL, ICPEND, MXGAUS, NSTATE, MAXCDA
       PARAMETER       ( IOUT=6, ICPALL=4, ICPEND=3, MXGAUS=64,
-     >                  NSTATE=40 )
+     >                  NSTATE=40, MAXCDA=30 )
       CHARACTER         NAMSBR*6
       PARAMETER       ( NAMSBR='EXCELP')
       INTEGER           MKI1, MKI2, MKI3, MKI4, MKI5
       PARAMETER       (MKI1=600,MKI2=600,MKI3=600,MKI4=600,MKI5=600)
-      INTEGER           ISTATE(NSTATE),ICODE(6)
+      INTEGER           ISTATE(NSTATE),ICODE(MAXCDA)
       INTEGER           NPROB,ISBG,KSBG,ITYPBC
-      REAL              ALBEDO(6),EXTKOP(NSTATE),CUTOF,RCUTOF,ASCRP,
-     >                  YGSS,XGSS(MXGAUS),WGSS(MXGAUS),WGSSX(MXGAUS),
-     >                  ALBG(6)
+      REAL              ALBEDO(MAXCDA),EXTKOP(NSTATE),CUTOF,RCUTOF,
+     >                  ASCRP,YGSS,XGSS(MXGAUS),WGSS(MXGAUS),
+     >                  WGSSX(MXGAUS),ALBG(MAXCDA)
       LOGICAL           SWVOID, LPIJK
       CHARACTER         CTRKT*4, COMENT*80
       DOUBLE PRECISION  DANG0,DASCRP
@@ -104,7 +104,8 @@
       INTEGER           JJ,MSYM,IL,NALLOC,ITRAK,IANG,IC,IPRT,ISPEC,
      >                  IUN,KSPEC,LOPT,MXSEG,NALBG,NANGL,NCOMNT,NCOR,
      >                  NCORT,NDIM,NGSS,NREG2,NSCRP,NTRK,NUNKNO,JGSS,
-     >                  JUN,IFMT,MXSUB,ISA,IBATCH,IL1   ,III,IND,I,J
+     >                  JUN,IFMT,MXSUB,ISA,IBATCH,IL1,III,IND,I,J,
+     >                  ILONG,ITYLCM
 *----
 *  Variables for NXT: inline tracking
 *----
@@ -153,7 +154,7 @@
      1 + MIN(I+NSOUT+1,J+NSOUT+1)
 *----
 * RECOVER EXCELL SPECIFIC TRACKING INFORMATION.
-*             ALBEDO: SURFACE ALBEDOS (REAL(6))
+*             ALBEDO: SURFACE ALBEDOS (REAL(MAXCDA))
 *             KSPEC : KIND OF PIJ INTEGRATION (0:ISOTROPE,1:SPECULAR)
 *             CUTOF : MFP CUTOFF FOR SPECULAR INTEGRATION
 *----
@@ -162,6 +163,9 @@
       KSPEC=ISTATE(10)
       CALL LCMGET(IPTRK,'EXCELTRACKOP',EXTKOP)
       CUTOF=EXTKOP(1)
+      CALL LCMLEN(IPTRK,'ICODE',ILONG,ITYLCM)
+      IF(ILONG.GT.MAXCDA) CALL XABORT('EXCELP: MAXCDA OVERFLOW(1).')
+      ICODE(:MAXCDA)=0
       CALL LCMGET(IPTRK,'ICODE',ICODE)
       CALL LCMGET(IPTRK,'ALBEDO',ALBG)
 *
@@ -269,16 +273,16 @@
       SWVOID= .FALSE.
       DO ISBG=1,NSBG
         IF(NPSYS(ISBG).NE.0) THEN
-          DO ISA=1,6
-            ALBEDO(ISA)=ALBG(ISA)
-          ENDDO
+          ALBEDO(:MAXCDA)=ALBG(:MAXCDA)
           IF(NALBP .GT. 0) THEN
-            DO ISA=1,6
+            DO ISA=1,MAXCDA
               IF(ICODE(ISA).GT.0) ALBEDO(ISA)=ALBP(ICODE(ISA),ISBG)
             ENDDO
           ENDIF
           DO IUN= -NSOUT, -1
             SIGT00(IUN,ISBG)= 0.0
+            IF(-MATALB(IUN).GT.MAXCDA) CALL XABORT('EXCELP: MAXCDA OV'
+     >      //'ERFLOW(2).')
             SIGTAL(IUN,ISBG)= ALBEDO(-MATALB(IUN))
             SWNZBC= SWNZBC.OR.(SIGTAL(IUN,ISBG).NE.0.0)
           ENDDO
-- 
cgit v1.2.3