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
|
*DECK SPHSCO
SUBROUTINE SPHSCO(IPCPO,ICAL,IMPX,IMC,NMIL,NGRP,SPH)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Apply a new set of SPH factors for an elementary calculation in a
* Multicompo.
*
*Copyright:
* Copyright (C) 2012 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
* IPCPO pointer to the Multicompo (L_MULTICOMPO signature).
* ICAL index of the elementary calculation being considered.
* IMPX print parameter (equal to zero for no print).
* IMC type of macro-calculation (=1 diffusion or SPN;
* =2 other options).
* NMIL number of mixtures in the elementary calculation.
* NGRP number of energy groups in the elementary calculation.
* SPH SPH-factor set to be applied to the Multicompo.
*
*-----------------------------------------------------------------------
*
USE GANLIB
*----
* SUBROUTINE ARGUMENTS
*----
TYPE(C_PTR) IPCPO
INTEGER ICAL,IMPX,IMC,NMIL,NGRP
REAL SPH(NMIL,NGRP)
*----
* LOCAL VARIABLES
*----
PARAMETER (NSTATE=40,IOUT=6)
INTEGER ISTATE(NSTATE)
TYPE(C_PTR) JPCPO,KPCPO,LPCPO,MPCPO
REAL, ALLOCATABLE, DIMENSION(:) :: SPH2
*
CALL LCMLEN(IPCPO,'STATE-VECTOR',ILENG,ITYLCM)
IF(ILENG.EQ.0) CALL XABORT('SPHSCO: INVALID MULTICOMPO.')
CALL LCMGET(IPCPO,'STATE-VECTOR',ISTATE)
IF(NMIL.NE.ISTATE(1)) THEN
CALL XABORT('SPHSCO: INVALID NUMBER OF MIXTURES(1).')
ELSE IF(NGRP.NE.ISTATE(2)) THEN
CALL XABORT('SPHSCO: INVALID NUMBER OF ENERGY GROUPS(1).')
ELSE IF((ICAL.LE.0).OR.(ICAL.GT.ISTATE(3))) THEN
CALL XABORT('SPHSCO: INVALID VALUE OF ICAL.')
ENDIF
JPCPO=LCMGID(IPCPO,'MIXTURES')
DO 20 IBM=1,NMIL
IF(IMPX.GT.0) WRITE(IOUT,'(/33H SPHSCO: PROCESS MULTICOMPO MIXTU,
1 2HRE,I5)') IBM
KPCPO=LCMGIL(JPCPO,IBM)
LPCPO=LCMGID(KPCPO,'CALCULATIONS')
MPCPO=LCMGIL(LPCPO,ICAL)
CALL LCMGET(MPCPO,'STATE-VECTOR',ISTATE)
IF(ISTATE(1).NE.1) THEN
CALL XABORT('SPHSCO: INVALID NUMBER OF MIXTURES(2).')
ELSE IF(ISTATE(3).NE.NGRP) THEN
CALL XABORT('SPHSCO: INVALID NUMBER OF ENERGY GROUPS(2).')
ENDIF
NISOT=ISTATE(2)
NL=ISTATE(4)
NED=ISTATE(13)
NDEL=ISTATE(19)
NW=ISTATE(25)
ALLOCATE(SPH2(NGRP))
DO 10 IGR=1,NGRP
SPH2(IGR)=SPH(IBM,IGR)
10 CONTINUE
NALBP=0 ! no albedo correction
CALL SPHCMI(MPCPO,IMPX,IMC,1,NISOT,NGRP,NL,NW,NED,NDEL,NALBP,SPH2)
DEALLOCATE(SPH2)
20 CONTINUE
RETURN
END
|
