mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
44 lines
1.4 KiB
Fortran
44 lines
1.4 KiB
Fortran
*DECK SWRITP
|
|
SUBROUTINE SWRITP (IPAGE, LIST, RLIST, LPAGE, IREC)
|
|
C***BEGIN PROLOGUE SWRITP
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE 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 SPLP
|
|
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 SWRITP
|
|
INTEGER LIST(*)
|
|
REAL RLIST(*)
|
|
CHARACTER*8 XERN1, XERN2
|
|
C***FIRST EXECUTABLE STATEMENT SWRITP
|
|
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', 'SWRITP', 'IN SPLP, LGP = ' // XERN1 //
|
|
* ' IRECN = ' // XERN2, 100, 1)
|
|
RETURN
|
|
END
|