Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - namlst.for
There are 9 other files named namlst.for in the archive. Click here to see a list.
	PROGRAM NAMLST

! This software is furnished under a license and may only be used
! or copied in accordance with the terms of such license.

! Copyright (C) Digital Equipment Corporation 1982, 1983

!	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