diff options
| author | HEBERT Alain <alain.hebert@polymtl.ca> | 2025-10-23 10:31:44 -0400 |
|---|---|---|
| committer | HEBERT Alain <alain.hebert@polymtl.ca> | 2025-10-23 10:31:44 -0400 |
| commit | 5321198af9510e29be2b6a5a3245314e1b5c27cb (patch) | |
| tree | 59432ba3095286067837cbdfcaf0edb56a93d0a1 /Dragon/src/EXCELP.f | |
| parent | 2108052f8d9879e098c619b04dccb82020b8b0c9 (diff) | |
| parent | 56b7c71df99cc14f2de789bf2a2b84f62af42532 (diff) | |
Merge branch '8-correct-sfr-geometry-issues-in-module-salt' into 'main'
Resolve "Correct SFR geometry issues in module SALT:"
See merge request dragon/5.1!16
Diffstat (limited to 'Dragon/src/EXCELP.f')
| -rw-r--r-- | Dragon/src/EXCELP.f | 28 |
1 files changed, 16 insertions, 12 deletions
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 |