Now GNU G77 compliant

This commit is contained in:
cvs
2000-10-20 14:22:35 +00:00
parent ca2a062492
commit 9f2030d053
6 changed files with 16 additions and 12 deletions

View File

@ -714,7 +714,7 @@ C--------------------------------------------------------------------
$ ' (E) Exit.') $ ' (E) Exit.')
12000 FORMAT ( ' Command (L,D,R,A,F,E) ',$) 12000 FORMAT ( ' Command (L,D,R,A,F,E) ',$)
13000 FORMAT (' N Theta Omega Chi Phi Int'/) 13000 FORMAT (' N Theta Omega Chi Phi Int'/)
14000 FORMAT (' 'I2,1X,4(F8.2),2X,I8,5X,A) 14000 FORMAT (' ',I2,1X,4(F8.2),2X,I8,5X,A)
15000 FORMAT (' There are no reflections in the list') 15000 FORMAT (' There are no reflections in the list')
16000 FORMAT (' Input reflection number: ') 16000 FORMAT (' Input reflection number: ')
17000 FORMAT (' Reflection ',I2,' marked unused') 17000 FORMAT (' Reflection ',I2,' marked unused')
@ -725,7 +725,3 @@ C--------------------------------------------------------------------
21000 FORMAT (A) 21000 FORMAT (A)
22000 FORMAT (I4,' reflections have been read from ',A) 22000 FORMAT (I4,' reflections have been read from ',A)
END END

View File

@ -16,6 +16,9 @@ C-----------------------------------------------------------------------
CHARACTER ANGLE(4)*6 CHARACTER ANGLE(4)*6
DATA ANGLE/'2theta','Omega','Chi','PH'/ DATA ANGLE/'2theta','Omega','Chi','PH'/
INTEGER IRUPT INTEGER IRUPT
C
external range ! Prevent use of intrinsic function under GNU G77
C
NATT = 0 NATT = 0
C------- a debug flag! Set to 0 for no debug output C------- a debug flag! Set to 0 for no debug output
IDEBUG = 1 IDEBUG = 1
@ -79,7 +82,7 @@ C-----------------------------------------------------------------------
CALL CCTIME (PRESET,COUNT) CALL CCTIME (PRESET,COUNT)
IF(IDEBUG .EQ. 1)THEN IF(IDEBUG .EQ. 1)THEN
WRITE(COUT,20000),AN(1),AN(2),AN(3),AN(4),COUNT WRITE(COUT,20000),AN(1),AN(2),AN(3),AN(4),COUNT
20000 FORMAT('TH = ',F8.2,' OM = ',F8.2,' CH = ',F8.2,' PH = ' F8.2, 20000 FORMAT('TH = ',F8.2,' OM = ',F8.2,' CH = ',F8.2,' PH = ', F8.2,
& ' CTS = ', F8.2) & ' CTS = ', F8.2)
ENDIF ENDIF
CALL KORQ(IRUPT) CALL KORQ(IRUPT)
@ -292,6 +295,7 @@ C-----------------------------------------------------------------------
11000 FORMAT (' Alignment Failure on ',A,'. NBOT, NTOP',2I4,' MAX',I6) 11000 FORMAT (' Alignment Failure on ',A,'. NBOT, NTOP',2I4,' MAX',I6)
12000 FORMAT (3I6,/,(10F10.4)) 12000 FORMAT (3I6,/,(10F10.4))
END END
C
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Subroutine to do a fine (1) or coarse (0) centreing on a specified C Subroutine to do a fine (1) or coarse (0) centreing on a specified
C circle for the CAD4 using the routine GENSCN. C circle for the CAD4 using the routine GENSCN.
@ -435,6 +439,7 @@ C write (LPT,99998) ki,theta,omega,chi,phi
C99998 format (' After ',a,2x,4f8.3) C99998 format (' After ',a,2x,4f8.3)
RETURN RETURN
END END
C
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Subroutine to find the centroid of the ACOUNT distribution C Subroutine to find the centroid of the ACOUNT distribution
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
@ -500,5 +505,3 @@ C ENDIF
C99999 format (' imax,max,nbot,ntop',A,4i6/(10f7.0)) C99999 format (' imax,max,nbot,ntop',A,4i6/(10f7.0))
RETURN RETURN
END END

