GCC Code Coverage Report

Directory:	./
File:	misc/xerprn.f
Date:	2022-01-11 19:19:34

	Exec	Total	Coverage
Lines:	0	52	0.0%
Branches:	0	52	0.0%

Line	Exec	Source
1		*DECK XERPRN
2	✗	SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
3		IMPLICIT NONE
4		C***BEGIN PROLOGUE XERPRN
5		C***SUBSIDIARY
6		C***PURPOSE Print error messages processed by XERMSG.
7		C***LIBRARY SLATEC (XERROR)
8		C***CATEGORY R3C
9		C***TYPE ALL (XERPRN-A)
10		C***KEYWORDS ERROR MESSAGES, PRINTING, XERROR
11		C***AUTHOR Fong, Kirby, (NMFECC at LLNL)
12		C***DESCRIPTION
13		C
14		C This routine sends one or more lines to each of the (up to five)
15		C logical units to which error messages are to be sent. This routine
16		C is called several times by XERMSG, sometimes with a single line to
17		C print and sometimes with a (potentially very long) message that may
18		C wrap around into multiple lines.
19		C
20		C PREFIX Input argument of type CHARACTER. This argument contains
21		C characters to be put at the beginning of each line before
22		C the body of the message. No more than 16 characters of
23		C PREFIX will be used.
24		C
25		C NPREF Input argument of type INTEGER. This argument is the number
26		C of characters to use from PREFIX. If it is negative, the
27		C intrinsic function LEN is used to determine its length. If
28		C it is zero, PREFIX is not used. If it exceeds 16 or if
29		C LEN(PREFIX) exceeds 16, only the first 16 characters will be
30		C used. If NPREF is positive and the length of PREFIX is less
31		C than NPREF, a copy of PREFIX extended with blanks to length
32		C NPREF will be used.
33		C
34		C MESSG Input argument of type CHARACTER. This is the text of a
35		C message to be printed. If it is a long message, it will be
36		C broken into pieces for printing on multiple lines. Each line
37		C will start with the appropriate prefix and be followed by a
38		C piece of the message. NWRAP is the number of characters per
39		C piece; that is, after each NWRAP characters, we break and
40		C start a new line. In addition the characters '$$' embedded
41		C in MESSG are a sentinel for a new line. The counting of
42		C characters up to NWRAP starts over for each new line. The
43		C value of NWRAP typically used by XERMSG is 72 since many
44		C older error messages in the SLATEC Library are laid out to
45		C rely on wrap-around every 72 characters.
46		C
47		C NWRAP Input argument of type INTEGER. This gives the maximum size
48		C piece into which to break MESSG for printing on multiple
49		C lines. An embedded '$$' ends a line, and the count restarts
50		C at the following character. If a line break does not occur
51		C on a blank (it would split a word) that word is moved to the
52		C next line. Values of NWRAP less than 16 will be treated as
53		C 16. Values of NWRAP greater than 132 will be treated as 132.
54		C The actual line length will be NPREF + NWRAP after NPREF has
55		C been adjusted to fall between 0 and 16 and NWRAP has been
56		C adjusted to fall between 16 and 132.
57		C
58		C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
59		C Error-handling Package, SAND82-0800, Sandia
60		C Laboratories, 1982.
61		C***ROUTINES CALLED I1MACH, XGETUA
62		C***REVISION HISTORY (YYMMDD)
63		C 880621 DATE WRITTEN
64		C 880708 REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF
65		C JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK
66		C THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE
67		C SLASH CHARACTER IN FORMAT STATEMENTS.
68		C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
69		C STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK
70		C LINES TO BE PRINTED.
71		C 890721 REVISED TO ADD A NEW FEATURE. A NEGATIVE VALUE OF NPREF
72		C CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.
73		C 891013 REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.
74		C 891214 Prologue converted to Version 4.0 format. (WRB)
75		C 900510 Added code to break messages between words. (RWC)
76		C 920501 Reformatted the REFERENCES section. (WRB)
77		C***END PROLOGUE XERPRN
78		CHARACTER() PREFIX, MESSG
79		INTEGER NPREF, NWRAP
80		CHARACTER*148 CBUFF
81		INTEGER IU(5), NUNIT
82		CHARACTER*2 NEWLIN
83		PARAMETER (NEWLIN = '$$')
84		INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC
85		INTEGER LPIECE, IDELTA
86		C***FIRST EXECUTABLE STATEMENT XERPRN
87	✗	CALL XGETUA(IU,NUNIT)
88		C
89		C A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD
90		C ERROR MESSAGE UNIT INSTEAD. I1MACH(4) RETRIEVES THE STANDARD
91		C ERROR MESSAGE UNIT.
92		C
93	✗	N = I1MACH(4)
94	✗	DO 10 I=1,NUNIT
95	✗	IF (IU(I) .EQ. 0) IU(I) = N
96	✗	10 CONTINUE
97		C
98		C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE
99		C BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING
100		C THE REST OF THIS ROUTINE.
101		C
102	✗	IF ( NPREF .LT. 0 ) THEN
103	✗	LPREF = LEN(PREFIX)
104		ELSE
105		LPREF = NPREF
106		ENDIF
107	✗	LPREF = MIN(16, LPREF)
108	✗	IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX
109		C
110		C LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE
111		C TIME FROM MESSG TO PRINT ON ONE LINE.
112		C
113	✗	LWRAP = MAX(16, MIN(132, NWRAP))
114		C
115		C SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.
116		C
117	✗	LENMSG = LEN(MESSG)
118		N = LENMSG
119	✗	DO 20 I=1,N
120	✗	IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30
121	✗	LENMSG = LENMSG - 1
122	✗	20 CONTINUE
123		30 CONTINUE
124		C
125		C IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.
126		C
127	✗	IF (LENMSG .EQ. 0) THEN
128	✗	CBUFF(LPREF+1:LPREF+1) = ' '
129	✗	DO 40 I=1,NUNIT
130	✗	WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)
131	✗	40 CONTINUE
132		RETURN
133		ENDIF
134		C
135		C SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING
136		C STARTS. FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.
137		C WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.
138		C WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.
139		C
140		C WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL. THE
141		C INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE
142		C OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH
143		C OF THE SECOND ARGUMENT.
144		C
145		C THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE
146		C FOLLOWING ORDER. WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER
147		C OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT
148		C POSITION NEXTC.
149		C
150		C LPIECE .EQ. 0 THE NEW LINE SENTINEL DOES NOT OCCUR IN THE
151		C REMAINDER OF THE CHARACTER STRING. LPIECE
152		C SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,
153		C WHICHEVER IS LESS.
154		C
155		C LPIECE .EQ. 1 THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:
156		C NEXTC). LPIECE IS EFFECTIVELY ZERO, AND WE
157		C PRINT NOTHING TO AVOID PRODUCING UNNECESSARY
158		C BLANK LINES. THIS TAKES CARE OF THE SITUATION
159		C WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF
160		C EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE
161		C SENTINEL FOLLOWED BY MORE CHARACTERS. NEXTC
162		C SHOULD BE INCREMENTED BY 2.
163		C
164		C LPIECE .GT. LWRAP+1 REDUCE LPIECE TO LWRAP.
165		C
166		C ELSE THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1
167		C RESET LPIECE = LPIECE-1. NOTE THAT THIS
168		C PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.
169		C LWRAP+1. THAT IS, THE SENTINEL FALLS EXACTLY
170		C AT THE END OF A LINE.
171		C
172	✗	NEXTC = 1
173	✗	50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN)
174	✗	IF (LPIECE .EQ. 0) THEN
175		C
176		C THERE WAS NO NEW LINE SENTINEL FOUND.
177		C
178		IDELTA = 0
179	✗	LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)
180	✗	IF (LPIECE .LT. LENMSG+1-NEXTC) THEN
181	✗	DO 52 I=LPIECE+1,2,-1
182	✗	IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
183	✗	LPIECE = I-1
184		IDELTA = 1
185	✗	GOTO 54
186		ENDIF
187	✗	52 CONTINUE
188		ENDIF
189	✗	54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
190	✗	NEXTC = NEXTC + LPIECE + IDELTA
191	✗	ELSEIF (LPIECE .EQ. 1) THEN
192		C
193		C WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).
194		C DON'T PRINT A BLANK LINE.
195		C
196	✗	NEXTC = NEXTC + 2
197	✗	GO TO 50
198	✗	ELSEIF (LPIECE .GT. LWRAP+1) THEN
199		C
200		C LPIECE SHOULD BE SET DOWN TO LWRAP.
201		C
202		IDELTA = 0
203		LPIECE = LWRAP
204	✗	DO 56 I=LPIECE+1,2,-1
205	✗	IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
206	✗	LPIECE = I-1
207		IDELTA = 1
208	✗	GOTO 58
209		ENDIF
210	✗	56 CONTINUE
211	✗	58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
212	✗	NEXTC = NEXTC + LPIECE + IDELTA
213		ELSE
214		C
215		C IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.
216		C WE SHOULD DECREMENT LPIECE BY ONE.
217		C
218	✗	LPIECE = LPIECE - 1
219	✗	CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
220	✗	NEXTC = NEXTC + LPIECE + 2
221		ENDIF
222		C
223		C PRINT
224		C
225	✗	DO 60 I=1,NUNIT
226	✗	WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)
227	✗	60 CONTINUE
228		C
229	✗	IF (NEXTC .LE. LENMSG) GO TO 50
230		RETURN
231	✗	END
232

