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
|
*DECK DELDRV
SUBROUTINE DELDRV (IPTRK,IPSYS0,IPSYSP,IPFLU0,IPGPT,NUN,NGRP,
1 NSTEP)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Driver for the calculation of direct or adjoint sources for a fixed
* source eigenvalue problem.
*
*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
* IPTRK L_TRACK pointer to the tracking information.
* IPSYS0 L_SYSTEM pointer to unperturbed system matrices.
* IPSYSP L_SYSTEM pointer to delta system matrices.
* IPFLU0 L_FLUX pointer to the unperturbed solution.
* IPGPT L_GPT pointer to the GPT fixed source.
* NUN total number of unknowns per energy group.
* NGRP number of energy groups.
* NSTEP number of perturbation states in STEP directory.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPTRK,IPSYS0,IPSYSP,IPFLU0,IPGPT
INTEGER NUN,NGRP,NSTEP
*----
* LOCAL VARIABLES
*----
LOGICAL ADJ
DOUBLE PRECISION DFLOTT
CHARACTER TEXT4*4
TYPE(C_PTR) JPFLU1,JPFLU2,JPGPT,KPGPT,JPSYSP,KPSYSP
REAL, DIMENSION(:,:), ALLOCATABLE :: EVECT,ADECT,SUNKNO
*----
* SCRATCH STORAGE ALLOCATION
*----
ALLOCATE(EVECT(NUN,NGRP),ADECT(NUN,NGRP),SUNKNO(NUN,NGRP))
*----
* READ THE INPUT DATA.
*----
* DEFAULT OPTIONS.
IMPX=1
ADJ=.FALSE.
*
10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
IF(INDIC.EQ.10) GO TO 20
IF(INDIC.NE.3) CALL XABORT('DELDRV: CHARACTER DATA EXPECTED.')
*
IF(TEXT4.EQ.'EDIT') THEN
CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
IF(INDIC.NE.1) CALL XABORT('DELDRV: INTEGER DATA EXPECTED.')
ELSE IF(TEXT4.EQ.'ADJ') THEN
ADJ=.TRUE.
ELSE IF(TEXT4.EQ.';') THEN
GO TO 20
ELSE
CALL XABORT('DELDRV: ; EXPECTED.')
ENDIF
GO TO 10
*----
* RECOVER UNPERTURBED K-EFFECTIVE AND FLUXES.
*----
20 CALL LCMGET(IPFLU0,'K-EFFECTIVE',FKEFF)
JPFLU1=LCMGID(IPFLU0,'FLUX')
JPFLU2=LCMGID(IPFLU0,'AFLUX')
DO 30 IGR=1,NGRP
CALL LCMGDL(JPFLU1,IGR,EVECT(1,IGR))
CALL LCMGDL(JPFLU2,IGR,ADECT(1,IGR))
30 CONTINUE
*----
* COMPUTE THE DIRECT OR ADJOINT FIXED SOURCES AND SAVE THE FIXED
* SOURCES.
*----
IF(NSTEP.EQ.0) THEN
CALL DELPER(IPTRK,IPSYS0,IPSYSP,ADJ,NUN,NGRP,FKEFF,IMPX,EVECT,
1 ADECT,DELKEF,SUNKNO)
IF(ADJ) THEN
JPGPT=LCMLID(IPGPT,'ASOUR',1)
ELSE
JPGPT=LCMLID(IPGPT,'DSOUR',1)
ENDIF
KPGPT=LCMLIL(JPGPT,1,NGRP)
DO 40 IGR=1,NGRP
CALL LCMPDL(KPGPT,IGR,NUN,2,SUNKNO(1,IGR))
40 CONTINUE
ELSE
JPSYSP=LCMGID(IPSYSP,'STEP')
IF(ADJ) THEN
JPGPT=LCMLID(IPGPT,'ASOUR',NSTEP)
ELSE
JPGPT=LCMLID(IPGPT,'DSOUR',NSTEP)
ENDIF
DO 55 ISTEP=1,NSTEP
KPSYSP=LCMGIL(JPSYSP,ISTEP)
CALL DELPER(IPTRK,IPSYS0,KPSYSP,ADJ,NUN,NGRP,FKEFF,IMPX,EVECT,
1 ADECT,DELKEF,SUNKNO)
KPGPT=LCMLIL(JPGPT,ISTEP,NGRP)
DO 50 IGR=1,NGRP
CALL LCMPDL(KPGPT,IGR,NUN,2,SUNKNO(1,IGR))
50 CONTINUE
55 CONTINUE
ENDIF
*----
* SCRATCH STORAGE DEALLOCATION
*----
DEALLOCATE(EVECT,ADECT,SUNKNO)
RETURN
END
|
