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/SALTCG.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/SALTCG.f')
| -rw-r--r-- | Dragon/src/SALTCG.f | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/Dragon/src/SALTCG.f b/Dragon/src/SALTCG.f index 123a288..dcf496f 100644 --- a/Dragon/src/SALTCG.f +++ b/Dragon/src/SALTCG.f @@ -57,10 +57,10 @@ PARAMETER (IOUT=6,NAMSBR='SALTCG') INTEGER NSTATE PARAMETER (NSTATE=40) - INTEGER NMAX0 + INTEGER NMAX0,MAXCDA DOUBLE PRECISION PI,DZERO,DONE,DTWO,DSUM PARAMETER (PI=3.14159265358979, DZERO=0.0D0,DONE=1.0D0, - > DTWO=2.0D0,NMAX0=100000) + > DTWO=2.0D0,NMAX0=100000,MAXCDA=30) *---- * Functions *---- @@ -68,8 +68,8 @@ *---- * Local variables *---- - INTEGER ISTATE(NSTATE),IEDIMG(NSTATE),ICODE(6) - REAL RSTATT(NSTATE),ALBEDO(6) + INTEGER ISTATE(NSTATE),IEDIMG(NSTATE),ICODE(MAXCDA) + REAL RSTATT(NSTATE),ALBEDO(MAXCDA) INTEGER RENO,LTRK,AZMOAQ,ISYMM,POLQUA,POLOAQ,AZMQUA, > AZMNBA,OK DOUBLE PRECISION DENUSR,RCUTOF,DENLIN,SPACLN,WEIGHT @@ -81,7 +81,7 @@ > MAXSUB,MAXSGL,NBDR,ILONG,ITYLCM,IPER(3) INTEGER JJ,KK,NCOR,NQUAD,NANGL,NBANGL,LINMAX DOUBLE PRECISION DQUAD(4),ABSC(3,2),RCIRC,SIDEH,ANGLE - CHARACTER CTRK*4,COMENT*80 + CHARACTER CTRK*4,COMENT*80,HSMG*131 INTEGER IFMT,NEREG,NESUR *---- * Allocatable arrays @@ -132,7 +132,11 @@ * Get main tracking records *---- CALL LCMLEN(IPTRK,'ICODE ',ILONG,ITYLCM) - IF(ILONG.GT.6) CALL XABORT('SALTCG: ALBEDO OVERFLOW.') + IF(ILONG.GT.MAXCDA) THEN + WRITE(HSMG,'(24HSALTCG: The geometry has,I3,15H albedo values , + 1 2H(>,I3,2H).)') ILONG,MAXCDA + CALL XABORT(HSMG) + ENDIF CALL LCMGET(IPTRK,'ICODE ',ICODE ) CALL LCMGET(IPTRK,'ALBEDO ',ALBEDO) CALL LCMSIX(IPTRK,'NXTRecords ',1) |