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
|
SUBROUTINE GRIDIP (GRID,SEQSS,LEN,IPSET,CSET,NO,Z,LLOC)
C
C THIS SUBROUTINE FINDS SETS OF IP NUMBERS AND DEGREE OF FREEDOM
C COMPONENT NUMBERS FOR GRID POINTS DEFINED IN A BASIC
C SUBSTRUCTURE THAT IS A COMPONENT OF A PSEUDO-STRUCTURE.
C
C ARGUMENTS
C GRID - GRID POINT ID NUMBER
C SEQSS - THE STARTING ADDRESS IN OPEN CORE OF THE
C PSEUDO-STRUCTURE EQSS RECORD
C LEN - LENGTH OF THE EQSS
C IPSET - THE SET OF IP NUMBERS FOR GRID
C CSET - COMPONENTS OF GIVEN IP NUMBER
C NO - THE NUMBER OF IP DEFINED BY GRID
C
C
EXTERNAL ORF,RSHIFT
INTEGER ORF,RSHIFT,GRID,SEQSS,IPSET(6),CSET(6),POSNO,Z(1)
COMMON /CMBFND/ INAM(2),IERR
C
IERR = 0
NENT = LEN/3
C
C SEARCH FOR THE GRID ID IN THE EQSS
C
C NOTE --- FOR RAPID LOCATION OF ALL IP FOR A GIVEN GRID,
C THE COMPONENT WORD OF THE EQSS HAS HAD ITS FIRST
C SIX BITS PACKED WITH A CODE- THE FIRST THREE
C BITS GIVE THE NUMBER OF THE IP AND THE SECOND
C THREE THE TOTAL NO. OF IP. E.G. 011101 MEANS
C THE CURRENT IP IS THE THIRD OF FIVE FOR THIS
C GRID ID.
C
C
CALL BISLOC (*30,GRID,Z(SEQSS),3,NENT,LOC)
K = SEQSS + LOC - 1
ICODE = RSHIFT(Z(K+2),26)
C
C ICODE CONTAINS SIX BIT CODE
C
POSNO = ICODE/8
NOAPP = ICODE - 8*POSNO
C
C POSNO IS THE POSITION NUMBER OF THE GRID WE HAVE FOUND,
C NOAPP IS THE TOTAL NUMBER OF APPEARANCES OF THAT GRID.
C
IF (NOAPP .EQ. 0) POSNO = 1
IF (NOAPP .EQ. 0) NOAPP = 1
ISTART = K - 3*(POSNO-1)
LLOC = ISTART
C
C PICK UP RIGHT 26 BITS BY MASK26 FOR CSET(I), INSTEAD OF R/LSHIFT
C
MASK26 = MASKN(26,0)
C
DO 20 I = 1,NOAPP
KK = ISTART + 3*(I-1)
IPSET(I) = Z(KK+1)
CSET(I) = ORF(Z(KK+2),MASK26)
20 CONTINUE
C
NO = NOAPP
GO TO 40
30 IERR = 1
40 RETURN
END
|
