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/MUSACG.f90 | |
| parent | 2108052f8d9879e098c619b04dccb82020b8b0c9 (diff) | |
Resolve "Correct SFR geometry issues in module SALT:"
Diffstat (limited to 'Dragon/src/MUSACG.f90')
| -rw-r--r-- | Dragon/src/MUSACG.f90 | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/Dragon/src/MUSACG.f90 b/Dragon/src/MUSACG.f90 index 9ceaeb8..3d560e4 100644 --- a/Dragon/src/MUSACG.f90 +++ b/Dragon/src/MUSACG.f90 @@ -54,12 +54,14 @@ SUBROUTINE MUSACG(ITRACK,IFTRK,IPRINT,IMACRO,NBSLIN,RCUTOF,GG,LGINF,NBNODE_MACRO INTEGER, PARAMETER :: NSTATE=40 INTEGER, PARAMETER :: FOUT=6 INTEGER, PARAMETER :: NDIM=2 ! NUMBER OF DIMENSIONS + INTEGER, PARAMETER :: MAXCDA=30 ! MAXIMUM NUMBER OF PERIMETERS INTEGER ELEM, OK, TYPE REAL(PDB) :: X1,X2,Y1,Y2,DET1,DET2 REAL(PDB) :: DGMESHX(2),DGMESHY(2) LOGICAL :: LTEST INTEGER, DIMENSION(NSTATE) :: I_STATE,IEDIMG CHARACTER(LEN=72) :: TEXT72 + CHARACTER(LEN=131) :: HSMG !---- ! Allocatable arrays !---- @@ -384,7 +386,11 @@ SUBROUTINE MUSACG(ITRACK,IFTRK,IPRINT,IMACRO,NBSLIN,RCUTOF,GG,LGINF,NBNODE_MACRO WRITE(FOUT,'(3HEND)') WRITE(FOUT,'(5H--cut,70(1H-),I5)') IMACRO ENDIF - IF(GG_MAC%NBBCDA.GT.6) CALL XABORT('MUSACG: The unfolded geometry has more than 6 perimeters') + IF(GG_MAC%NBBCDA.GT.MAXCDA) THEN + WRITE(HSMG,'(33HMUSACG: The unfolded geometry has,I3,14H perimeters (>,I3,2H).)') & + & GG_MAC%NBBCDA,MAXCDA + CALL XABORT(HSMG) + ENDIF !**** !* compute node perimeters for the macro ALLOCATE (GG_MAC%PPERIM_NODE(GG_MAC%NB_NODE+1),STAT=OK) @@ -649,7 +655,7 @@ SUBROUTINE MUSACG(ITRACK,IFTRK,IPRINT,IMACRO,NBSLIN,RCUTOF,GG,LGINF,NBNODE_MACRO MATALB(-I)=-1 GALBED(1)=REAL(GG_MAC%ALBEDO) ELSE - IF(INDEX.GT.6) CALL XABORT('MUSACG: SDIRE overflow.') + IF(INDEX.GT.MAXCDA) CALL XABORT('MUSACG: INDEX overflow.') IF(INDEX > GG_MAC%NALBG) THEN CALL XABORT('MUSACG: Albedo array overflow(2).') ENDIF |