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