diff options
Diffstat (limited to 'Dragon')
| -rw-r--r-- | Dragon/src/APXCA2.f | 16 | ||||
| -rw-r--r-- | Dragon/src/EDIMIC.f | 39 | ||||
| -rw-r--r-- | Dragon/src/MPOCA2.f | 12 |
3 files changed, 27 insertions, 40 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 diff --git a/Dragon/src/EDIMIC.f b/Dragon/src/EDIMIC.f index e284110..90e1dfb 100644 --- a/Dragon/src/EDIMIC.f +++ b/Dragon/src/EDIMIC.f @@ -172,7 +172,6 @@ MAXH=9+NBESP+2*NDEL+NED+NL+3*NW CALL EDIMAX(NBISO,ISONAM,MIX,IPRINT,NREGIO,NMERGE,MATCOD,IMERGE, 1 LSISO,LISO,MAXISO) - ALLOCATE(IGAR(NGROUP,3,NL),IHNISO(3,MAXISO),ISMIX(MAXISO), 1 ISTYP(MAXISO),ISTOD(MAXISO),ITYPRO(NL),MILVO(NMERGE), 2 ITYPS(NBISO),IMERGL(NBMIX)) @@ -200,11 +199,9 @@ IF(MAXISO.GT.0) JPEDIT=LCMLID(IPEDIT,'ISOTOPESLIST',MAXISO) ENDIF * - DO 10 ISO=1,MAXISO - SDEN(ISO)=0.0 - VOLISO(ISO)=0.0 - JPIFI(ISO)=0 - 10 CONTINUE + SDEN(:MAXISO)=0.0 + VOLISO(:MAXISO)=0.0 + JPIFI(:MAXISO)=0 IOF0H=8+NED+NL+3*NW IOF1H=8+NED+NL+3*NW+NDEL IOF2H=8+NED+NL+3*NW+2*NDEL @@ -349,24 +346,10 @@ * MERGE/CONDENSE REACTIONS 'NWT0','NWT1','NWAT0','NWAT1','SIGS'//CM, * 'SCAT'//CM, 'NTOT0', 'NUSIGF', 'CHI', 'CHIxx', 'STRD' AND HVECT *---- - DO 110 J=1,MAXH+NL - HMAKE(J)=' ' - 110 CONTINUE - DO 121 J=1,MAXH - DO 120 I=1,NGCOND - GAS(I,J)=0.0D0 - 120 CONTINUE - 121 CONTINUE - DO 132 K=1,NL - DO 131 J=1,NGCOND - DO 130 I=1,NGCOND - WSCAT(I,J,K)=0.0D0 - 130 CONTINUE - 131 CONTINUE - 132 CONTINUE - DO 140 I=1,NDEL - WDLA(I)=0.0 - 140 CONTINUE + HMAKE(:MAXH+NL)=' ' + GAS(:NGCOND,:MAXH)=0.0D0 + WSCAT(:NGCOND,:NGCOND,:NL)=0.0D0 + WDLA(:NDEL)=0.0 *---- * RECOVER THE RADIOACTIVE DECAY CONSTANTS OF DELAYED NEUTRON * GROUPS FROM THE MACROLIB IF THEY EXIST @@ -508,9 +491,7 @@ CALL LCMGET(KPLIB,'TRANC',GAR(1,7+NED+NL+3*NW)) HMAKE(7+NED+NL+3*NW)='TRANC' ENDIF - DO 186 IGR=1,NGROUP - GAR(IGR,5+NED+NL+3*NW)=0.0 - 186 CONTINUE + GAR(:NGROUP,5+NED+NL+3*NW)=0.0 CALL LCMLEN(KPLIB,'H-FACTOR',LENGTH,ITYLCM) IF(LENGTH.GT.0) THEN CALL LCMGET(KPLIB,'H-FACTOR',GAR(1,5+NED+NL+3*NW)) @@ -549,9 +530,7 @@ PARM4=0.0D0 PARM12(:NW+1)=0.0D0 IF(IADJ.EQ.0) THEN - DO 206 IW=1,NW+1 - PARM12(IW)=FLUXES(IREGIO,IGR,IW)*DENVOL - 206 CONTINUE + PARM12(:NW+1)=FLUXES(IREGIO,IGR,:NW+1)*DENVOL PARM3=0.0D0 DO 210 JREGIO=1,NREGIO IF(IMERGE(JREGIO).EQ.INM) THEN diff --git a/Dragon/src/MPOCA2.f b/Dragon/src/MPOCA2.f index 70a24a8..49ac76d 100644 --- a/Dragon/src/MPOCA2.f +++ b/Dragon/src/MPOCA2.f @@ -75,8 +75,8 @@ *---- * ALLOCATABLE ARRAYS *---- - INTEGER, ALLOCATABLE, DIMENSION(:) :: IDATAP,IFD1,IAD1,IFD2, - 1 IAD2,IJJ1,NJJ1,IPOS,IJJ2,NJJ2,MIX,ITYPE,IDATAP_MIL,VINTE1D + INTEGER, ALLOCATABLE, DIMENSION(:) :: IDATAP,IFD1,IAD1,IFD2,IAD2, + 1 IJJ1,NJJ1,IPOS,IJJ2,NJJ2,MIX,ITYPE,IDEPL,IDATAP_MIL,VINTE1D INTEGER, ALLOCATABLE, DIMENSION(:) :: REACTION,ISOTOPE INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM,OUPUTID INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: ADRX,VINTE3D @@ -94,7 +94,7 @@ ALLOCATE(ADRX(NREA+3,NISO,NADRX+NMIL),IDATAP(MAXIDA),IFD1(NG), 1 IAD1(NG+1),IFD2(NG),IAD2(NG+1),IJJ1(NMIL),NJJ1(NMIL), 2 IPOS(NMIL),IJJ2(NG),NJJ2(NG),ISONAM(3,NBISO),MIX(NBISO), - 3 ITYPE(NBISO),IDATAP_MIL((2*NG+1)*NISO)) + 3 ITYPE(NBISO),IDEPL(NBISO),IDATAP_MIL((2*NG+1)*NISO)) ALLOCATE(RDATAX(MAXRDA),OVERV(NG),DNUSIG(NG,NPRC+1), 1 DCHI(NG,NPRC),WORKD(NPRC),WORK1(NG*NMIL+1),WORK2(NG), 2 DATA1(NG,NREA),DATA2(NG,NL),DATA3(NG,NG,NL),DATA4(NG,NG), @@ -227,6 +227,7 @@ CALL LCMGET(IPEDIT,'ISOTOPESMIX',MIX) CALL LCMGET(IPEDIT,'ISOTOPESDENS',DEN) CALL LCMGET(IPEDIT,'ISOTOPESTYPE',ITYPE) + CALL LCMGET(IPEDIT,'ISOTOPESTODO',IDEPL) ENDIF NISOTS=0 DO 90 IBISO=1,NBISO @@ -287,6 +288,7 @@ ALLOCATE(DECAYC(NISOTS)) DECAYC(:NISOTS)=0.0 DO 150 IBISO=1,NBISO + IF(IDEPL(IBISO).EQ.1) GO TO 150 IF(MIX(IBISO).EQ.0) GO TO 150 WRITE(TEXT12,'(3A4)') (ISONAM(I0,IBISO),I0=1,3) IISOTS=0 @@ -1007,7 +1009,7 @@ DEALLOCATE(NOMISO,NOMREA) DEALLOCATE(CONCES,DENISO,DEN,DATA4,DATA3,DATA2,DATA1,WORK2,WORK1, 1 WORKD,DCHI,DNUSIG,OVERV,RDATAX) - DEALLOCATE(IDATAP_MIL,ITYPE,MIX,ISONAM,NJJ2,IJJ2,IPOS,NJJ1,IJJ1, - 1 IAD2,IFD2,IAD1,IFD1,IDATAP,ADRX) + DEALLOCATE(IDATAP_MIL,IDEPL,ITYPE,MIX,ISONAM,NJJ2,IJJ2,IPOS,NJJ1, + 1 IJJ1,IAD2,IFD2,IAD1,IFD1,IDATAP,ADRX) RETURN END |