NCEPLIBS-w3emc  2.9.3
w3ai19.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Blocker Subroutine.
3 C> @author Robert Allard @date 1997-04-15
4 
5 C> Fills a record block with logical records or lines of information.
6 C>
7 C> Program history log:
8 C> - Robeert Allard 1974-02-01
9 C> - Ralph Jones 1990-09-15 Convert from ibm370 assembler to microsoft
10 C> fortran 5.0.
11 C> - Ralph Jones 1990-10-07 Convert to sun fortran 1.3.
12 C> - Ralph Jones 1991-07-20 Convert to silicongraphics 3.3 fortran 77.
13 C> - Ralph Jones 1993-03-29 Add save statement.
14 C> - Ralph Jones 1994-04-22 Add xmovex and xstore to move and
15 C> store character data faster on the cray.
16 C> - Bob Hollern 1997-04-15 Corrected the problem of iniializing nblk
17 C> to @'s instead of blanks.
18 C>
19 C> @param[in] LINE Array address of logical record to be blocked.
20 C> @param[in] L Number of characters in line to be blocked.
21 C> @param[in] N Maximum character size of nblk.
22 C> @param[inout] NEXT (in) flag, initialized to 0. (out) character count, error indicator.
23 C> @param[out] NBLK Block filled with logical records.
24 C>
25 C> Exit states:
26 C> - NEXT = -1 Line will not fit into remainder of block;
27 C> otherwise, next is set to (next + l).
28 C> - NEXT = -2 N is zero or less.
29 C> - NEXT = -3 L is zero or less.
30 C>
31 C> @author Robert Allard @date 1997-04-15
32  SUBROUTINE w3ai19(LINE, L, NBLK, N, NEXT)
33 C
34 C METHOD:
35 C
36 C THE USER MUST SET NEXT = 0 EACH TIME NBLK IS TO BE FILLED WITH
37 C LOGICAL RECORDS.
38 C
39 C W3AI19 WILL THEN MOVE THE LINE OF INFORMATION INTO NBLK, STORE
40 C BLANK CHARACTERS IN THE REMAINDER OF THE BLOCK, AND SET NEXT = NEXT
41 C + L.
42 C
43 C EACH TIME W3AI19 IS ENTERED, ONE LINE IS BLOCKED AND NEXT INCRE-
44 C MENTED UNTIL A LINE WILL NOT FIT THE REMAINDER OF THE BLOCK. THEN
45 C W3AI19 WILL SET NEXT = -1 AS A FLAG FOR THE USER TO DISPOSE OF THE
46 C BLOCK. THE USER SHOULD BE AWARE THAT THE LAST LOGICAL RECORD WAS NOT
47 C BLOCKED.
48 C
49  INTEGER L
50  INTEGER N
51  INTEGER NEXT
52  INTEGER(8) WBLANK
53 C
54  CHARACTER * 1 LINE(*)
55  CHARACTER * 1 NBLK(*)
56  CHARACTER * 1 BLANK
57 C
58  SAVE
59 C
60  DATA wblank/z'2020202020202020'/
61 C
62 C TEST VALUE OF NEXT.
63 C
64  IF (next.LT.0) THEN
65  RETURN
66 C
67 C TEST N FOR ZERO OR LESS
68 C
69  ELSE IF (n.LE.0) THEN
70  next = -2
71  RETURN
72 C
73 C TEST L FOR ZERO OR LESS
74 C
75  ELSE IF (l.LE.0) THEN
76  next = -3
77  RETURN
78 C
79 C TEST TO SEE IF LINE WILL FIT IN BLOCK.
80 C
81  ELSE IF ((l + next).GT.n) THEN
82  next = -1
83  RETURN
84 C
85 C FILL BLOCK WITH BLANK CHARACTERS IF NEXT EQUAL ZERO.
86 C BLANK IS EBCDIC BLANK, 40 HEX, OR 64 DECIMAL
87 C
88  ELSE IF (next.EQ.0) THEN
89  CALL w3fi01(lw)
90  iwords = n / lw
91  CALL xstore(nblk,wblank,iwords)
92  IF (mod(n,lw).NE.0) THEN
93  nwords = iwords * lw
94  ibytes = n - nwords
95  DO i = 1,ibytes
96  nblk(nwords+i) = char(32)
97  END DO
98  END IF
99  END IF
100 C
101 C MOVE LINE INTO BLOCK.
102 C
103 C DO 20 I = 1,L
104 C NBLK(I + NEXT) = LINE(I)
105 C20 CONTINUE
106  CALL xmovex(nblk(next+1),line,l)
107 C
108 C ADJUST VALUE OF NEXT.
109 C
110  next = next + l
111 C
112  RETURN
113 C
114  END
w3ai19
subroutine w3ai19(LINE, L, NBLK, N, NEXT)
Fills a record block with logical records or lines of information.
Definition: w3ai19.f:33
xstore
subroutine xstore(COUT, CON, MWORDS)
Stores an 8-byte (fullword) value through consecutive storage locations.
Definition: xstore.f:29
xmovex
subroutine xmovex(OUT, IN, IBYTES)
Definition: xmovex.f:21
w3fi01
subroutine w3fi01(LW)
Determines the number of bytes in a full word for the particular machine (IBM or cray).
Definition: w3fi01.f:19