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
122
123
124
125
126
127
128
129
130
131
|
*DECK EPCRMI
SUBROUTINE EPCRMI(IPMIC,IPRINT,NIS,NBISO,NMIXT,NIFISS,
> NAMISO,NISOU,IDVF,IDMF)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Cross reference variance isotopes and MICROLIB isotopes.
*
*Copyright:
* Copyright (C) 2009 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):
* G. Marleau
*
*Parameters: input
* IPMIC pointer to microlib.
* IPRINT print level.
* NIS number of isotopes on EPC.
* NBISO number of isotopes on MICROLIB.
* NMIXT number of mixtures on MICROLIB.
* NIFISS number of fissiles isotopes on MICROLIB.
*
*Parameters: output
* NAMISO array containing the isotope names.
* NISOU MICROLIB isotopes used.
* IDVF variance isotopes to analyze and fission id.
* IDMF MICROLIB isotopes to analyze and fission id.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* Subroutine arguments
*----
TYPE(C_PTR) IPMIC
INTEGER IPRINT,NIS,NBISO,NMIXT,NIFISS
INTEGER NAMISO(3,NIS),NISOU(3,NBISO),
> IDVF(2,NIS),IDMF(2,NBISO)
*----
* Local parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='EPCRMI')
INTEGER ILCMUP,ILCMDN
PARAMETER (ILCMUP=1,ILCMDN=2)
*----
* Local variables
*----
INTEGER IPRTL,NBIU,ISO,JSO,IFI
*----
* Allocatable arrays
*----
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: NISON,FID,FNM
*----
* Scratch storage allocation
* NISON MICROLIB isotopes reference names
* FID MICROLIB fissile id
* FNM MICROLIB fissile name
*----
ALLOCATE(NISON(3,NBISO),FID(NMIXT,NIFISS),FNM(2,NIFISS))
*----
* Write header
*----
IPRTL=IPRINT
IF(IPRTL .GE. 10) THEN
WRITE(IOUT,6000) NAMSBR
ENDIF
*----
* Isotope names identification
*----
CALL LCMGET(IPMIC,'ISOTOPERNAME',NISON)
*----
* Fissile isotopes identifier
*----
CALL LCMSIX(IPMIC,'MACROLIB ',ILCMUP)
CALL LCMGET(IPMIC,'FISSIONINDEX',FID)
CALL LCMGET(IPMIC,'FISSIONNAMES',FNM)
CALL LCMSIX(IPMIC,'MACROLIB ',ILCMDN)
IDVF(:2,:NIS)=0
IDMF(:2,:NBISO)=0
DO ISO=1,NIS
*----
* Test if isotope used in Microlib
*----
NBIU=0
DO JSO=1,NBISO
IF( (NISON(1,JSO) .EQ. NAMISO(1,ISO)) .AND.
> (NISON(2,JSO) .EQ. NAMISO(2,ISO)) .AND.
> (NISON(3,JSO) .EQ. NAMISO(3,ISO)) ) THEN
IDMF(1,JSO)=ISO
NBIU=NBIU+1
ENDIF
ENDDO
IF(NBIU .GT. 0) IDVF(1,ISO)=1
ENDDO
*----
* Find fissile isotope id
*----
DO JSO=1,NBISO
ISO=IDMF(1,JSO)
IF(ISO .GT. 0) THEN
DO IFI=1,NIFISS
IF( (FNM(1,IFI) .EQ. NISOU(1,JSO)) .AND.
> (FNM(2,IFI) .EQ. NISOU(2,JSO)) ) THEN
IDMF(2,JSO)=IFI
IDVF(2,ISO)=IFI
ENDIF
ENDDO
ENDIF
ENDDO
IF(IPRTL .GE. 2) THEN
WRITE(IOUT,6001) NAMSBR
ENDIF
*----
* Scratch storage deallocation
*----
DEALLOCATE(FNM,FID,NISON)
RETURN
*----
* Formats
*----
6000 FORMAT('(* Output from --',A6,'-- follows ')
6001 FORMAT(' Output from --',A6,'-- completed *)')
END
|
