1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
*DECK DUO
SUBROUTINE DUO(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Perturbative analysis of two systems and determination of the origins
* of Keff discrepancies.
*
*Copyright:
* Copyright (C) 2013 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): read-only type(L_LIBRARY) first system;
* HENTRY(2): read-only type(L_LIBRARY) second system.
* 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)
TYPE(C_PTR) IPLIB1,IPLIB2
CHARACTER HSIGN*12,CARLIR*12
INTEGER ISTATE(NSTATE)
REAL REALIR
DOUBLE PRECISION DBLLIR
LOGICAL LENER,LISOT,LMIXT,LREAC
*----
* PARAMETER VALIDATION.
*----
IF(NENTRY.NE.2) CALL XABORT('DUO: TWO PARAMETERS EXPECTED.')
DO IEN=1,2
IF((IENTRY(IEN).NE.1).AND.(IENTRY(IEN).NE.2)) CALL XABORT('DUO'
1 //': LCM OBJECT EXPECTED AT LHS.')
IF(JENTRY(IEN).NE.2) CALL XABORT('DUO: ENTRY IN READ-ONLY MODE'
1 //' EXPECTED.')
CALL LCMGTC(KENTRY(IEN),'SIGNATURE',12,HSIGN)
IF(HSIGN.NE.'L_LIBRARY') THEN
CARLIR=HENTRY(IEN)
CALL XABORT('DUO: SIGNATURE OF '//CARLIR//' IS '//HSIGN//
1 '. L_LIBRARY EXPECTED.')
ENDIF
ENDDO
IPLIB1=KENTRY(1)
IPLIB2=KENTRY(2)
CALL LCMGET(IPLIB1,'STATE-VECTOR',ISTATE)
NG=ISTATE(3)
CALL LCMGET(IPLIB2,'STATE-VECTOR',ISTATE)
IF(ISTATE(3).NE.NG) CALL XABORT('DUO: INVALID NUMBER OF ENERGY G'
1 //'ROUPS.')
*---
* READ DATA
*---
IPRINT=1
LENER=.FALSE.
LISOT=.FALSE.
LMIXT=.FALSE.
LREAC=.FALSE.
10 CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
IF(ITYPLU.EQ.10) GO TO 100
IF(ITYPLU.NE.3) CALL XABORT('DUO: READ ERROR - CHARACTER VARI'
> //'ABLE EXPECTED')
IF(CARLIR.EQ.';') THEN
GO TO 100
ELSE IF(CARLIR.EQ.'EDIT') THEN
CALL REDGET(ITYPLU,IPRINT,REALIR,CARLIR,DBLLIR)
IF(ITYPLU.NE.1) CALL XABORT('DUO: READ ERROR - INTEGER VARI'
> //'ABLE EXPECTED')
ELSE IF(CARLIR.EQ.'ENERGY') THEN
LENER=.TRUE.
ELSE IF(CARLIR.EQ.'ISOTOPE') THEN
LISOT=.TRUE.
ELSE IF(CARLIR.EQ.'MIXTURE') THEN
LMIXT=.TRUE.
ELSE IF(CARLIR.EQ.'REAC') THEN
LREAC=.TRUE.
GO TO 100
ELSE
CALL XABORT('DUO: ILLEGAL KEYWORD '//CARLIR)
ENDIF
GO TO 10
100 CALL LCMGET(IPLIB1,'STATE-VECTOR',ISTATE)
NMIX=ISTATE(1)
NISOT=ISTATE(2)
NGRP=ISTATE(3)
CALL LCMGET(IPLIB2,'STATE-VECTOR',ISTATE)
IF(ISTATE(1).NE.NMIX) CALL XABORT('DUO: THE TWO MICROLIBS HAVE A'
> //' DIFFERENT NUMBER OF MIXTURES.')
IF(ISTATE(2).NE.NISOT) CALL XABORT('DUO: THE TWO MICROLIBS HAVE '
> //'A DIFFERENT NUMBER OF ISOTOPES.')
IF(ISTATE(3).NE.NGRP) CALL XABORT('DUO: THE TWO MICROLIBS HAVE A'
> //' DIFFERENT NUMBER OF GROUPS.')
*
CALL DUODRV(IPLIB1,IPLIB2,IPRINT,LENER,LISOT,LMIXT,LREAC,NMIX,
> NISOT,NGRP)
RETURN
END
|
