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