1

*DECK XERPRN

2

✗

SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)

3

IMPLICIT NONE

4

C***BEGIN PROLOGUE XERPRN

5

C***SUBSIDIARY

6

C***PURPOSE Print error messages processed by XERMSG.

7

C***LIBRARY SLATEC (XERROR)

8

C***CATEGORY R3C

9

C***TYPE ALL (XERPRN-A)

10

C***KEYWORDS ERROR MESSAGES, PRINTING, XERROR

11

C***AUTHOR Fong, Kirby, (NMFECC at LLNL)

12

C***DESCRIPTION

13

C

14

C This routine sends one or more lines to each of the (up to five)

15

C logical units to which error messages are to be sent. This routine

16

C is called several times by XERMSG, sometimes with a single line to

17

C print and sometimes with a (potentially very long) message that may

18

C wrap around into multiple lines.

19

C

20

C PREFIX Input argument of type CHARACTER. This argument contains

21

C characters to be put at the beginning of each line before

22

C the body of the message. No more than 16 characters of

23

C PREFIX will be used.

24

C

25

C NPREF Input argument of type INTEGER. This argument is the number

26

C of characters to use from PREFIX. If it is negative, the

27

C intrinsic function LEN is used to determine its length. If

28

C it is zero, PREFIX is not used. If it exceeds 16 or if

