*DECK S2M SUBROUTINE S2M(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * To recover information from a SERPENT output file and translate the * requested data towards a macrolib. * *Copyright: * Copyright (C) 2014 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 or modification ascii file containing * Apotrim data; * HENTRY(2) read-only type(L_MACROLIB). * 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) IPMAC,JPMAC,KPMAC PARAMETER (NSTATE=40,IOUT=6) CHARACTER TEXT12*12,HSIGN*12,HLINE*512,CM*2 LOGICAL LB1,LFIS DOUBLE PRECISION DFLOTT INTEGER ISTATE(NSTATE) PARAMETER(CM='00') *---- * ALLOCATABLE ARRAYS *---- REAL, ALLOCATABLE, DIMENSION(:) :: XS,FLUX,FISS,CHI,DIFF,GAR3 REAL, ALLOCATABLE, DIMENSION(:,:) :: SCAT * IF(NENTRY.LE.1) CALL XABORT('S2M: MINIMUM OF 2 OBJECTS EXPECTED.') TEXT12=HENTRY(1) IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.4)) CALL XABORT('S2M: LCM ' 1 //'OBJECT EXPECTED AT LHS.') IF(JENTRY(1).EQ.2) CALL XABORT('S2M: LCM OBJECT IN CREATE OR MOD' 1 //'IFICATION MODE EXPECTED AT LHS.') IPMAC=KENTRY(1) IF(IENTRY(2).NE.4) CALL XABORT('S2M: ASCII FILE NAMED '//TEXT12 1 //' EXPECTED AT RHS.') IF(JENTRY(2).NE.2) CALL XABORT('S2M: ASCII FILE IN READ-ONLY MOD' 1 //'E EXPECTED AT RHS.') IFIN=FILUNIT(KENTRY(2)) HSIGN='L_MACROLIB' CALL LCMPTC(IPMAC,'SIGNATURE',12,HSIGN) *---- * READ THE INPUT DATA *---- IMPX=1 IDX=1 NGRP=0 LB1=.FALSE. 20 CALL REDGET(INDIC,NITMA,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.3) CALL XABORT('S2M: CHARACTER DATA EXPECTED(1).') IF(TEXT12.EQ.'EDIT') THEN * READ THE PRINT INDEX. CALL REDGET(INDIC,IMPX,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1) CALL XABORT('S2M: INTEGER DATA EXPECTED(1).') ELSE IF(TEXT12.EQ.'IDX') THEN * READ THE INSTANCE INDEX. CALL REDGET(INDIC,IDX,FLOTT,TEXT12,DFLOTT) IF(INDIC.NE.1) CALL XABORT('S2M: INTEGER DATA EXPECTED(2).') IF(IDX.LE.0) CALL XABORT('S2M: INVALID VALUE OF IDX.') ELSE IF(TEXT12.EQ.'B1') THEN LB1=.TRUE. ELSE IF(TEXT12.EQ.';') THEN GO TO 30 ELSE CALL XABORT('S2M: '//TEXT12//' IS AN INVALID KEYWORD.') ENDIF GO TO 20 *---- * FIND THE NUMBER OF ENERGY GROUPS *---- 30 DO READ(IFIN,'(A)',END=40) HLINE IND1=INDEX(HLINE,'GC_NE (idx, 1)') IF(IND1.GT.0) THEN IND2=INDEX(HLINE,';') READ(HLINE(45:IND2-1),'(I5)') NGRP GO TO 50 ENDIF ENDDO 40 CALL XABORT('S2M: UNABLE TO FING NUMBER OF ENERGY GROUPS.') 50 IF(IMPX.GT.0) WRITE(IOUT,100) NGRP *---- * DETERMINE IF THE ISOTOPE IS FISSILE *---- LFIS=.FALSE. DO READ(IFIN,'(A)',END=40) HLINE IND1=INDEX(HLINE,'CHI') IF(IND1.GT.0) THEN LFIS=.TRUE. GO TO 60 ENDIF ENDDO 60 IF(IMPX.GT.0) WRITE(IOUT,110) LFIS *---- * RECOVER CROSS SECTIONS *---- ALLOCATE(XS(NGRP+1),FLUX(NGRP+1),CHI(NGRP),FISS(NGRP+1), > SCAT(NGRP,NGRP),DIFF(NGRP),GAR3(NGRP*NGRP)) CALL S2MGET(IFIN,'GC_BOUNDS',IDX,.FALSE.,NGRP+1,XS(1)) DO IGRP=1,NGRP+1 XS(IGRP)=XS(IGRP)*1.0E6 ENDDO CALL LCMPUT(IPMAC,'ENERGY',NGRP+1,2,XS) CALL S2MGET(IFIN,'TOTXS',IDX,.TRUE.,NGRP+1,XS(1)) CALL S2MGET(IFIN,'FLUX',IDX,.TRUE.,NGRP+1,FLUX(1)) CALL S2MGET(IFIN,'GTRANSFXS',IDX,.TRUE.,NGRP*NGRP,SCAT(1,1)) ! I -> J IF(LFIS) THEN CALL S2MGET(IFIN,'CHI ',IDX,.TRUE.,NGRP,CHI(1)) CALL S2MGET(IFIN,'NSF ',IDX,.TRUE.,NGRP+1,FISS(1)) ENDIF IF(LB1) THEN CALL S2MGET(IFIN,'B1_DIFFCOEF',IDX,.TRUE.,NGRP,DIFF(1)) ENDIF JPMAC=LCMLID(IPMAC,'GROUP',NGRP) DO IGRP=1,NGRP KPMAC=LCMDIL(JPMAC,IGRP) CALL LCMPUT(KPMAC,'NTOT0',1,2,XS(IGRP+1)) CALL LCMPUT(KPMAC,'NWT0',1,2,FLUX(IGRP+1)) IF(LFIS) THEN CALL LCMPUT(KPMAC,'CHI',1,2,CHI(IGRP)) CALL LCMPUT(KPMAC,'NUSIGF',1,2,FISS(IGRP+1)) ENDIF IF(LB1) THEN CALL LCMPUT(KPMAC,'DIFF',1,2,DIFF(IGRP)) ENDIF IPOSDE=0 IPOS=1 IGMIN=IGRP IGMAX=IGRP DO JGRP=1,NGRP IF(SCAT(JGRP,IGRP).NE.0.0) THEN IGMIN=MIN(IGMIN,JGRP) IGMAX=MAX(IGMAX,JGRP) ENDIF ENDDO IJJ=IGMAX NJJ=IGMAX-IGMIN+1 DO JGRP=IGMAX,IGMIN,-1 IPOSDE=IPOSDE+1 GAR3(IPOSDE)=SCAT(JGRP,IGRP) ENDDO CALL LCMPUT(KPMAC,'SCAT'//CM,IPOSDE,2,GAR3) CALL LCMPUT(KPMAC,'SIGW'//CM,1,2,SCAT(IGRP,IGRP)) CALL LCMPUT(KPMAC,'NJJS'//CM,1,1,NJJ) CALL LCMPUT(KPMAC,'IJJS'//CM,1,1,IJJ) CALL LCMPUT(KPMAC,'IPOS'//CM,1,1,IPOS) ENDDO ISTATE(:NSTATE)=0 ISTATE(1)=NGRP ISTATE(2)=1 ISTATE(3)=1 IF(LFIS) ISTATE(4)=1 CALL LCMPUT(IPMAC,'STATE-VECTOR',NSTATE,1,ISTATE) DEALLOCATE(GAR3,DIFF,SCAT,FISS,CHI,FLUX,XS) RETURN * 100 FORMAT(/30H S2M: NUMBER OF ENERGY GROUPS=,I5) 110 FORMAT(/19H S2M: FISSILE FLAG=,L1) END