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
|
*DECK LIBIPS
SUBROUTINE LIBIPS(IPLIB,NBISO,IPISO)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Construct the pointer array towards microlib isotopes.
*
*Copyright:
* Copyright (C) 2017 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
* IPLIB pointer to the lattice microscopic cross section library
* (L_LIBRARY signature).
* NBISO number of isotopes present in the calculation domain.
*
*Parameters: output
* IPISO pointer array towards microlib isotopes.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NBISO
TYPE(C_PTR) IPLIB,IPISO(NBISO)
*----
* LOCAL VARIABLES
*----
TYPE(C_PTR) JPLIB
*----
* ALLOCATABLE ARRAYS
*----
INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISONAM
*
ALLOCATE(ISONAM(3,NBISO))
CALL LCMGET(IPLIB,'ISOTOPESUSED',ISONAM)
JPLIB=LCMGID(IPLIB,'ISOTOPESLIST')
DO 10 ISOT=1,NBISO
CALL LCMLEL(JPLIB,ISOT,LENGTH,ITYLCM)
IF(LENGTH.NE.0) THEN
IPISO(ISOT)=LCMGIL(JPLIB,ISOT) ! set ISOT-th isotope
ELSE
DO JSOT=1,ISOT-1
IF(ISONAM(1,ISOT).NE.ISONAM(1,JSOT)) CYCLE
IF(ISONAM(2,ISOT).NE.ISONAM(2,JSOT)) CYCLE
IF(ISONAM(3,ISOT).NE.ISONAM(3,JSOT)) CYCLE
IF(.NOT.C_ASSOCIATED(IPISO(JSOT))) CYCLE
IPISO(ISOT)=IPISO(JSOT) ! set JSOT-th isotope
GO TO 10
ENDDO
IPISO(ISOT)=C_NULL_PTR
ENDIF
10 CONTINUE
DEALLOCATE(ISONAM)
RETURN
END
|
