Changeset 5086 for LMDZ6/branches/Amaury_dev/libf/misc/xerprn.F
- Timestamp:
- Jul 19, 2024, 7:54:50 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/misc/xerprn.F
r5082 r5086 92 92 C 93 93 N = I1MACH(4) 94 DO 10I=1,NUNIT94 DO I=1,NUNIT 95 95 IF (IU(I) == 0) IU(I) = N 96 10 CONTINUE96 END DO 97 97 C 98 98 C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE … … 117 117 LENMSG = LEN(MESSG) 118 118 N = LENMSG 119 DO 20I=1,N119 DO I=1,N 120 120 IF (MESSG(LENMSG:LENMSG) /= ' ') GO TO 30 121 121 LENMSG = LENMSG - 1 122 20 CONTINUE122 END DO 123 123 30 CONTINUE 124 124 C … … 127 127 IF (LENMSG == 0) THEN 128 128 CBUFF(LPREF+1:LPREF+1) = ' ' 129 DO 40I=1,NUNIT129 DO I=1,NUNIT 130 130 WRITE(IU(I), '(A)') CBUFF(1:LPREF+1) 131 40 CONTINUE131 END DO 132 132 RETURN 133 133 ENDIF … … 179 179 LPIECE = MIN(LWRAP, LENMSG+1-NEXTC) 180 180 IF (LPIECE < LENMSG+1-NEXTC) THEN 181 DO 52I=LPIECE+1,2,-1181 DO I=LPIECE+1,2,-1 182 182 IF (MESSG(NEXTC+I-1:NEXTC+I-1) == ' ') THEN 183 183 LPIECE = I-1 … … 185 185 GOTO 54 186 186 ENDIF 187 52 CONTINUE187 END DO 188 188 ENDIF 189 189 54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) … … 202 202 IDELTA = 0 203 203 LPIECE = LWRAP 204 DO 56I=LPIECE+1,2,-1204 DO I=LPIECE+1,2,-1 205 205 IF (MESSG(NEXTC+I-1:NEXTC+I-1) == ' ') THEN 206 206 LPIECE = I-1 … … 208 208 GOTO 58 209 209 ENDIF 210 56 CONTINUE210 END DO 211 211 58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1) 212 212 NEXTC = NEXTC + LPIECE + IDELTA … … 223 223 C PRINT 224 224 C 225 DO 60I=1,NUNIT225 DO I=1,NUNIT 226 226 WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE) 227 60 CONTINUE227 END DO 228 228 C 229 229 IF (NEXTC <= LENMSG) GO TO 50
Note: See TracChangeset
for help on using the changeset viewer.