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
|
*DECK MOCCAL
SUBROUTINE MOCCAL(N,NOMCEL,NREG,MCUW,MCUI,LMCU,LMXMCU)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Calculation of connection matrices.
*
*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): I. Suslov
*
*Parameters: input
* N number of segments on this track.
* NOMCEL integer tracking elements.
* NREG number of volumes.
* LMCU dimension (used) of MCUW.
* LMXMCU real dimension of MCUW MCUI.
*
*Parameters: input/output
* MCUW Suslov W correction matrix.
* MCUI Suslov I correction matrix.
*
*-----------------------------------------------------------------------
*
*----
* SUBROUTINE ARGUMENTS
*----
INTEGER N,NOMCEL(N),NREG,MCUW(LMXMCU),MCUI(LMXMCU),LMCU,LMXMCU
*
CHARACTER HSMG*131
*
DO 10 I=1,N
ICEL=NOMCEL(I)
IF (ICEL.LE.NREG) THEN
IF (I.EQ.N) THEN
ICEL1=NOMCEL(1)
ELSE
ICEL1=NOMCEL(I+1)
ENDIF
IF((ICEL.EQ.ICEL1).OR.(ICEL1.GT.NREG)) GOTO 6
* IS THERE AREADY AN ELEMENT IN MATRIX FOR CELL ICEL ?
IF (MCUW(ICEL).NE.0) GOTO 5
* NO :
MCUW(ICEL)=ICEL1
GOTO 6
* YES :
5 II=ICEL
IF(MCUW(II).EQ.ICEL1) GOTO 6
ICEL=MCUI(II)
IF(ICEL.NE.0) GOTO 5
* ADD NEW ELEMENT
LMCU=LMCU+1
IF(LMCU.GT.LMXMCU) THEN
WRITE(HSMG,'(42HMOCCAL: MEMORY OVERFLOW. INCREASE MCU. LMX,
1 4HMCU=,I10,1H.)') LMXMCU
CALL XABORT(HSMG)
ENDIF
MCUW(LMCU)=ICEL1
MCUI(II)=LMCU
6 CONTINUE
ENDIF
10 CONTINUE
*
RETURN
END
|
