Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-test/if.for
There are 11 other files named if.for in the archive. Click here to see a list.
	PROGRAM IF

!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!	Version 7	IF.FOR

!	Basic testing of IF statement.

	DOUBLE PRECISION D
	LOGICAL TORF,LOG

!	If statements with relationals .LT.,.LE.,.EQ.,.GE.,.GT.,
!	.OR.,.AND. used.

	M=3
50	IF (M.EQ.3) GOTO 60
	TYPE 55
55	FORMAT(' ?Error line 50, GOTO not taken.')
60	CONTINUE

	TORF=.FALSE.
	I=4; X=3.3
100	IF ((I.EQ.4).AND.(X.LE.3.4)) TORF=.TRUE.
	IF (TORF.NE..TRUE.) TYPE 110
110	FORMAT(' ?Error line 100. TORF=.FALSE., should = .TRUE.')

	QQ=66.5; D=9.99998889999; N=1; P=3
200	IF (D.GT.6D0 .OR. N.NE.P) QQ=77.5
	IF (QQ.EQ.66.5) TYPE 210
	IF (QQ.NE.77.5) TYPE 220,QQ
210	FORMAT(' ?Error line 200. QQ = 66.5, should = 77.5')
220	FORMAT(' ?Error line 200. QQ = 'F', should = 77.5')

	RESULT=0		!IF should fail
	D=10; P=1; M=P; TORF=.FALSE.; J=-1
300	IF (D.GE.11 .OR. P.NE.M .OR.(TORF.AND.J.LT.M)) RESULT=10
	IF (RESULT.NE.0) TYPE 310,RESULT
310	FORMAT(' ?Error line 300. RESULT = 'F', should = 0')

!	Arithmetic IF statement

	I=3; D=2
400	IF (I-(D+1)) 410,420,430
410	CONTINUE
430	CONTINUE
	TYPE 435
435	FORMAT(' ?Error IF 400.  Wrong branch taken')
420	CONTINUE

!	Logical Two-branch IF statement

	LOG=.TRUE.
500	IF (.NOT. LOG) 510,520
510	TYPE 515
515	FORMAT(' ?Error 510 branch taken, statement evaluated'
	1 ' as true.')
520	CONTINUE

	STOP
	END