From 98b807649ee1f0f813c8d0b2316e5d6ad37d3507 Mon Sep 17 00:00:00 2001
From: Alain Hebert <alainhebert@Alains-MacBook-Pro.local>
Date: Sun, 4 Jan 2026 11:10:52 -0500
Subject: #22: Issue with the partial homogenization of a colorset

---
 Dragon/src/APXCA2.f | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

(limited to 'Dragon/src/APXCA2.f')

diff --git a/Dragon/src/APXCA2.f b/Dragon/src/APXCA2.f
index 97aa69e..6663435 100644
--- a/Dragon/src/APXCA2.f
+++ b/Dragon/src/APXCA2.f
@@ -67,7 +67,7 @@
 *----
 *  ALLOCATABLE ARRAYS
 *----
-      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,ITYPE
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: MIX,ITYPE,IDEPL
       INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM
       REAL, ALLOCATABLE, DIMENSION(:) :: OVERV,WORKD,WORK1,WORK2,DEN,
      1 DENISO,ENRGS,VOLMIX,WORK1D
@@ -80,7 +80,7 @@
 *----
 *  SCRATCH STORAGE ALLOCATION
 *----
-      ALLOCATE(ISONAM(3,NBISO),MIX(NBISO),ITYPE(NBISO))
+      ALLOCATE(ISONAM(3,NBISO),MIX(NBISO),ITYPE(NBISO),IDEPL(NBISO))
       ALLOCATE(OVERV(NG),DNUSIG(NG,NPRC+1),DCHI(NG,NPRC),WORKD(NPRC),
      1 WORK1(NG*NMIL+1),WORK2(NG),DEN(NBISO),DENISO(NISO),
      2 CONCES(NISO,NMIL),IPERM(NISO,NMIL),VOLMIX(NMIL))
@@ -170,8 +170,10 @@
           CALL LCMGET(IPTEMP,'ISOTOPESMIX',MIX)
           CALL LCMGET(IPTEMP,'ISOTOPESDENS',DEN)
           CALL LCMGET(IPEDIT,'ISOTOPESTYPE',ITYPE)
+          CALL LCMGET(IPEDIT,'ISOTOPESTODO',IDEPL)
           CALL LIBIPS(IPTEMP,NBISO,IPISO)
           DO IBISO=1,NBISO
+            IF(IDEPL(IBISO).EQ.1) CYCLE
             IMIL=MIX(IBISO)
             IF(IMIL.EQ.0) CYCLE
             WRITE(TEXT12,'(3A4)') (ISONAM(I0,IBISO),I0=1,3)
@@ -187,6 +189,7 @@
         ENDIF
         DO ISO=1,NISO
           DO IMIL=1,NMIL
+            IF(CONCES(ISO,IMIL).EQ.0.0) GO TO 10
             IF(C_ASSOCIATED(IPERM(ISO,IMIL))) GO TO 10
           ENDDO
           WRITE(HSMG,'(17HAPXCA2: ISOTOPE '',A8,7H'' (ISO=,I8,3H) I,
@@ -204,12 +207,15 @@
           DO 40 ISO=1,NISO
           IISOTS=0
           DO 20 IBISO=1,NBISO
-          IISOTS=ISO
+          IF(IDEPL(IBISO).EQ.1) GO TO 20
           IF(MIX(IBISO).EQ.0) GO TO 20
+          IISOTS=ISO
           WRITE(TEXT12,'(3A4)') (ISONAM(I0,IBISO),I0=1,3)
           IF(TEXT12(:8).EQ.NOMISO(ISO)) GO TO 30
    20     CONTINUE
-          CALL XABORT('APXCA2: CANNOT FIND ISOTOPE '//NOMISO(ISO)//'.')
+          WRITE(6,'(48H APXCA2: **WARNING** UNABLE TO FIND THE RADIOACT,
+     1    31HIVE DECAY CONSTANT FOR ISOTOPE ,A,1H.)') TRIM(NOMISO(ISO))
+          GO TO 40
    30     JPEDIT=IPISO(IISOTS)
           IF(.NOT.C_ASSOCIATED(JPEDIT)) GO TO 40
           CALL LCMLEN(JPEDIT,'DECAY',ILONG,ITYLCM)
@@ -403,6 +409,6 @@
       IF(NMAC.GT.0) DEALLOCATE(NOMMAC)
       IF(NREA.GT.0) DEALLOCATE(NOMREA)
       DEALLOCATE(VOLMIX,IPERM,CONCES,DENISO,DEN,WORK2,WORK1,WORKD,DCHI,
-     1 DNUSIG,OVERV,ITYPE,MIX,ISONAM)
+     1 DNUSIG,OVERV,IDEPL,ITYPE,MIX,ISONAM)
       RETURN
       END
-- 
cgit v1.2.3