diff options
Diffstat (limited to 'Dragon/src/LIBNOT.f')
| -rw-r--r-- | Dragon/src/LIBNOT.f | 140 |
1 files changed, 140 insertions, 0 deletions
diff --git a/Dragon/src/LIBNOT.f b/Dragon/src/LIBNOT.f new file mode 100644 index 0000000..6ac7da0 --- /dev/null +++ b/Dragon/src/LIBNOT.f @@ -0,0 +1,140 @@ +*DECK LIBNOT + SUBROUTINE LIBNOT (IPLIB,NGRO,NL,NDIL,NED,NDEL,IMPX,LSCAT,LSIGF, + 1 LADD,DILUT,FLUX,TOTAL,SIGF,SIGS,SCAT,SADD,ZDEL,HVECT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Write the incremental x-s data on a temperature-independant Draglib. +* +*Copyright: +* Copyright (C) 2002 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version +* +*Author(s): A. Hebert +* +*Parameters: input +* IPLIB pointer to the internal library (L_LIBRARY signature). +* NGRO number of energy groups. +* NL number of Legendre orders required in the calculation +* (NL=1 or higher). +* NDIL number of finite dilutions. +* NED number of extra vector edits. +* NDEL number of delayed neutron precursor groups. +* IMPX print flag. +* LSCAT Legendre flag (=.true. if a given Legendre order of the +* scattering cross section exists). +* LSIGF fission flag (=.true. if the isotope can fission). +* LADD additional xs flag (=.true. if a given additional cross +* section exists). +* DILUT dilutions. +* FLUX weighting flux. +* TOTAL total cross sections. +* SIGF nu*fission cross sections. +* SIGS diffusion cross sections. +* SCAT scattering transfer matrices (sec,prim,Legendre,dilution). +* SADD additional cross sections. +* ZDEL delayed nu-sigf cross sections. +* HVECT names of the extra vector edits. +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPLIB + INTEGER NGRO,NL,NDIL,NED,NDEL,IMPX + REAL DILUT(NDIL+1),FLUX(NGRO,NDIL+1),TOTAL(NGRO,NDIL+1), + 1 SIGF(NGRO,NDIL+1),SIGS(NGRO,NL,NDIL+1),SCAT(NGRO,NGRO,NL,NDIL+1), + 2 SADD(NGRO,NED,NDIL+1),ZDEL(NGRO,NDEL,NDIL+1) + LOGICAL LSIGF,LSCAT(NL),LADD(NED) + CHARACTER HVECT(NED)*8 +*---- +* LOCAL VARIABLES +*---- + CHARACTER TEXT12*12,CD*4 + INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO + REAL, ALLOCATABLE, DIMENSION(:) :: GAS + REAL, ALLOCATABLE, DIMENSION(:,:) :: GA1 + REAL, ALLOCATABLE, DIMENSION(:,:,:) :: GA2 +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(ITYPRO(NL)) + ALLOCATE(GAS(NGRO),GA1(NGRO,NL),GA2(NGRO,NGRO,NL)) +* + CALL LCMPUT(IPLIB,'DILUTION',NDIL,2,DILUT) + DO 130 IDIL=1,NDIL + WRITE (CD,'(I4.4)') IDIL + CALL LCMSIX(IPLIB,'SUBMAT'//CD,1) + DO 10 IG1=1,NGRO + GAS(IG1)=FLUX(IG1,IDIL)-1.0 + 10 CONTINUE + CALL LCMPUT(IPLIB,'NWT0',NGRO,2,GAS) + DO 20 IG1=1,NGRO + GAS(IG1)=TOTAL(IG1,IDIL)*FLUX(IG1,IDIL)-TOTAL(IG1,NDIL+1) + 20 CONTINUE + CALL LCMPUT(IPLIB,'NTOT0',NGRO,2,GAS) + IF(LSIGF) THEN + DO 30 IG1=1,NGRO + GAS(IG1)=SIGF(IG1,IDIL)*FLUX(IG1,IDIL)-SIGF(IG1,NDIL+1) + 30 CONTINUE + CALL LCMPUT(IPLIB,'NUSIGF',NGRO,2,GAS) + ENDIF + INGRO=NL-1 + DO 40 IL=NL-1,0,-1 + IF(.NOT.LSCAT(IL+1)) THEN + INGRO=INGRO-1 + ELSE + GO TO 50 + ENDIF + 40 CONTINUE + 50 DO 80 IL=1,INGRO+1 + IF(LSCAT(IL)) THEN + DO 65 IG1=1,NGRO + GA1(IG1,IL)=SIGS(IG1,IL,IDIL)*FLUX(IG1,IDIL)- + 1 SIGS(IG1,IL,NDIL+1) + DO 60 IG2=1,NGRO + GA2(IG1,IG2,IL)=SCAT(IG1,IG2,IL,IDIL)*FLUX(IG2,IDIL)- + 1 SCAT(IG1,IG2,IL,NDIL+1) + 60 CONTINUE + 65 CONTINUE + ELSE + DO 75 IG1=1,NGRO + GA1(IG1,IL)=0.0 + DO 70 IG2=1,NGRO + GA2(IG1,IG2,IL)=0.0 + 70 CONTINUE + 75 CONTINUE + ENDIF + 80 CONTINUE + CALL XDRLGS(IPLIB,1,IMPX,0,INGRO,1,NGRO,GA1,GA2,ITYPRO) + DO 100 IED=1,NED + IF(LADD(IED)) THEN + DO 90 IG1=1,NGRO + GAS(IG1)=SADD(IG1,IED,IDIL)*FLUX(IG1,IDIL)-SADD(IG1,IED,NDIL+1) + 90 CONTINUE + CALL LCMPUT(IPLIB,HVECT(IED),NGRO,2,GAS) + ENDIF + 100 CONTINUE + DO 120 IDEL=1,NDEL + WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL + DO 110 IG1=1,NGRO + GAS(IG1)=ZDEL(IG1,IDEL,IDIL)*FLUX(IG1,IDIL)-ZDEL(IG1,IDEL,NDIL+1) + 110 CONTINUE + CALL LCMPUT(IPLIB,TEXT12,NGRO,2,GAS) + 120 CONTINUE + CALL LCMSIX(IPLIB,' ',2) + 130 CONTINUE + IF(IMPX.GT.3) CALL LCMLIB(IPLIB) +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(GA2,GA1,GAS) + DEALLOCATE(ITYPRO) + RETURN + END |