summaryrefslogtreecommitdiff
path: root/Dragon/src/FMAC.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/FMAC.f')
-rw-r--r--Dragon/src/FMAC.f259
1 files changed, 259 insertions, 0 deletions
diff --git a/Dragon/src/FMAC.f b/Dragon/src/FMAC.f
new file mode 100644
index 0000000..40c6723
--- /dev/null
+++ b/Dragon/src/FMAC.f
@@ -0,0 +1,259 @@
+*DECK FMAC
+ SUBROUTINE FMAC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Convert a macroscopic cross section file in ascii FMAC-M format
+* towards Version5 macrolib format.
+*
+*Copyright:
+* Copyright (C) 2020 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/output
+* NENTRY number of LCM objects or files used by the operator.
+* HENTRY name of each LCM object or file:
+* HENTRY(1) create type(L_MACROLIB);
+* HENTRY(2) read-only ascii file containing FMAC-M data.
+* IENTRY type of each LCM object or file:
+* =1 LCM memory object; =2 XSM file; =3 sequential binary file;
+* =4 sequential ascii file.
+* JENTRY access of each LCM object or file:
+* =0 the LCM object or file is created;
+* =1 the LCM object or file is open for modifications;
+* =2 the LCM object or file is open in read-only mode.
+* KENTRY LCM object address or file unit number.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
+ TYPE(C_PTR) KENTRY(NENTRY)
+ CHARACTER HENTRY(NENTRY)*12
+*----
+* LOCAL VARIABLES
+*----
+ TYPE(C_PTR) IPMACR
+ PARAMETER(NSTATE=40,IOUT=6,MAS=38)
+ CHARACTER TEXT12*12,TEXT18*18,HSIGN*12,TEX(50)*6,HPART*1
+ INTEGER ISTATE(NSTATE),N(MAS),IZA(40)
+ DOUBLE PRECISION DFLOTT
+*----
+* ALLOCATABLE ARRAYS
+*----
+ INTEGER, ALLOCATABLE, DIMENSION(:) :: NGPRT,NPMIN,NPMAX,NANIS,
+ 1 MUFIS
+ INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NWA
+ REAL, ALLOCATABLE, DIMENSION(:,:) :: H2
+ CHARACTER(LEN=1), ALLOCATABLE, DIMENSION(:) :: HNPRT
+*----
+* PARAMETER VALIDATION
+*----
+ IF(NENTRY.NE.2) CALL XABORT('FMAC: TWO PARAMETERS EXPECTED.')
+ IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('FMAC: LCM'
+ 1 //' OBJECT EXPECTED AT LHS.')
+ IF(JENTRY(1).NE.0) CALL XABORT('FMAC: ENTRY IN CREATE MODE EXPEC'
+ 1 //'TED.')
+ IPMACR=KENTRY(1)
+ HSIGN='L_MACROLIB'
+ CALL LCMPTC(IPMACR,'SIGNATURE',12,HSIGN)
+*----
+* RECOVER FMAC-M FILE
+*----
+ TEXT12=HENTRY(2)
+ IF(IENTRY(2).NE.4) CALL XABORT('FMAC: ASCII FILE NAMED '//TEXT12
+ 1 //' EXPECTED AT LHS.')
+ IF(JENTRY(2).NE.2) CALL XABORT('FMAC: ASCII FILE IN READ-ONLY MO'
+ 1 //'DE EXPECTED.')
+ LIN=FILUNIT(KENTRY(2))
+*----
+* READ THE INPUT DATA
+*----
+ IMPX=1
+ HPART=' '
+ 10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT)
+ IF(INDIC.NE.3) CALL XABORT('FMAC: CHARACTER DATA EXPECTED.')
+ IF(TEXT12.EQ.'EDIT') THEN
+* READ THE PRINT INDEX.
+ CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT)
+ IF(INDIC.NE.1) CALL XABORT('FMAC: INTEGER DATA EXPECTED.')
+ ELSE IF(TEXT12.EQ.'PARTICLE') THEN
+* READ THE PARTICLE TYPE ('N', 'G', 'C', 'P')
+ CALL REDGET(INDIC,NITMA,FLOTT,HPART,DFLOTT)
+ IF(INDIC.NE.3) CALL XABORT('FMAC: CHARACTER DATA EXPECTED.')
+ CALL LCMPTC(IPMACR,'PARTICLE',1,HPART)
+ ELSE IF(TEXT12.EQ.';') THEN
+ GO TO 20
+ ELSE
+ CALL XABORT('FMAC: '//TEXT12//' IS AN INVALID KEYWORD.')
+ ENDIF
+ GO TO 10
+*----
+* MACROLIB INITIALIZATION
+*----
+ 20 IPART=0
+ NANISO=0
+ ITRANC=0
+ NALBP=0
+ NSTEP=0
+ IDF=0
+*----
+* PROCESS THE FMAC FILE FOR 1D COUPLED CROSS-SECTION DATA
+*----
+ READ(LIN,'(A18,I12)') TEXT18,IVERS
+ IF(IMPX.GT.0) WRITE(IOUT,1002) TEXT18,IVERS
+ READ(LIN,'(A72)')
+ READ(LIN,'(A30)')
+ READ(LIN,'(6I12)') NTYPE,(N(I),I=1,9)
+ READ(LIN,'(12A6)')(TEX(I),I=1,NTYPE)
+ IF(TEX(1).NE.'NGCAP ') THEN
+ CALL XABORT('FMAC: INVALID DATA TYPE='//TEX(1)//'.')
+ ENDIF
+ READ(LIN,'(6I12)') (IZA(I),I=1,40)
+ WRITE(IOUT,1101) (IZA(I),I=1,40)
+ NGP=IZA(1)
+ NPART=IZA(2)
+ NGXI=IZA(3)
+ NGXIF=IZA(4)
+ NDELG=IZA(5)
+ NEDIT=IZA(8)
+ KLEIN=IZA(10)
+ IADJ=IZA(12)
+ NUCL=IZA(13)
+ NK=IZA(15)
+ NUFIS=IZA(16)
+ MASM3=IZA(17)
+ NWO=IZA(20)
+ MPOINT=IZA(21)
+ ALLOCATE(NGPRT(NPART),HNPRT(NPART),NPMIN(NGP),NPMAX(NGP),
+ 1 NANIS(NGP),MUFIS(NUFIS))
+ NPMIN=1
+ NPMAX=NGP
+ NANIS=NWO
+ IF(MASM3.GT.38) CALL XABORT('FMAC: MASM3 OVERFLOW.')
+ READ(LIN,'(6I12)')(N(I),I=1,MASM3)
+ CALL FMAC01(IPMACR,IMPX,HPART,LIN,IVERS,NGP,NPART,NGXI,NEDIT,
+ 1 NUCL,NK,NUFIS,MASM3,N,NGPRT,HNPRT,NPMIN,NPMAX,NANIS,MUFIS)
+*----
+* PROCESS SCATTERING INFORMATION
+*----
+ DO I=1,NPART
+ IF(HNPRT(I).EQ.HPART) THEN
+ IPART=I
+ GO TO 30
+ ENDIF
+ ENDDO
+ CALL XABORT('FMAC: PARTICLE '//HPART//' NOT AVAILABLE IN FMAC-M '
+ 1 //'FILE.')
+ 30 IF(IPART.EQ.0) CALL XABORT('FMAC: PARTICLE TYPE NOT DEFINED.')
+ IG1=1
+ DO I=1,IPART-1
+ IG1=IG1+NGPRT(I)
+ ENDDO
+ IG2=IG1+NGPRT(IPART)-1
+ DO IG=IG1,IG2
+ NANISO=MAX(NANISO,NANIS(IG))
+ ENDDO
+ DO IG=1,NGP
+ MAXLEN=2*(NANISO+1)*NK
+ ALLOCATE(H2(NGP,MAXLEN),NWA(NGP,NK))
+ H2(:NGP,:MAXLEN)=0.0
+ NWA(:NGP,:NK)=0
+ DO NP=NPMIN(IG),NPMAX(IG)
+ READ(LIN,'(6I12)') NPP,NQQ,(NWA(NPP,I),I=1,NK),LENGTH
+ IF(LENGTH.GT.MAXLEN) CALL XABORT('FMAC: MAXLEN OVERFLOW.')
+ READ(LIN,'(6E12.0)') (H2(NPP,J),J=1,LENGTH)
+ ENDDO
+ IF((IG.GE.IG1).AND.(IG.LE.IG2)) THEN
+ CALL FMAC03(IPMACR,IG,IPART,NGP,MAXLEN,NANISO,NK,NPART,HNPRT,
+ 1 NGPRT,NWA,H2)
+ ENDIF
+ DEALLOCATE(NWA,H2)
+ ENDDO
+*----
+* WRITE THE STATE VECTOR AND EXIT
+*----
+ ISTATE(:NSTATE)=0
+ ISTATE(1)=NGPRT(IPART)
+ ISTATE(2)=NK
+ ISTATE(3)=NANISO
+ ISTATE(4)=NUFIS
+ ISTATE(5)=0
+ ISTATE(6)=ITRANC
+ ISTATE(7)=NDELG
+ ISTATE(8)=NALBP
+ ISTATE(11)=NSTEP
+ ISTATE(12)=IDF
+ ISTATE(13)=IADJ
+ ISTATE(17)=NPART-1
+ CALL LCMPUT(IPMACR,'STATE-VECTOR',NSTATE,1,ISTATE)
+ IF(IMPX.GT.1) CALL LCMLIB(IPMACR)
+ IF(IMPX.GT.0) THEN
+ WRITE(IOUT,1010) IMPX,(ISTATE(I),I=1,7),ISTATE(9),ISTATE(11),
+ 1 ISTATE(12),ISTATE(13),ISTATE(17),HPART
+ WRITE(IOUT,1020) (HNPRT(I),I=1,NPART)
+ WRITE(IOUT,1030) (NGPRT(I),I=1,NPART)
+ ENDIF
+ DEALLOCATE(MUFIS,NANIS,NPMAX,NPMIN,HNPRT,NGPRT)
+ RETURN
+*
+ 1101 FORMAT(1X,'NG =',I3,' number of energy groups;',/
+ +,1X,'NPART =',I3,' number of particle types;',/
+ +,1X,'NGXI =',I3,' number of groups with non-zero fission spectr
+ +um;',/
+ +,1X,'NGXIF =',I3,' number of the first group with non-zero fissi
+ +on spectrum;',/
+ +,1X,'NGRET =',I3,' number of delayed neutron groups;',/
+ +,1X,'NGXIR =',I3,' number of groups with non-zero fission spectr
+ +um for delayed neutrons;',/
+ +,1X,'NGXIFR=',I3,' number of the first group with non-zero fissi
+ +on spectrum for delayed neutrons;',/
+ +,1X,'NEDIT =',I3,' number of additional edit cross-sections;'
+ +,/
+ +,1X,'MAXGS =',I3,' not used;',/
+ +,1X,'KLEIN =',I3,' not used;',/
+ +,1X,'NGHIGH=',I3,' total number of groups of cascade region;',/
+ +,1X,'IADJ =',I3,' 0/1 - regular/adjoint cross-section file;',/
+ +,1X,'NUCL =',I3,' number of nuclides;',/
+ +,1X,'NUCLF =',I3,' number of fission nuclides;',/
+ +,1X,'MIX =',I3,' number of materials (compositions);',/
+ +,1X,'NUFIS =',I3,' number of fission materials;',/
+ +,1X,'MAS =',I3,' length of integer control array LL(MAS);',/
+ +,1X,'KIN=',I6,' total number of scattering transitions (not used
+ +);',/
+ +,1X,'MX =',I3,' maximal length of transition array (not used)
+ +;',/
+ +,1X,'MNW =',I3,' order of PL approximation used +1;',/
+ +,1X,'MPOINT=',I3,' order of discrete approximation of scattering
+ + indicatrix (number of angular scattering cosine points used);',/
+ +,1X,'NUMD(I)=',19I3,' not used')
+ 1002 FORMAT(1X,A18/' FMAC: Format FMAC-M version =',I2)
+ 1010 FORMAT(/8H OPTIONS/8H -------/
+ 1 7H IMPX ,I6,30H (0=NO PRINT/1=SHORT/2=MORE)/
+ 2 7H NGROUP,I6,28H (NUMBER OF ENERGY GROUPS)/
+ 3 7H NBMIX ,I6,39H (NUMBER OF MIXTURES IN THE MACROLIB)/
+ 4 7H NANISO,I6,34H (MAXIMUM SCATTERING ANISOTROPY)/
+ 5 7H NIFISS,I6,45H (MAXIMUM NUMBER OF FISSILE ISOTOPES IN A M,
+ 6 7HIXTURE)/
+ 7 7H NEDMAC,I6,34H (NUMBER OF CROSS SECTION EDITS)/
+ 8 7H ITRANC,I6,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2,
+ 9 43H=RECOVER FROM LIBRARY/4=LEAKAGE CORRECTION)/
+ 1 7H NLG ,I6,39H (NUMBER OF DELAYED PRECURSOR GROUPS)/
+ 2 7H ILEAK ,I6,40H (1=DIFF AVAILABLE; 2=DIFFX AVAILABLE)/
+ 3 7H NSTEP ,I6,39H (NUMBER OF PERTURBATION DIRECTORIES)/
+ 4 7H IDF ,I6,48H (=0/2 BOUNDARY FLUXES FOR ADF ABSENT/PRESENT)/
+ 5 7H IADJ ,I6,33H (=0/1 DIRECT/ADJOINT MACROLIB)/
+ 6 7H NPART0,I6,34H (NUMBER OF COMPANION PARTICLES)/
+ 7 6H HPART ,A7,22H (MACROLIB PARTICLE))
+ 1020 FORMAT(/22H PARTICLE NAMES:,10A8)
+ 1030 FORMAT(22H NB. OF ENERGY GROUPS:,10I8)
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:33:29 +0000