diff options
| author | HEBERT Alain <alain.hebert@polymtl.ca> | 2025-12-23 11:34:01 -0500 |
|---|---|---|
| committer | HEBERT Alain <alain.hebert@polymtl.ca> | 2025-12-23 11:34:01 -0500 |
| commit | bd7171d346ad4f079aa89b2d9fdd6a56aa0a3b1c (patch) | |
| tree | ff7bea851c1ce9685d26fc5080f65fcf9110086b /Donjon/src/FPSOUT.f | |
| parent | 0fbdc50700be08e00ecad828d9c99b5c045b382b (diff) | |
Resolve "Depreciate use of Version 4 and 5.0 Draglibs"
Diffstat (limited to 'Donjon/src/FPSOUT.f')
| -rw-r--r-- | Donjon/src/FPSOUT.f | 150 |
1 files changed, 0 insertions, 150 deletions
diff --git a/Donjon/src/FPSOUT.f b/Donjon/src/FPSOUT.f deleted file mode 100644 index 5d78203..0000000 --- a/Donjon/src/FPSOUT.f +++ /dev/null @@ -1,150 +0,0 @@ -*DECK FPSOUT - SUBROUTINE FPSOUT(IPMAC,IPRINT,NG,NMIL,NFIS,ILEAKS,TEXT9,OUTG) -* -*----------------------------------------------------------------------- -* -*Purpose: -* Compute the leakage rate in each energy group -* -*Copyright: -* Copyright (C) 2019 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 -* IPMAC pointer to the macrolib structure. -* IPRINT print parameter -* NG number of energy groups. -* NMIL number of material mixtures. -* NFIS number of fissile isotopes. -* ILEAKS type of leakage calculation =0: no leakage; =1: homogeneous -* leakage (Diffon). -* TEXT9 type of calculation ('REFERENCE' or 'MACRO'). -* -*Parameters: output -* OUTG leakage rates. -* -*----------------------------------------------------------------------- -* - USE GANLIB -*---- -* SUBROUTINE ARGUMENTS -*---- - TYPE(C_PTR) IPMAC - INTEGER IPRINT,NG,NMIL,NFIS,ILEAKS - CHARACTER TEXT9*9 - REAL OUTG(NG) -*---- -* LOCAL VARIABLES -*---- - TYPE(C_PTR) JPMAC,KPMAC - CHARACTER HSMG*131 -*---- -* ALLOCATABLE ARRAYS -*---- - INTEGER, ALLOCATABLE, DIMENSION(:) :: IJJ,NJJ,IPOS - REAL, ALLOCATABLE, DIMENSION(:) :: GAR,WORK,DIFHOM,DIFF - REAL, ALLOCATABLE, DIMENSION(:,:) :: PHI,NUF - REAL, ALLOCATABLE, DIMENSION(:,:,:) :: CHI,RHS,LHS -*---- -* SCRATCH STORAGE ALLOCATION -*---- - ALLOCATE(PHI(NMIL,NG),RHS(NMIL,NG,NG),LHS(NMIL,NG,NG)) - ALLOCATE(IJJ(NMIL),NJJ(NMIL),IPOS(NMIL),GAR(NMIL),WORK(NMIL*NG), - > CHI(NMIL,NFIS,NG),NUF(NMIL,NFIS),DIFHOM(NG),DIFF(NMIL)) -*---- -* COMPUTE THE ACTUAL AND REFERENCE REACTION RATE MATRICES -*---- - CALL LCMGET(IPMAC,'K-EFFECTIVE',ZKEFF) - IF(IPRINT.GT.1) WRITE(6,120) TEXT9,ZKEFF - CALL LCMLEN(IPMAC,'B2 B1HOM',ILCMLN,ITYLCM) - IF(ILCMLN.EQ.1) THEN - CALL LCMGET(IPMAC,'B2 B1HOM',B2) - ELSE - B2=0.0 - ENDIF - IF((ILEAKS.EQ.1).AND.(IPRINT.GT.1)) THEN - WRITE(6,'(/9H FPSOUT: ,A,4H B2=,1P,E12.4)') TEXT9,B2 - ENDIF - RHS(:NMIL,:NG,:NG)=0.0 - LHS(:NMIL,:NG,:NG)=0.0 - JPMAC=LCMGID(IPMAC,'GROUP') - DO IG=1,NG - KPMAC=LCMGIL(JPMAC,IG) - CALL LCMGET(KPMAC,'CHI',CHI(1,1,IG)) - CALL LCMLEN(KPMAC,'FLUX-INTG',ILG,ITYLCM) - IF(ILG.NE.NMIL) CALL XABORT('FPSOUT: MISSING REFERENCE FLUX.') - CALL LCMGET(KPMAC,'FLUX-INTG',PHI(1,IG)) - ENDDO - DO IG=1,NG - KPMAC=LCMGIL(JPMAC,IG) - IF(ILEAKS.EQ.1) THEN - CALL LCMLEN(KPMAC,'DIFF',ILCMLN,ITYLCM) - IF(ILCMLN.GT.0) THEN - CALL LCMGET(KPMAC,'DIFF',DIFF) - ELSE - CALL LCMGET(IPMAC,'DIFHOMB1HOM',DIFHOM) - DO IBM=1,NMIL - DIFF(IBM)=DIFHOM(IG) - ENDDO - ENDIF - ELSE - DIFF(:NMIL)=0.0 - ENDIF - CALL LCMGET(KPMAC,'NTOT0',GAR) - CALL LCMGET(KPMAC,'SCAT00',WORK) - CALL LCMGET(KPMAC,'NJJS00',NJJ) - CALL LCMGET(KPMAC,'IJJS00',IJJ) - CALL LCMGET(KPMAC,'IPOS00',IPOS) - DO IBM=1,NMIL - IPOSDE=IPOS(IBM) - DO JG=IJJ(IBM),IJJ(IBM)-NJJ(IBM)+1,-1 -* IG <-- JG - RHS(IBM,IG,JG)=RHS(IBM,IG,JG)-WORK(IPOSDE)*PHI(IBM,JG) - IPOSDE=IPOSDE+1 - ENDDO - RHS(IBM,IG,IG)=RHS(IBM,IG,IG)+(GAR(IBM)+B2*DIFF(IBM))* - > PHI(IBM,IG) - ENDDO - CALL LCMGET(KPMAC,'NUSIGF',NUF) - DO IBM=1,NMIL - DO IFIS=1,NFIS - DO JG=1,NG - LHS(IBM,JG,IG)=LHS(IBM,JG,IG)+CHI(IBM,IFIS,JG)* - > NUF(IBM,IFIS)*PHI(IBM,IG) - ENDDO - ENDDO - ENDDO - ENDDO -*---- -* COMPUTE THE ACTUAL AND REFERENCE ABSORPTION AND FISSION RATES -*---- - DO IG=1,NG - OUTG(IG)=0.0 - DO IBM=1,NMIL - OUTG(IG)=OUTG(IG)+SUM(LHS(IBM,IG,:NG))/ZKEFF- - 1 SUM(RHS(IBM,IG,:NG)) - ENDDO - IF(OUTG(IG).LT.-1.0E-6) THEN - WRITE(HSMG,'(21HFPSOUT: INCONSISTENT ,A,17H LEAKAGE IN GROUP, - 1 I4,7H. LEAK=,1P,E13.4)') TEXT9,IG,OUTG(IG) - CALL XABORT(HSMG) - ENDIF - IF(IPRINT.GT.1) WRITE(6,130) IG,TEXT9,OUTG(IG) - ENDDO -*---- -* SCRATCH STORAGE DEALLOCATION -*---- - DEALLOCATE(DIFF,DIFHOM,NUF,CHI,WORK,GAR,IPOS,NJJ,IJJ) - DEALLOCATE(LHS,RHS,PHI) - RETURN -* - 120 FORMAT(/9H FPSOUT: ,A,33H EFFECTIVE MULTIPLICATION FACTOR=,1P, - 1 E12.4) - 130 FORMAT(/8H FPSOUT:,5X,6HGROUP=,I4,1X,A,9H LEAKAGE=,1P,E12.4) - END |
