summaryrefslogtreecommitdiff
path: root/Dragon/src/AUTO.f
diff options
context:
space:
mode:
Diffstat (limited to 'Dragon/src/AUTO.f')
-rw-r--r--Dragon/src/AUTO.f383
1 files changed, 383 insertions, 0 deletions
diff --git a/Dragon/src/AUTO.f b/Dragon/src/AUTO.f
new file mode 100644
index 0000000..37f7f98
--- /dev/null
+++ b/Dragon/src/AUTO.f
@@ -0,0 +1,383 @@
+*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
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 13:22:46 +0000