mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
33 lines
915 B
Fortran
33 lines
915 B
Fortran
*DECK SCLOSM
|
|
SUBROUTINE SCLOSM (IPAGE)
|
|
C***BEGIN PROLOGUE SCLOSM
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE ALL (SCLOSM-A)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C 1. UNLOAD, RELEASE, OR CLOSE UNIT NUMBER IPAGEF.
|
|
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 900402 Added TYPE section. (WRB)
|
|
C 900510 Convert XERRWV calls to XERMSG calls. (RWC)
|
|
C***END PROLOGUE SCLOSM
|
|
CHARACTER*8 XERN1
|
|
C
|
|
C***FIRST EXECUTABLE STATEMENT SCLOSM
|
|
IPAGEF=IPAGE
|
|
CLOSE(UNIT=IPAGEF,IOSTAT=IOS,ERR=100,STATUS='KEEP')
|
|
RETURN
|
|
C
|
|
100 WRITE (XERN1, '(I8)') IOS
|
|
CALL XERMSG ('SLATEC', 'SCLOSM',
|
|
* 'IN SPLP, CLOSE HAS ERROR FLAG = ' // XERN1, 100, 1)
|
|
RETURN
|
|
END
|