29

C LEN(PREFIX) exceeds 16, only the first 16 characters will be

30

C used. If NPREF is positive and the length of PREFIX is less

31

C than NPREF, a copy of PREFIX extended with blanks to length

32

C NPREF will be used.

33

C

34

C MESSG Input argument of type CHARACTER. This is the text of a

35

C message to be printed. If it is a long message, it will be

36

C broken into pieces for printing on multiple lines. Each line

37

C will start with the appropriate prefix and be followed by a

38

C piece of the message. NWRAP is the number of characters per

39

C piece; that is, after each NWRAP characters, we break and

40

C start a new line. In addition the characters '$$' embedded

41

C in MESSG are a sentinel for a new line. The counting of

42

C characters up to NWRAP starts over for each new line. The

43

C value of NWRAP typically used by XERMSG is 72 since many

44

C older error messages in the SLATEC Library are laid out to

45

C rely on wrap-around every 72 characters.

46

C

47

C NWRAP Input argument of type INTEGER. This gives the maximum size

48

C piece into which to break MESSG for printing on multiple

49

C lines. An embedded '$$' ends a line, and the count restarts

50

C at the following character. If a line break does not occur

51

C on a blank (it would split a word) that word is moved to the

52

C next line. Values of NWRAP less than 16 will be treated as

53

C 16. Values of NWRAP greater than 132 will be treated as 132.

54

C The actual line length will be NPREF + NWRAP after NPREF has

55

C been adjusted to fall between 0 and 16 and NWRAP has been

56

C adjusted to fall between 16 and 132.

57

C

58

C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC

59

C Error-handling Package, SAND82-0800, Sandia

60

C Laboratories, 1982.

61

C***ROUTINES CALLED I1MACH, XGETUA

62

C***REVISION HISTORY (YYMMDD)

63

C 880621 DATE WRITTEN

64

C 880708 REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF

65

C JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK

66

C THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE

67

C SLASH CHARACTER IN FORMAT STATEMENTS.

68

C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO

69

C STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK

70

C LINES TO BE PRINTED.

71

C 890721 REVISED TO ADD A NEW FEATURE. A NEGATIVE VALUE OF NPREF

72

C CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.

73

C 891013 REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.

74

C 891214 Prologue converted to Version 4.0 format. (WRB)

75

C 900510 Added code to break messages between words. (RWC)

76

C 920501 Reformatted the REFERENCES section. (WRB)

77

C***END PROLOGUE XERPRN

78

CHARACTER*(*) PREFIX, MESSG

INTEGER NPREF, NWRAP

CHARACTER*148 CBUFF

INTEGER IU(5), NUNIT

CHARACTER*2 NEWLIN

PARAMETER (NEWLIN = '$$')

84

INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC

85

INTEGER LPIECE, IDELTA

86

C***FIRST EXECUTABLE STATEMENT XERPRN

87

✗

CALL XGETUA(IU,NUNIT)

88

C

89

C A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD

90

C ERROR MESSAGE UNIT INSTEAD. I1MACH(4) RETRIEVES THE STANDARD

91

C ERROR MESSAGE UNIT.

92

C

93

✗

N = I1MACH(4)

94

✗

DO 10 I=1,NUNIT

95

✗

