diff options
Diffstat (limited to 'Donjon/src/NEWMGT.f')
| -rw-r--r-- | Donjon/src/NEWMGT.f | 200 |
1 files changed, 200 insertions, 0 deletions
diff --git a/Donjon/src/NEWMGT.f b/Donjon/src/NEWMGT.f new file mode 100644 index 0000000..0578daf --- /dev/null +++ b/Donjon/src/NEWMGT.f @@ -0,0 +1,200 @@ +*DECK NEWMGT + SUBROUTINE NEWMGT(IPMAC,NMIX,NGRP,NL,NDEL,LEAK,NTOT0,NTOT1,ZNUS, + 1 CHI,ZSIGF,DIFFX,DIFFY,DIFFZ,HFAC,IJJ,NJJ,SCAT) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Recover the existing macrolib data and store them in memory. +* +*Copyright: +* Copyright (C) 2007 Ecole Polytechnique de Montreal. +* +*Author(s): +* D. Sekki +* +*Parameters: input +* IPMAC pointer to the macrolib information. +* NMIX maximum number of material mixtures. +* NGRP number of energy groups. +* NL number of legendre orders (=1 for isotropic scattering). +* NDEL number of precursor groups for delayed neutron. +* +*Parameters: output +* NTOT0 flux-weighted total macroscopic x-sections. +* NTOT1 current-weighted total macroscopic x-sections. +* ZNUS nu*fission macroscopic x-sections. +* CHI fission spectra. +* ZSIGF fission macroscopic x-sections. +* DIFFX x-directed diffusion coefficients. +* DIFFY y-directed diffusion coefficients. +* DIFFZ z-directed diffusion coefficients. +* HFAC h-factors (kappa*fission macroscopic x-sections). +* IJJ highest energy number for which the scattering +* component to group g does not vanish. +* NJJ number of energy groups for which the scattering +* component does not vanish. +* SCAT scattering macroscopic x-sections. +* LEAK diffusion coefficient flag (=1: isotropic; =2: anisotropic). +* +*----------------------------------------------------------------------- +* + USE GANLIB +*---- +* SUBROUTINE ARGUMENTS +*---- + TYPE(C_PTR) IPMAC + INTEGER NMIX,NGRP,NL,NDEL,LEAK,IJJ(NMIX,NL,NGRP),NJJ(NMIX,NL,NGRP) + REAL NTOT0(NMIX,NGRP),NTOT1(NMIX,NGRP),ZSIGF(NMIX,NGRP), + 1 DIFFX(NMIX,NGRP),DIFFY(NMIX,NGRP),DIFFZ(NMIX,NGRP), + 2 ZNUS(NMIX,NGRP,NDEL+1),CHI(NMIX,NGRP,NDEL+1),HFAC(NMIX,NGRP), + 3 SCAT(NMIX,NL,NGRP,NGRP) +*---- +* LOCAL VARIABLES +*---- + CHARACTER CM*2,TEXT12*12 + PARAMETER(IOUT=6) + TYPE(C_PTR) JPMAC,KPMAC + REAL, ALLOCATABLE, DIMENSION(:) :: WORK +*---- +* SCRATCH STORAGE ALLOCATION +*---- + ALLOCATE(WORK(NMIX*NGRP)) +* + WORK(:NMIX*NGRP)=0.0 + NTOT0(:NMIX,:NGRP)=0.0 + NTOT1(:NMIX,:NGRP)=0.0 + ZSIGF(:NMIX,:NGRP)=0.0 + DIFFX(:NMIX,:NGRP)=0.0 + DIFFY(:NMIX,:NGRP)=0.0 + DIFFZ(:NMIX,:NGRP)=0.0 + ZNUS(:NMIX,:NGRP,:NDEL+1)=0.0 + CHI(:NMIX,:NGRP,:NDEL+1)=0.0 + HFAC(:NMIX,:NGRP)=0.0 + SCAT(:NMIX,:NL,:NGRP,:NGRP)=0.0 + DO 12 IGR=1,NGRP + DO 11 IBM=1,NMIX + DO 10 IL=1,NL + IJJ(IBM,IL,IGR)=IGR + NJJ(IBM,IL,IGR)=1 + 10 CONTINUE + 11 CONTINUE + 12 CONTINUE +*---- +* RECOVER THE EXISTING MACROLIB DATA +*---- + JPMAC=LCMGID(IPMAC,'GROUP') + DO 70 JGR=1,NGRP + KPMAC=LCMGIL(JPMAC,JGR) +* NTOT0 + CALL LCMLEN(KPMAC,'NTOT0',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'NTOT0',NTOT0(1,JGR)) + ELSEIF(LENGT.EQ.0)THEN + CALL XABORT('@NEWMGT: MISSING NTOT0 DATA IN MACROLIB.') + ELSE + CALL XABORT('@NEWMGT: INVALID NTOT0 DATA IN MACROLIB.') + ENDIF +* NTOT1 + CALL LCMLEN(KPMAC,'NTOT1',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'NTOT1',NTOT1(1,JGR)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID NTOT1 DATA IN MACROLIB.') + ENDIF +* NUSIGF + CALL LCMLEN(KPMAC,'NUSIGF',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'NUSIGF',ZNUS(1,JGR,1)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID NUSIGF DATA IN MACROLIB.') + ENDIF + DO IDEL=1,NDEL + WRITE(TEXT12,'(6HNUSIGF,I2.2)') IDEL + CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,TEXT12,ZNUS(1,JGR,IDEL+1)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID '//TEXT12//' DATA IN MACROLIB.') + ENDIF + ENDDO +* CHI + CALL LCMLEN(KPMAC,'CHI',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'CHI',CHI(1,JGR,1)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID CHI DATA IN MACROLIB.') + ENDIF + DO IDEL=1,NDEL + WRITE(TEXT12,'(3HCHI,I2.2)') IDEL + CALL LCMLEN(KPMAC,TEXT12,LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,TEXT12,CHI(1,JGR,IDEL+1)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID '//TEXT12//' DATA IN MACROLIB.') + ENDIF + ENDDO +* NFTOT + CALL LCMLEN(KPMAC,'NFTOT',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'NFTOT',ZSIGF(1,JGR)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID NFTOT DATA IN MACROLIB.') + ENDIF +* DIFF + CALL LCMLEN(KPMAC,'DIFF',LENGT,ITYLCM) + IF(LENGT.EQ.0)GOTO 20 + IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFF DATA.') + CALL LCMGET(KPMAC,'DIFF',DIFFX(1,JGR)) + LEAK=1 + GOTO 30 +* DIFFX + 20 CALL LCMLEN(KPMAC,'DIFFX',LENGT,ITYLCM) + IF(LENGT.EQ.0)GO TO 30 + IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFX DATA.') + CALL LCMGET(KPMAC,'DIFFX',DIFFX(1,JGR)) +* DIFFY + CALL LCMLEN(KPMAC,'DIFFY',LENGT,ITYLCM) + IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFY DATA.') + CALL LCMGET(KPMAC,'DIFFY',DIFFY(1,JGR)) +* DIFFZ + CALL LCMLEN(KPMAC,'DIFFZ',LENGT,ITYLCM) + IF(LENGT.NE.NMIX)CALL XABORT('@NEWMGT: INVALID DIFFZ DATA.') + CALL LCMGET(KPMAC,'DIFFZ',DIFFZ(1,JGR)) + LEAK=2 +* H-FACTOR + 30 CALL LCMLEN(KPMAC,'H-FACTOR',LENGT,ITYLCM) + IF(LENGT.EQ.NMIX)THEN + CALL LCMGET(KPMAC,'H-FACTOR',HFAC(1,JGR)) + ELSEIF(LENGT.NE.0)THEN + CALL XABORT('@NEWMGT: INVALID H-FACTOR DATA IN MACROLIB.') + ENDIF +* SCAT,NJJ,IJJ + DO IL=1,NL + WRITE (CM,'(I2.2)') IL-1 + CALL LCMLEN(KPMAC,'SCAT'//CM,LENGT,ITYLCM) + IF(LENGT.GT.NMIX*NL*NGRP*NGRP)THEN + CALL XABORT('@NEWMGT: INVALID INPUT MACROLIB(1).') + ELSEIF(LENGT.GT.0)THEN + CALL LCMGET(KPMAC,'SCAT'//CM,WORK) + CALL LCMGET(KPMAC,'NJJS'//CM,NJJ(1,IL,JGR)) + CALL LCMGET(KPMAC,'IJJS'//CM,IJJ(1,IL,JGR)) + IPOSDE=0 + DO 65 IBM=1,NMIX + IJJ0=IJJ(IBM,IL,JGR) + DO 60 IGR=IJJ0,IJJ0-NJJ(IBM,IL,JGR)+1,-1 + IPOSDE=IPOSDE+1 + SCAT(IBM,IL,IGR,JGR)=WORK(IPOSDE) + 60 CONTINUE + 65 CONTINUE + ELSE + CALL XABORT('@NEWMGT: OLD FORMAT OF THE MACROLIB.') + ENDIF + ENDDO + 70 CONTINUE +*---- +* SCRATCH STORAGE DEALLOCATION +*---- + DEALLOCATE(WORK) + RETURN + END |