Google
 

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