| 1234567891011121314151617181920212223242526272829303132333435363738394041424344 |
- *DECK DWRITP
- SUBROUTINE DWRITP (IPAGE, LIST, RLIST, LPAGE, IREC)
- C***BEGIN PROLOGUE DWRITP
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to DSPLP
- C***LIBRARY SLATEC
- C***TYPE DOUBLE PRECISION (SWRITP-S, DWRITP-D)
- C***AUTHOR (UNKNOWN)
- C***DESCRIPTION
- C
- C WRITE RECORD NUMBER IRECN, OF LENGTH LPG, FROM STORAGE
- C ARRAY LIST(*) ONTO UNIT NUMBER IPAGEF.
- C WRITE RECORD NUMBER IRECN+1, OF LENGTH LPG, ONTO UNIT
- C NUMBER IPAGEF FROM THE STORAGE ARRAY RLIST(*).
- C
- C TO CHANGE THIS PROGRAM UNIT TO DOUBLE PRECISION CHANGE
- C /REAL (12 BLANKS)/ TO /DOUBLE PRECISION/.
- C
- C***SEE ALSO DSPLP
- C***ROUTINES CALLED XERMSG
- C***REVISION HISTORY (YYMMDD)
- C 811215 DATE WRITTEN
- C 890605 Corrected references to XERRWV. (WRB)
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900328 Added TYPE section. (WRB)
- C 900510 Convert XERRWV calls to XERMSG calls. (RWC)
- C***END PROLOGUE DWRITP
- INTEGER LIST(*)
- DOUBLE PRECISION RLIST(*)
- CHARACTER*8 XERN1, XERN2
- C***FIRST EXECUTABLE STATEMENT DWRITP
- IPAGEF=IPAGE
- LPG =LPAGE
- IRECN =IREC
- WRITE(IPAGEF,REC=IRECN,ERR=100)(LIST(I),I=1,LPG)
- WRITE(IPAGEF,REC=IRECN+1,ERR=100)(RLIST(I),I=1,LPG)
- RETURN
- C
- 100 WRITE (XERN1, '(I8)') LPG
- WRITE (XERN2, '(I8)') IRECN
- CALL XERMSG ('SLATEC', 'DWRITP', 'IN DSPLP, LGP = ' // XERN1 //
- * ' IRECN = ' // XERN2, 100, 1)
- RETURN
- END
|
