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 | 56b7c71df99cc14f2de789bf2a2b84f62af42532 (patch) | |
| tree | 59432ba3095286067837cbdfcaf0edb56a93d0a1 /Dragon/src/PIJWIJ.f | |
| parent | 2108052f8d9879e098c619b04dccb82020b8b0c9 (diff) | |
Resolve "Correct SFR geometry issues in module SALT:"
Diffstat (limited to 'Dragon/src/PIJWIJ.f')
| -rw-r--r-- | Dragon/src/PIJWIJ.f | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/Dragon/src/PIJWIJ.f b/Dragon/src/PIJWIJ.f index c4d9e11..bea36a2 100644 --- a/Dragon/src/PIJWIJ.f +++ b/Dragon/src/PIJWIJ.f @@ -88,13 +88,14 @@ *---- * 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='PIJWIJ') - INTEGER ILONG,ITYPE,NPROB,ISBG,ISTATE(NSTATE),ICODE(6) - REAL FACT,ALBEDO(6),ALBG(6) + INTEGER ILONG,ITYPE,NPROB,ISBG,ISTATE(NSTATE), + > ICODE(MAXCDA) + REAL FACT,ALBEDO(MAXCDA),ALBG(MAXCDA) LOGICAL LSKIP,SWNZBC,SWVOID * INTEGER MSYM,IU,IL,ISOUT,IIN,I,J,IBM,IOP,INDPIJ,IJKS, @@ -125,6 +126,9 @@ ISTATE(:NSTATE)=0 CALL LCMGET(IPTRK,'STATE-VECTOR',ISTATE) KSPEC=ISTATE(10) + CALL LCMLEN(IPTRK,'ICODE',ILONG,ITYPE) + IF(ILONG.GT.MAXCDA) CALL XABORT('PIJWIJ: MAXCDA OVERFLOW(1).') + ICODE(:MAXCDA)=0 CALL LCMGET(IPTRK,'ICODE',ICODE) CALL LCMGET(IPTRK,'ALBEDO',ALBG) *---- @@ -135,11 +139,9 @@ 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 |