Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	PROGRAM NAMLST

!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1982, 1986
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!	SRM
!	April 1982
!
! Revision history
!
!16-April-82	SRM	Added tests for numeric data in NAMELISTS

! Simple test of NAMELIST IO
!
	DOUBLE PRECISION D,DA(10)
	COMPLEX CX, CXA(2,3)
	REAL RA(2,4)
	CHARACTER C*3, C1(3)*7
	CHARACTER C2*2, C3(2)*3
	CHARACTER LINE(3)*30

	NAMELIST /NAM1/ C2, C3
	NAMELIST /NAM/ C1, C
	NAMELIST /NAM2/ I,R,D,CX, RA
	NAMELIST /NAM3/ DA,CXA
!
! Test NAMELIST Output
	C2='12'
	C3(1) = 'ABC'
	C3(2) = 'DEF'
100	OPEN (UNIT=1, DEVICE='DSK:', FILE='NAM1.DAT')
	WRITE (UNIT=1, FMT=NAM1)
	CLOSE(UNIT=1)
! Now read in the RECORD that was written and check its contents
200	OPEN( UNIT=1, FILE='NAM1.DAT', DEVICE='DSK:')
	READ ( UNIT=1, FMT=10 ) LINE(1), LINE(2), LINE(3)
10	FORMAT( A6 / A27 / A5 )
	IF (LINE(1) .NE. ' $NAM1' )
	1 TYPE *, ' ?First line in NAM1.DAT was ', LINE(1) 

	IF (LINE(2) .NE. ' C2= ''12'', C3= ''ABC'', ''DEF''')
	1 TYPE *, ' ?Second line in NAM1.DAT was ', LINE(2)

	IF (LINE(3) .NE. ' $END')
	1 TYPE *, '?Third line in NAM1.DAT was ', LINE(3)


	CLOSE(UNIT=1)

!
! Test NAMELIST Input
300	OPEN (UNIT=1, DEVICE='DSK:', FILE='NAMLST.DAT')
	READ (UNIT=1, FMT=NAM)

	IF (C .NE. '@#$') 
	1 TYPE *, ' ? NAMELIST input of C failed.',
	2 ' C = ', C

	IF ( C1(1) .NE. '1234567' ) 
	1 TYPE *, ' ? NAMELIST input of C1(1) failed.',
	2 '  C1(1) = ', C1(1)

	IF (C1(2) .NE. '12     ')
	1 TYPE *, ' ? NAMELIST input of C1(2) failed.',
	2 ' C1(2) = ', C1(2)

	IF (C1(3) .NE. 'ABCDEFG')
	1 TYPE *, ' ? NAMELIST input of C1(3) failed.',
	2 ' C1(3) = ', C1(3)

	READ( UNIT=1, FMT=NAM2 )

	IF (I .NE. 1)
	1 TYPE *, ' ? NAMELIST input of I failed.',
	2 ' I = ', I

	IF (R .NE. 2)
	1 TYPE *, ' ? NAMELIST input of R failed.',
	2 ' R = ', R

	IF (RA(1,1) .NE. 1)
	1 TYPE *, ' ? NAMELIST input of RA(1,1) failed.',
	2 ' RA(1,1) = ', RA(1,1)

	IF (RA(1,2) .NE. 3)
	1 TYPE *, ' ? NAMELIST input of RA(1,2) failed.',
	2 ' RA(1,2) = ', RA(1,2)

	IF (D .NE. 3)
	1 TYPE *, ' ? NAMELIST input of D failed.',
	2 ' D = ', D

	IF (CX .NE. (4,5))
	1 TYPE *, ' ? NAMELIST input of C failed.',
	2 ' CX = ', CX

	READ( UNIT=1, FMT=NAM3 )

	IF (DA(10) .NE. 10)
	1 TYPE *, ' ? NAMELIST input of DA(10) failed.',
	2 ' DA(10) = ', DA(10)

	IF (CXA(2,2) .NE. (2,2))
	1 TYPE *, ' ? NAMELIST input of CXA(2,2) failed.',
	2 ' CXA(2,2) = ', CXA(2,2)
	END