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
|
*DECK LIBDI4
SUBROUTINE LIBDI4 (MAXDIL,NAMFIL,HSHI,NDIL,DILUT)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Find the dilutions corresponding to a resonant isotope within a
* library in Apolib-1 format.
*
*Copyright:
* Copyright (C) 2002 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
* MAXDIL maximum number of dilutions.
* NAMFIL name of the Apolib file.
* HSHI library name of the self-shielding data.
*
*Parameters: output
* NDIL number of finite dilutions.
* DILUT dilutions.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER MAXDIL,NDIL
CHARACTER NAMFIL*(*),HSHI*12
REAL DILUT(MAXDIL)
*----
* LOCAL VARIABLES
*----
PARAMETER (MAXIT=1000)
CHARACTER FORM*4,HSMG*131
INTEGER IT(MAXIT),NTETA(3)
REAL, ALLOCATABLE, DIMENSION(:) :: WORK
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(WORK(MAXDIL))
*
NIN=KDROPN(NAMFIL,2,2,0)
IF(NIN.LE.0) THEN
WRITE (HSMG,'(35HLIBDI4: UNABLE TO OPEN LIBRARY FILE,1X,A16,
1 6H. NIN=,I4,1H.)') NAMFIL,NIN
CALL XABORT(HSMG)
ENDIF
I=INDEX(HSHI,' ')
IF(HSHI.EQ.' ') THEN
NISBEF=0
ELSE IF(I.EQ.0) THEN
READ(HSHI,'(I8)') NISBEF
ELSE
WRITE(FORM,'(2H(I,I1,1H))') I-1
READ(HSHI,FORM) NISBEF
ENDIF
10 READ(NIN) INDLOR,NR,NIT,(IT(I),I=1,NIT),(DUMMY,I=1,18)
IF(NIT.GT.MAXIT) CALL XABORT('LIBDI4: INVALID MAXIT.')
IF(INDLOR.EQ.9999) THEN
CALL XABORT('LIBDI4: UNABLE TO FIND ISOTOPE '//HSHI//'.')
ELSE IF(INDLOR.EQ.NISBEF) THEN
NTYPE=0
JTYSEC=0
DO 20 IK=1,IT(4)
IF(IT(IK+4).NE.JTYSEC) THEN
NTYPE=NTYPE+1
NTETA(NTYPE)=1
JTYSEC=IT(IK+4)
ELSE
NTETA(NTYPE)=NTETA(NTYPE)+1
ENDIF
20 CONTINUE
DO 55 I=1,NTYPE
READ (NIN) TEMP,NSEI,(WORK(K),K=1,NSEI)
IF(NSEI.GT.MAXDIL) CALL XABORT('LIBDI4: INVALID MAXDIL.')
IF(I.EQ.1) THEN
NDIL=NSEI
DO 30 K=NSEI,1,-1
IF(WORK(K).GE.1.0E10) THEN
NDIL=NDIL-1
ELSE
DILUT(K)=WORK(K)
ENDIF
30 CONTINUE
DILUT(NDIL+1)=1.0E10
ELSE
DO 40 K=NSEI,1,-1
IF((WORK(K).LT.1.0E10).AND.(WORK(K).NE.DILUT(K))) THEN
WRITE(HSMG,'(26HLIBDI4: INVALID DILUTION (,1P,E12.4,
1 9H) ON TYPE,I2,11H REACTIONS.,E12.4,10H EXPECTED.)')
2 WORK(K),I,DILUT(K)
CALL XABORT(HSMG)
ENDIF
40 CONTINUE
ENDIF
DO 50 ITET=2,NTETA(I)
READ(NIN)
50 CONTINUE
55 CONTINUE
ELSE
DO 60 K=1,NR
READ(NIN)
60 CONTINUE
GO TO 10
ENDIF
IER=KDRCLS(NIN,1)
IF(IER.LT.0) THEN
WRITE (HSMG,'(36HLIBDI4: UNABLE TO CLOSE LIBRARY FILE,1X,A16,
1 1H.)') NAMFIL
CALL XABORT(HSMG)
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(WORK)
RETURN
END
|
