Trailing-Edge
-
PDP-10 Archives
-
k20v7d
-
uetp/lib/ifthel.for
There are 9 other files named ifthel.for in the archive. Click here to see a list.
PROGRAM IFTHEL
C COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985
C ALL RIGHTS RESERVED.
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
C ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
C OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
C TRANSFERRED.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
C AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
C CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
C August 1981
C CDM
C Simple program to test IF-THEN-ELSE statements.
C-100- Regular IF
A=24.5
IF (A.NE.24.5) TYPE 100,A
100 FORMAT(' ?Error 100. A='F', should =24.5')
C-200- IF-THEN
IOK=0
IF (A.EQ.24.5) THEN
IOK=1
ENDIF
IF (IOK.NE.1) TYPE 200,IOK
200 FORMAT(' ?Error 200. IOK='I4', should = 1')
C-300- IF-THEN-ELSE
JJ=5
IOK=0
IF (JJ.LT.4)
1 THEN
TYPE 310
310 FORMAT(' ?Error 310! Took THEN branch')
ELSE
IOK=1
ENDIF
IF (IOK.NE.1) TYPE 320
320 FORMAT(' ?Error 320. ELSE branch not taken')
C-400- IF-THEN-ELSE-IF
IF (JJ.LT.4) THEN
TYPE 400
400 FORMAT(' ?Error 400. THEN branch taken.')
ELSE IF (JJ.GT.4)
1 THEN
IOK=1
ELSE
TYPE 410
410 FORMAT(' ?Error 410. ELSE branch taken.')
ENDIF
IF (IOK.NE.1) TYPE 420
420 FORMAT(' ?Error 420. THEN branch not taken.')
END