*DECK AUTO SUBROUTINE AUTO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY) * *----------------------------------------------------------------------- * *Purpose: * UAutosecol self-shielding operator. * *Copyright: * Copyright (C) 2023 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) creation or modification type(L_LIBRARY) (no * subgroups); * HENTRY(2) read-only type(L_LIBRARY) (with subgroups); * HENTRY(3) read-only type(L_TRACK); * HENTRY(4) optional read-only sequential binary tracking file. * 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 *---- PARAMETER (NSTATE=40,MAXRSS=300,IOUT=6) TYPE(C_PTR) IPLI0,IPLIB,IPTRK CHARACTER TEXT4*4,HSIGN*12,TEXT8*8,TEXT12*12,HSMG*131,CDOOR*12, 1 TITR*72,HISOT*12 DOUBLE PRECISION DFLOTT LOGICAL LEAKSW,LDIL INTEGER IGP(NSTATE),IPAR(NSTATE),IPAS(NSTATE),IRSS(MAXRSS) *---- * ALLOCATABLE ARRAYS *---- REAL, ALLOCATABLE, DIMENSION(:) :: DIL CHARACTER(LEN=12), ALLOCATABLE, DIMENSION(:) :: HUSED *---- * PARAMETER VALIDATION. *---- IF(NENTRY.LE.2) CALL XABORT('AUTO: THREE PARAMETERS EXPECTED.') IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) CALL XABORT('AUTO: LI' 1 //'NKED LIST OR XSM FILE EXPECTED AT LHS.') IF((JENTRY(1).NE.0).AND.(JENTRY(1).NE.1)) CALL XABORT('AUTO: EN' 1 //'TRY IN CREATE OR MODIFICATION MODE EXPECTED.') IF((JENTRY(2).NE.2).OR.((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2))) 1 CALL XABORT('AUTO: LINKED LIST OR XSM FILE IN READ-ONLY MODE E' 2 //'XPECTED AT FIRST RHS.') IF((JENTRY(3).NE.2).OR.((IENTRY(3).NE.1).AND.(IENTRY(3).NE.2))) 1 CALL XABORT('AUTO: LINKED LIST OR XSM FILE IN READ-ONLY MODE E' 2 //'XPECTED AT SECOND RHS.') CALL LCMGTC(KENTRY(3),'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_TRACK') THEN TEXT12=HENTRY(3) CALL XABORT('AUTO: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_TRACK EXPECTED.') ENDIF CALL LCMGTC(KENTRY(3),'TRACK-TYPE',12,CDOOR) IPLI0=KENTRY(1) IPLIB=KENTRY(2) IPTRK=KENTRY(3) INDREC=0 IF(JENTRY(1).EQ.0) THEN INDREC=1 HSIGN='L_LIBRARY' CALL LCMPTC(IPLI0,'SIGNATURE',12,HSIGN) ELSE IF(JENTRY(1).EQ.1) THEN CALL LCMGTC(IPLI0,'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_LIBRARY') THEN TEXT12=HENTRY(1) CALL XABORT('AUTO: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_LIBRARY EXPECTED.') ENDIF INDREC=2 ENDIF *---- * RECOVER TABULATED FUNCTIONS. *---- CALL XDRTA2 *---- * RECOVER TRACKING FILE INFORMATION. *---- IFTRAK=0 IF(NENTRY.GE.4) THEN IF(IENTRY(4).EQ.3) THEN IF(JENTRY(4).NE.2) CALL XABORT('AUTO: BINARY TRACKING FILE NA' 1 //'MED '//TEXT12//' IS NOT IN REAL-ONLY MODE.') IFTRAK=FILUNIT(KENTRY(4)) ENDIF ENDIF *---- * RECOVER GENERAL TRACKING INFORMATION. *---- CALL LCMGET(IPTRK,'STATE-VECTOR',IGP) NREG=IGP(1) NUN=IGP(2) LEAKSW=IGP(3).EQ.0 CALL LCMLEN(IPTRK,'TITLE',LENGT,ITYLCM) IF(LENGT.GT.0) THEN CALL LCMGTC(IPTRK,'TITLE',72,TITR) ELSE TITR='*** NO TITLE PROVIDED ***' ENDIF *---- * RECOVER INTERNAL LIBRARY PARAMETERS. *---- CALL LCMGTC(IPLIB,'SIGNATURE',12,HSIGN) IF(HSIGN.NE.'L_LIBRARY') THEN TEXT12=HENTRY(2) CALL XABORT('AUTO: SIGNATURE OF '//TEXT12//' IS '//HSIGN// 1 '. L_LIBRARY EXPECTED.') ENDIF CALL LCMGET(IPLIB,'STATE-VECTOR',IPAR) NBISO=IPAR(2) NGRP=IPAR(3) NL=IPAR(4) ITRANC=IPAR(5) IGRMIN=IPAR(9)+1 IGRMAX=IPAR(10) NED=IPAR(13) NBMIX=IPAR(14) NRES=IPAR(15) NDEL=IPAR(19) IF(IGP(4).GT.NBMIX) THEN WRITE(HSMG,'(45HAUTO: THE NUMBER OF MIXTURES IN THE TRACKING , 1 1H(,I5,51H) IS GREATER THAN THE NUMBER OF MIXTURES IN THE INT, 2 15HERNAL LIBRARY (,I5,2H).)') IGP(4),NBMIX CALL XABORT(HSMG) ENDIF IF(INDREC.EQ.2) THEN CALL LCMGET(IPLI0,'STATE-VECTOR',IPAR) IF(IPAR(2).NE.NBISO) CALL XABORT('AUTO: INVALID LIBRARY.') ENDIF ALLOCATE(DIL(NBISO),HUSED(NBISO)) DIL(:NBISO)=0.0 CALL LCMGTC(IPLIB,'ISOTOPESUSED',12,NBISO,HUSED) * IMPX=1 LDIL=.FALSE. CALL LCMLEN(IPLI0,'SHIBA_SG',LENLCM,ITYLCM) IF(LENLCM.NE.0) THEN CALL LCMSIX(IPLI0,'SHIBA_SG',1) CALL LCMGET(IPLI0,'STATE-VECTOR',IPAS) CALL LCMSIX(IPLI0,' ',2) IGRMIN=IPAS(1) IGRMAX=IPAS(2) KSPH=IPAS(3) ITRANZ=IPAS(4) NPASS=IPAS(5) IPHASE=IPAS(6) ICALC=IPAS(8) IALTER=IPAS(11) MAXTRA=IPAS(12) ISEED=IPAS(14) ELSE KSPH=1 ITRANZ=ITRANC NPASS=1 IF(CDOOR.EQ.'SYBIL') THEN IPHASE=2 ELSE IF(CDOOR.EQ.'EXCELL') THEN IPHASE=2 ELSE IPHASE=1 ENDIF ICALC=0 IALTER=0 MAXTRA=10000 ISEED=0 ENDIF * 10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT) IF(INDIC.EQ.10) GO TO 70 IF(INDIC.NE.3) CALL XABORT('AUTO: CHARACTER DATA EXPECTED(1).') IF(TEXT4.EQ.'EDIT') THEN CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(1).') ELSE IF(TEXT4.EQ.'GRMI') THEN CALL REDGET(ITYPLU,IGRMIN,FLOTT,TEXT4,DFLOTT) IF(ITYPLU.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(2).') ELSE IF(TEXT4.EQ.'GRMA') THEN CALL REDGET(ITYPLU,IGRMAX,FLOTT,TEXT4,DFLOTT) IF(ITYPLU.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(3).') IF(IGRMAX.GT.NGRP) THEN CALL XABORT('AUTO: ILLEGAL NUMBER OF GROUP IN LIBRARY.') ENDIF ELSE IF(TEXT4.EQ.'NOSP') THEN KSPH=0 ELSE IF(TEXT4.EQ.'SPH') THEN KSPH=1 ELSE IF(TEXT4.EQ.'NOTR') THEN ITRANZ=0 ELSE IF(TEXT4.EQ.'TRAN') THEN ITRANZ=1 ELSE IF(TEXT4.EQ.'PASS') THEN CALL REDGET(ITYPLU,NPASS,FLOTT,TEXT4,DFLOTT) IF(ITYPLU.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(5).') IF(NPASS.LE.0) CALL XABORT('AUTO: POSITIVE PASS EXPECTED.') ELSE IF(TEXT4.EQ.'ARM') THEN IPHASE=1 ELSE IF(TEXT4.EQ.'PIJ') THEN IPHASE=2 ELSE IF(TEXT4.EQ.'CALC') THEN ICALC=1 CALL LCMSIX(IPLI0,'SHIBA_SG',1) CALL LCMSIX(IPLI0,'-DATA-CALC-',1) CALL REDGET(ITYPLU,NITMA,FLOTT,TEXT12,DFLOTT) IF(ITYPLU.NE.3) CALL XABORT('AUTO: CHARACTER DATA EXPECTED.') 40 IF(TEXT12.EQ.'ENDC') THEN CALL LCMSIX(IPLI0,' ',2) CALL LCMSIX(IPLI0,' ',2) GO TO 10 ENDIF IF(TEXT12.NE.'REGI') CALL XABORT('AUTO: REGI KWORD EXPECTED.') CALL REDGET(ITYPLU,NITMA,FLOTT,TEXT12,DFLOTT) IF(ITYPLU.NE.3) CALL XABORT('AUTO: CHARACTER DATA EXPECTED.') IF(TEXT12(5:).NE.' ') CALL XABORT('AUTO: 4-CHARACTER NAME EXPE' 1 //'CTED.') CALL LCMSIX(IPLI0,TEXT12(:4),1) CALL REDGET(ITYPLU,NITMA,FLOTT,TEXT12,DFLOTT) IF(ITYPLU.NE.3) CALL XABORT('AUTO: CHARACTER DATA EXPECTED.') 50 IF((TEXT12.EQ.'ENDC').OR.(TEXT12.EQ.'REGI')) THEN CALL LCMSIX(IPLI0,' ',2) GO TO 40 ENDIF HISOT=TEXT12 NRSS=0 60 CALL REDGET(ITYPLU,NITMA,FLOTT,TEXT12,DFLOTT) IF(ITYPLU.EQ.3) THEN IF(TEXT12.EQ.'ALL') THEN NRSS=1 IRSS(1)=-999 GO TO 60 ENDIF IF(NRSS.EQ.0) CALL XABORT('AUTO: INTEGER ARRAY EXPECTED.') CALL LCMPUT(IPLI0,HISOT,NRSS,1,IRSS) GO TO 50 ENDIF IF(ITYPLU.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(6).') NRSS=NRSS+1 IF(NRSS.GT.MAXRSS) CALL XABORT('AUTO: MAXRSS OVERFLOW.') IF((NITMA.LE.0).OR.(NITMA.GT.NBMIX)) THEN WRITE(HSMG,'(42HAUTO: REGI KEYWORD -- INVALID MIXTURE INDE, 1 2HX=,I5,1H.)') NITMA CALL XABORT(HSMG) ENDIF IRSS(NRSS)=NITMA GO TO 60 ELSE IF(TEXT4.EQ.'DILU') THEN CALL REDGET(ITYPLU,NITMA,FLOTT,TEXT8,DFLOTT) IF(ITYPLU.NE.3) CALL XABORT('AUTO: CHARACTER DATA EXPECTED.') LDIL=.FALSE. DO ISO=1,NBISO IF(TEXT8.EQ.HUSED(ISO)(:8)) THEN LDIL=.TRUE. CALL REDGET(ITYPLU,NITMA,DIL(ISO),TEXT12,DFLOTT) IF(ITYPLU.NE.2) CALL XABORT('AUTO: REAL DATA EXPECTED.') ENDIF ENDDO IF(.NOT.LDIL) THEN WRITE(HSMG,'(29HAUTO: CANNOT FIND ALIAS NAME=,A8,1H.)') TEXT8 CALL XABORT(HSMG) ENDIF ELSE IF(TEXT4.EQ.'KERN') THEN CALL REDGET(INDIC,IALTER,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(7).') ELSE IF(TEXT4.EQ.'MAXT') THEN CALL REDGET(INDIC,MAXTRA,FLOTT,TEXT4,DFLOTT) IF(INDIC.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(9).') ELSE IF(TEXT4.EQ.'SEED') THEN * INPUT A SEED INTEGER FOR THE UNRESOLVED ENERGY DOMAIN CALL REDGET(INDIC,ISEED,FLOTT,TEXT4,DFLOTT) IF (INDIC.NE.1) CALL XABORT('AUTO: INTEGER DATA EXPECTED(10).') ELSE IF(TEXT4.EQ.';') THEN GO TO 70 ELSE CALL XABORT('AUTO: '//TEXT4//' IS AN INVALID KEY WORD.') ENDIF GO TO 10 *---- * THE NUMBER OF UNKNOWNS OF A CURRENT-BASED MULTICELL ITERATION IS * INCREASED TO HOLD INTERFACE CURRENT COMPONENTS. *---- 70 IF(IPHASE.EQ.1) THEN IF(CDOOR.EQ.'SYBIL') NUN=NUN+IGP(9) IF((CDOOR.EQ.'EXCELL').AND.(IGP(7).EQ.5)) NUN=NUN+IGP(28) ENDIF *---- * CALL AUTO: DRIVER. *---- IF(IMPX.GT.0) THEN IF(INDREC.EQ.1) WRITE(IOUT,100) WRITE(IOUT,110) TITR,CDOOR(:9),IGRMIN,IGRMAX,KSPH,ITRANZ,NPASS, 1 IPHASE,ICALC,IALTER,MAXTRA,ISEED ENDIF IF(LDIL.AND.(IMPX.GT.0)) THEN DO ISO=1,NBISO IF(DIL(ISO).NE.0.0) THEN WRITE(6,'(/20H AUTO: SET DILUTION(,A12,2H)=,1P,E12.4,2h b)') 1 HUSED(ISO),DIL(ISO) ENDIF ENDDO ENDIF *---- * PERFORM SELF-SHIELDING. *---- IF(CDOOR.EQ.'MCCG') THEN CALL LCMLEN(IPTRK,'KEYFLX',LKFL,ITYLCM) NFUNL=LKFL/NREG ELSE NFUNL=1 ENDIF CALL AUTDRV(IPLI0,IPTRK,IPLIB,IFTRAK,INDREC,CDOOR,IMPX,IGRMIN, 1 IGRMAX,NGRP,NBMIX,NREG,NUN,NBISO,NL,NED,NDEL,LEAKSW,ITRANZ, 2 IPHASE,TITR,KSPH,NRES,NPASS,ICALC,IALTER,MAXTRA,ISEED,DIL, 3 DELI) IF(DELI.EQ.0.0) CALL XABORT('AUTO: LETHARGY WIDTH UNDEFINED.') DEALLOCATE(HUSED,DIL) *---- * STORE THE GENERAL SHELF-SHIELDING PARAMETERS. *---- IPAS(:NSTATE)=0 IPAS(1)=IGRMIN IPAS(2)=IGRMAX IPAS(3)=KSPH IPAS(4)=ITRANZ IPAS(5)=NPASS IPAS(6)=IPHASE IPAS(8)=ICALC IPAS(11)=IALTER IPAS(12)=MAXTRA IPAS(14)=ISEED CALL LCMSIX(IPLI0,'SHIBA_SG',1) CALL LCMPUT(IPLI0,'STATE-VECTOR',NSTATE,1,IPAS) CALL LCMSIX(IPLI0,' ',2) RETURN * 100 FORMAT(1H1,32H A UU UU TTTTTTTT OOOOO ,107(1H*)/ 1 34H AAA UU UU TTTTTTTT OOOOOOO ,63(1H*), 2 43H AUTOSECOL SELF-SHIELDING MODEL. A. HEBERT/ 3 33H AA AA UU UU TT OO OO/ 4 33H AA AA UU UU TT OO OO/ 5 33H AAAAAAA UU UU TT OO OO/ 6 33H AAAAAAA UU UU TT OO OO/ 7 33H AA AA UUUUUUU TT OOOOOOO/ 8 32H AA AA UUUUU TT OOOOO/) 110 FORMAT(/1X,A72//8H OPTIONS/8H -------/ 1 7H CDOOR ,A9,30H (NAME OF THE SOLUTION DOOR)/ 2 7H IGRMIN,I9,27H (FIRST GROUP TO PROCESS)/ 3 7H IGRMAX,I9,34H (MOST THERMAL GROUP TO PROCESS)/ 4 7H KSPH ,I9,47H (=0: NO SPH CORRECTION; =1: SPH CORRECTION I, 5 19HN RESONANT REGIONS)/ 6 7H ITRANZ,I9,45H (0=NO TRANSPORT CORRECTION/1=APOLLO TYPE/2, 7 57H=RECOVER FROM LIBRARY/3=WIMS-D TYPE/4=LEAKAGE CORRECTION)/ 8 7H NPASS ,I9,31H (NUMBER OF OUTER ITERATIONS)/ 9 7H IPHASE,I9,37H (=1: NATIVE ASSEMBLY; =2: USE PIJ)/ 1 7H ICALC ,I9,48H (=0: NO &CALC DATA; =1: &CALC DATA AVAILABLE)/ 2 7H IALTER,I9,47H (=0: USE EXACT KERNEL; =1: USE APPROXIMATE K, 3 6HERNEL)/ 4 7H MAXTRA,I9,44H (MAXIMUM NUMBER OF DOWN-SCATTERING TERMS)/ 5 6H ISEED,I10,45H (INITIAL SEED FOR RANDOM NUMBER GENERATOR)) END