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/SALACG.f90 | |
| parent | 2108052f8d9879e098c619b04dccb82020b8b0c9 (diff) | |
Resolve "Correct SFR geometry issues in module SALT:"
Diffstat (limited to 'Dragon/src/SALACG.f90')
| -rw-r--r-- | Dragon/src/SALACG.f90 | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/Dragon/src/SALACG.f90 b/Dragon/src/SALACG.f90 index 0dbc708..679446c 100644 --- a/Dragon/src/SALACG.f90 +++ b/Dragon/src/SALACG.f90 @@ -45,13 +45,14 @@ SUBROUTINE SALACG(FGEO ,ITRACK, RCUTOF, IPRINT, GG) ! Local variables !---- INTEGER, PARAMETER :: NSTATE=40 - INTEGER, PARAMETER :: NDIM=2 ! NUMBER OF DIMENSIONS - INTEGER, PARAMETER :: NALBG=6 ! NUMBER OF ALBEDOS + INTEGER, PARAMETER :: NDIM=2 ! NUMBER OF DIMENSIONS + INTEGER, PARAMETER :: MAXCDA=30 ! MAXIMUM NUMBER OF ALBEDOS LOGICAL LGINF INTEGER, DIMENSION(NSTATE) :: I_STATE,IEDIMG - INTEGER OK,I,J,NREG,ELEM,NFREG,LEAK,NSOUT,ICODE(NALBG),INDEX,MMAX - REAL GALBED(NALBG) + INTEGER NALBG,OK,I,J,NREG,ELEM,NFREG,LEAK,NSOUT,ICODE(MAXCDA),INDEX,MMAX + REAL GALBED(MAXCDA) CHARACTER(LEN=72) TEXT72 + CHARACTER(LEN=131) HSMG REAL(PDB) :: DGMESHX(2),DGMESHY(2) !---- ! Allocatable arrays @@ -234,10 +235,16 @@ SUBROUTINE SALACG(FGEO ,ITRACK, RCUTOF, IPRINT, GG) VOLSUR(1:NREG)=VOLUME(:NREG) DEALLOCATE(VOLUME) ! boundary conditions structures - ICODE(:NALBG)=(/ (-I,I=1,NALBG) /) - GALBED(:NALBG)=REAL(GG%ALBEDO) + ICODE(:MAXCDA)=(/ (-I,I=1,MAXCDA) /) + GALBED(:MAXCDA)=REAL(GG%ALBEDO) + IF(GG%NALBG.GT.MAXCDA) THEN + WRITE(HSMG,'(24HSALACG: The geometry has,I3,17H albedo values (>,I3,2H).)') & + & GG%NALBG,MAXCDA + CALL XABORT(HSMG) + ENDIF IF(ISPEC == 0) THEN - IF(GG%NALBG > 6) CALL XABORT('SALACG: Albedo array overflow(1).') + NALBG=GG%NALBG + IF(TYPGEO.EQ.0) NALBG=6 DO I=1,NSOUT KEYMRG(-I)=-I VOLSUR(-I)=GG%SURF2(I) @@ -247,10 +254,8 @@ SUBROUTINE SALACG(FGEO ,ITRACK, RCUTOF, IPRINT, GG) MATALB(-I)=-1 GALBED(1)=REAL(GG%ALBEDO) ELSE - IF(INDEX.GT.6) CALL XABORT('SALACG: SDIRE overflow.') - IF(INDEX > GG%NALBG) THEN - CALL XABORT('SALACG: Albedo array overflow(2).') - ENDIF + IF(INDEX.GT.MAXCDA) CALL XABORT('SALACG: INDEX overflow(1).') + IF(INDEX.GT.GG%NALBG) CALL XABORT('SALACG: INDEX overflow(2).') MATALB(-I)=-INDEX IF(SIZE(GG%BCDATA) > 0) THEN GALBED(INDEX)=REAL(GG%BCDATA(6,INDEX)) @@ -260,13 +265,14 @@ SUBROUTINE SALACG(FGEO ,ITRACK, RCUTOF, IPRINT, GG) ENDIF ENDDO ELSE + NALBG=6 DO I=1,NSOUT VOLSUR(-I)=0.0 KEYMRG(-I)=-I MATALB(-I)=-1 ENDDO GALBED(:NALBG)=1.0 - ENDIF + ENDIF MATALB(0)=0 KEYMRG(0)=0 VOLSUR(0)=0._PDB |