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
132
133
|
*DECK EPCRPD
SUBROUTINE EPCRPD(NENTRY,KENTRY,IPRINT,NOPT,IOPT,CARRET)
*
*-----------------------------------------------------------------------
*
*Purpose:
* To extract library parameters with normal distribution
* around the average.
*
*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
* NENTRY number of data structures transfered to this module.
* KENTRY data structure pointer.
* IPRINT print level.
* NOPT number of options.
* IOPT processing option with:
* IOPT(1) type of processing (=0 for current option);
* IOPT(2) entry position for L_EPC structure;
* IOPT(3) number of parameters;
* IOPT(4) entry for normal distribution file;
* IOPT(5) number of records on normal distribution file.
* CARRET last input option read.
*
*-----------------------------------------------------------------------
*
USE GANLIB
IMPLICIT NONE
*----
* Subroutine arguments
*----
INTEGER NENTRY
TYPE(C_PTR) KENTRY(NENTRY)
INTEGER IPRINT,NOPT,IOPT(NOPT)
CHARACTER*12 CARRET
*----
* Local parameters
*----
INTEGER IOUT
CHARACTER NAMSBR*6
PARAMETER (IOUT=6,NAMSBR='EPCRPD')
INTEGER ILCMUP,ILCMDN
PARAMETER (ILCMUP=1,ILCMDN=2)
INTEGER NSTATE
PARAMETER (NSTATE=40)
*----
* Input and output parameters
*----
INTEGER ITYPLU,INTLIR
CHARACTER CARLIR*12
REAL REALIR
DOUBLE PRECISION DBLLIR
*----
* Local variables
*----
TYPE(C_PTR) IPNDI
INTEGER IKNDI
INTEGER ISTATE(NSTATE)
INTEGER NOREC,NTREC,NFREC,MAXD
*----
* Output structure
*----
IKNDI=1
IF(IOPT(3) .EQ. 0) IKNDI=-1
IPNDI=KENTRY(IOPT(2))
CALL LCMGET(IPNDI,'STATE-VECTOR',ISTATE)
*----
* Input structure
*----
NOREC=ISTATE(1)
MAXD=ISTATE(2)
NTREC=IOPT(5)
*----
* Recover parameter names from output and input structures
*----
NFREC=NTREC+NOREC
ISTATE(1)=NFREC
ISTATE(2)=MAXD
CALL LCMPUT(IPNDI,'STATE-VECTOR',NSTATE,1,ISTATE)
*----
* INPUT/OUTPUT VARIABLES
* Input data is of the form
* [ EDIT iprint ]
* [ SET (dataSET) ]
* [ GET (dataGET) ]
* where
* EDIT = keyword for print level
* iprint = integer print level
* SET = keyword to set reference value
* and extract number of parameters
* GET = keyword to set next value
* and to extract parameter
* (dataSET) = SET data processed by NDISET
* (dataGET) = GET data processed by NDIGET
*----
IPRINT=1
100 CONTINUE
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
101 CONTINUE
IF(ITYPLU .EQ. 10) GO TO 105
IF(ITYPLU .NE. 3) CALL XABORT(NAMSBR//
>': Read error -- Character variable expected')
IF(CARLIR .EQ. ';') THEN
GO TO 105
ELSE IF(CARLIR .EQ. 'EDIT') THEN
CALL REDGET(ITYPLU,INTLIR,REALIR,CARLIR,DBLLIR)
IF(ITYPLU .NE. 1) CALL XABORT(NAMSBR//
> ': Read error -- integer value for EDIT expected.')
IPRINT=INTLIR
ELSE IF(CARLIR .EQ. 'SET') THEN
CARRET=CARLIR
CARLIR=CARRET
GO TO 101
ELSE IF(CARLIR .EQ. 'GET') THEN
CARRET=CARLIR
CARLIR=CARRET
GO TO 101
ELSE
CALL XABORT(NAMSBR//
> ': '//CARLIR//' is an invalid keyword.')
ENDIF
GO TO 100
105 CONTINUE
RETURN
END
|