IF (IU(I) .EQ. 0) IU(I) = N

96

✗

10 CONTINUE

97

C

98

C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE

99

C BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING

100

C THE REST OF THIS ROUTINE.

101

C

102

✗

IF ( NPREF .LT. 0 ) THEN

103

✗

LPREF = LEN(PREFIX)

ELSE

LPREF = NPREF

ENDIF

✗

LPREF = MIN(16, LPREF)

108

✗

IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX

109

C

110

C LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE

111

C TIME FROM MESSG TO PRINT ON ONE LINE.

112

C

113

✗

LWRAP = MAX(16, MIN(132, NWRAP))

114

C

115

C SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.

116

C

117

✗

LENMSG = LEN(MESSG)

118

N = LENMSG

119

✗

DO 20 I=1,N

120

✗

IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30

121

✗

LENMSG = LENMSG - 1

122

✗

20 CONTINUE

123

30 CONTINUE

124

C

125

C IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.

126

C

127

✗

IF (LENMSG .EQ. 0) THEN

128

✗

CBUFF(LPREF+1:LPREF+1) = ' '

129

✗

DO 40 I=1,NUNIT

130

✗

WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)

131

✗

40 CONTINUE

RETURN

ENDIF

C

C SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING

136

C STARTS. FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.

137

C WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.

138

C WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.

139

C

140

C WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL. THE

141

C INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE

142

C OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH

143

C OF THE SECOND ARGUMENT.

144

C

145

C THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE

146

C FOLLOWING ORDER. WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER

147

C OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT

148

C POSITION NEXTC.

149

C

150

C LPIECE .EQ. 0 THE NEW LINE SENTINEL DOES NOT OCCUR IN THE

151

C REMAINDER OF THE CHARACTER STRING. LPIECE

152

C SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,

153

C WHICHEVER IS LESS.

154

C

155

C LPIECE .EQ. 1 THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:

156

C NEXTC). LPIECE IS EFFECTIVELY ZERO, AND WE

157

C PRINT NOTHING TO AVOID PRODUCING UNNECESSARY

158

C BLANK LINES. THIS TAKES CARE OF THE SITUATION

159

C WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF

160

C EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE

161

C SENTINEL FOLLOWED BY MORE CHARACTERS. NEXTC

162

C SHOULD BE INCREMENTED BY 2.

163

C

164

C LPIECE .GT. LWRAP+1 REDUCE LPIECE TO LWRAP.

165

C

166

C ELSE THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1

167

C RESET LPIECE = LPIECE-1. NOTE THAT THIS

168

C PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.

169

C LWRAP+1. THAT IS, THE SENTINEL FALLS EXACTLY

170

C AT THE END OF A LINE.

171

C

172

✗

NEXTC = 1

173

✗

50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN)

174

✗

IF (LPIECE .EQ. 0) THEN

175

C

176

C THERE WAS NO NEW LINE SENTINEL FOUND.

177

C

178

IDELTA = 0

179

✗

LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)

180

✗

IF (LPIECE .LT. LENMSG+1-NEXTC) THEN

181

✗

DO 52 I=LPIECE+1,2,-1

182

✗

IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN

183

✗

LPIECE = I-1

184

IDELTA = 1

185

✗

GOTO 54

186

ENDIF

187

✗

52 CONTINUE

188

ENDIF

189

✗

54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)

190

✗

NEXTC = NEXTC + LPIECE + IDELTA

191

✗

ELSEIF (LPIECE .EQ. 1) THEN

192

C

193

C WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).

194

C DON'T PRINT A BLANK LINE.

195

C

196

✗

NEXTC = NEXTC + 2

197

✗

GO TO 50

198

✗

ELSEIF (LPIECE .GT. LWRAP+1) THEN

199

C

200

C LPIECE SHOULD BE SET DOWN TO LWRAP.

C

IDELTA = 0

LPIECE = LWRAP

✗

DO 56 I=LPIECE+1,2,-1

205

✗

IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN

206

✗

LPIECE = I-1

207

IDELTA = 1

208

✗

GOTO 58

209

ENDIF

210

✗

56 CONTINUE

211

✗

58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)

212

✗

NEXTC = NEXTC + LPIECE + IDELTA

213

ELSE

214

C

215

C IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.

216

C WE SHOULD DECREMENT LPIECE BY ONE.

217

C

218

✗

LPIECE = LPIECE - 1

219

✗

CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)

220

✗

NEXTC = NEXTC + LPIECE + 2

ENDIF

C

C PRINT

C

✗

DO 60 I=1,NUNIT

226

✗

WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)

227

✗

60 CONTINUE

228

C

229

✗

IF (NEXTC .LE. LENMSG) GO TO 50

230

RETURN

231

✗

END

232