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
|
*DECK COMTRE
LOGICAL FUNCTION COMTRE(NPAR,NVP,ARB,DEB,MUPLET,IPARM,I0,II,JJ,
1 LAST)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Find the index of the corresponding elementary calculation in the
* global parameter tree for a value of the tuple MUPLET. If the
* elementary calculation exists, set COMTRE=.true. otherwise, set the
* indices in the tree where the new calculation must be introduced.
*
*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
* NPAR number of global parameters.
* NVP number of nodes in the global parameter tree.
* ARB array arbval of the global parameters tree.
* DEB array debarb of the global parameters tree.
* MUPLET tuple of indices associated to each global parameter of the
* elementary calculation.
*
*Parameters: output
* IPARM index of the parameter not corresponding to a node.
* I0 index in DEB of the first element corresponding to
* parameter iparm.
* II index of the elementary calculation corresponding to the
* tuple muplet (if exists). Otherwise, index in DEB of the
* element that will contain the new elementary calculation.
* JJ if the node has not been found, index in DEB of the
* element corresponding to the next node.
* LAST completion flag (=.true. if the node has not been found).
* If LAST=.true., a node will be added at the end of the tree.
* COMTRE If COMTRE=.true., node already exists.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER NPAR,NVP,ARB(NVP),DEB(NVP+1),MUPLET(NPAR),IPARM,I0,II,JJ
LOGICAL LAST
*
IPARM=NPAR
II=1
I0=1
DO 30 IPAR=1,NPAR
I0=DEB(I0)
DO 10 I=DEB(II),DEB(II+1)-1
IF(MUPLET(IPAR).EQ.ARB(I))THEN
II=I
GO TO 30
ELSEIF(MUPLET(IPAR).LT.ARB(I))THEN
JJ=I
LAST=.FALSE.
GO TO 20
ENDIF
10 CONTINUE
JJ=DEB(II+1)
LAST=JJ.EQ.DEB(I0)
20 IPARM=IPAR
COMTRE=.FALSE.
RETURN
30 CONTINUE
II=DEB(II+1)
COMTRE=.TRUE.
*
RETURN
END
|