View File

@ -195,7 +195,7 @@ C-----------------------------------------------------------------------
C Order the threefold axes on the angle with the plane C Order the threefold axes on the angle with the plane
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
IF (N3 - N2 .GE. 2) THEN IF (N3 - N2 .GE. 2) THEN
DO 240 I = N3,N3 - 1 DO 240 I = N3,N3 - 1,-1
ANMAX = AANG(I) ANMAX = AANG(I)
MAX = I MAX = I
DO 230 J = I + 1,N3 DO 230 J = I + 1,N3

View File

@ -96,7 +96,12 @@ C-----------------------------------------------------------------------
WORK = ACTUAL WORK = ACTUAL
IF (MNCODE .NE. 'VAXVMS') then IF (MNCODE .NE. 'VAXVMS') then
IF (MNCODE .EQ. 'PCMSDS') THEN IF (MNCODE .EQ. 'PCMSDS') THEN
IF (ACTUAL .EQ. 'GROUPS') WORK = '\NRCVAX\GROUPS.DAT' c
c Avoid a compiler problem with '\'. char(92) is '\'!
c
CCC IF (ACTUAL .EQ. 'GROUPS') WORK = '\NRCVAX\GROUPS.DAT'
IF (ACTUAL .EQ. 'GROUPS')
+ WORK = char(92) // 'NRCVAX' // char(92) // 'GROUPS.DAT'
C ELSE C ELSE
C IF (ACTUAL .EQ. 'GROUPS') C IF (ACTUAL .EQ. 'GROUPS')
C $ CALL GETENV (ACTUAL(1:LENAME),WORK) C $ CALL GETENV (ACTUAL(1:LENAME),WORK)

View File

@ -214,7 +214,7 @@ C-----------------------------------------------------------------------
ELSE IF (IFREE(1) .EQ. 2) THEN ELSE IF (IFREE(1) .EQ. 2) THEN
IF (STRING(6:9) .EQ. ' or ') THEN IF (STRING(6:9) .EQ. ' or ') THEN
WRITE (COUT,16100) STRING WRITE (COUT,16100) STRING
16100 FORMAT (' The space-group symbol CANNOT be both 'A/ 16100 FORMAT (' The space-group symbol CANNOT be both ',A/
$ ' Please type the correct symbol ',$) $ ' Please type the correct symbol ',$)
CALL ALFNUM (STRING) CALL ALFNUM (STRING)
ENDIF ENDIF

View File

@ -203,7 +203,7 @@ C-----------------------------------------------------------------------
$ ' Alf* ',F7.3,' Bet* ',F7.3,' Gam* ',F7.3) $ ' Alf* ',F7.3,' Bet* ',F7.3,' Gam* ',F7.3)
19000 FORMAT (' a ',F8.5,' b ',F8.5,' c ',F8.5, 19000 FORMAT (' a ',F8.5,' b ',F8.5,' c ',F8.5,
$ ' Alf ',F7.3,' Bet ',F7.3,' Gam ',F7.3/) $ ' Alf ',F7.3,' Bet ',F7.3,' Gam ',F7.3/)
20000 FORMAT (' Type h,k,l,Psi (End) '$) 20000 FORMAT (' Type h,k,l,Psi (End) ',$)
22000 FORMAT (3I4,' Psi ',F7.3,' Rotation not possible') 22000 FORMAT (3I4,' Psi ',F7.3,' Rotation not possible')
22100 FORMAT (3F8.3,' Psi ',F7.3,' Rotation not possible') 22100 FORMAT (3F8.3,' Psi ',F7.3,' Rotation not possible')
23000 FORMAT (3I4,5F8.3) 23000 FORMAT (3I4,5F8.3)