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 |