diff options
| author | HEBERT Alain <alain.hebert@polymtl.ca> | 2026-01-04 11:33:53 -0500 |
|---|---|---|
| committer | HEBERT Alain <alain.hebert@polymtl.ca> | 2026-01-04 11:33:53 -0500 |
| commit | 37a0700f07547af849a605ec91b62d43c569a286 (patch) | |
| tree | 45b764d8e487a461f5c6e24479030840d0bd39b4 /Dragon/src/APXCA2.f | |
| parent | 0e2eaa1f4619b6a38dc325d6d41def103c92caa5 (diff) | |
| parent | 98b807649ee1f0f813c8d0b2316e5d6ad37d3507 (diff) | |
Merge branch '22-issue-with-the-partial-homogenization-of-a-colorset' into 'main'
#22: Issue with the partial homogenization of a colorset
See merge request dragon/5.1!43
Diffstat (limited to 'Dragon/src/APXCA2.f')
| -rw-r--r-- | Dragon/src/APXCA2.f | 16 |
1 files changed, 11 insertions, 5 deletions
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 |