/[PAMELA software]/calo/ground/LEVEL2/src/millim.for
ViewVC logotype

Annotation of /calo/ground/LEVEL2/src/millim.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Mon Dec 5 16:13:53 2005 UTC (19 years ago) by mocchiut
Branch: LEVEL2, MAIN
CVS Tags: v4r04, v4r00, start, HEAD
Changes since 1.1: +0 -0 lines
Imported sources

1 mocchiut 1.1 SUBROUTINE MILLIM(LL,RMM)
2     C----------------------------------------------------------------------
3     C-
4     C- Purpose and Methods : TRASFORMA IL NUMERO DI STRISCIA IN mm TENENDO CONTO
5     C- DELLE AREE MORTE
6     C-
7     C- Inputs : NUMERO DI STRISCIA (INTERO)
8     C- Outputs : VALORE IN mm (REALE)
9     C- Controls:
10     C-
11     C- Created 3-FEB-1994 MIRKO BOEZIO
12     C- Modified 1-MAR-1994 MIRKO BOEZIO . SOSTITUITO IN MILLIM
13     C- - AA / 2. CON
14     C- - 3.75 / 2.
15     C- Modified 31-MAR-1994 MIRKO BOEZIO . AGGIUNTA IN LASTRISCIA LA RIGA :
16     C- IF (IBAR.EQ.0) IBAR = 1
17     C-
18     C----------------------------------------------------------------------
19     INCLUDE 'INTEST.TXT'
20    
21     COMMON /SHIFT/ SHIFT
22    
23     AAA = AA + SHIFT
24     II = LL - 1
25     K1 = INT(II / 32)
26     K2 = MOD(II,32) + 1
27     RMM = FLOAT(K1) * ADIST + AAA + FLOAT(K2) * 2.44 - 2.44 / 2.
28     C
29    
30     999 RETURN
31     END
32     C
33     C---------------------------------------------------------------------
34     SUBROUTINE LASTRISCIA(BAR,IBAR)
35     C---------------------------------------------------------------------
36     C TRASFORMA UN VALORE IN mm NELL'EQUIVALENTE VALORE IN NUMERO DI STRISCIA .
37     C
38     INCLUDE 'INTEST.TXT'
39    
40     COMMON /SHIFT/ SHIFT
41    
42    
43     BBAR = BAR - SHIFT
44     IBAR = 0
45     DO L = 1,NCHA
46     ALUNG = INT((FLOAT(L) - 1.) / 32.) * ADIST + AA
47     II = L - 1
48     K = MOD(II,32)
49     RLINF = FLOAT(K) * 2.44 + ALUNG
50     RLSUP = FLOAT(K + 1) * 2.44 + ALUNG
51     IF (BBAR.GT.RLINF.AND.BBAR.LT.RLSUP) THEN
52     IBAR = L
53     GO TO 500
54     ENDIF
55     ENDDO
56     C
57     C SE BAR SI TROVA SU UN'AREA MORTA SI PRENDE LA STRISCIA INFERIORE PIU`
58     C PROSSIMA TRANNE QUANDO SI TRATTA DELLA PRIMA AREA MORTA NEL QUAL CASO SI
59     C PRENDE IBAR = 1 .
60     C
61     IF (IBAR.EQ.0.AND.BBAR.GT.0.0001) THEN
62     LK = INT(BBAR / ADIST)
63     C$ IF (LK.EQ.0) LK = 1
64     DIS = BBAR - ADIST * FLOAT(LK+1)
65     IF (DIS.LT.-1.96) THEN
66     IBAR = 32 * LK
67     ELSE IF (DIS.GE.-1.96.AND.DIS.LE.-0.5) THEN
68     IBAR = 32 * (LK + 1)
69     ELSE IF (DIS.GT.-0.5.AND.DIS.LE.0.) THEN
70     IBAR = 32 * (LK + 1) + 1
71     ELSE
72     PRINT *,'PROBLEMS :',BBAR
73     ENDIF
74     IF (IBAR.EQ.0) IBAR = 1
75     ENDIF
76     C
77     500 CONTINUE
78     RETURN
79     END
80     C

  ViewVC Help
Powered by ViewVC 1.1.23