nbo
|
0origin,
README,
ch3nh2.arc,
enable.for,
g90.man,
gennbo.for,
junk,
nbo.man,
nbo.src,
readme.g90,
readme.nbo
|
|
|
C******************************************************************************
PROGRAM ENABLE
C******************************************************************************
IMPLICIT REAL (A-H,O-Z)
C
PARAMETER(NID = 8)
C
CHARACTER*80 STRING
CHARACTER*10 NAME
CHARACTER*3 ID,IDENT(NID)
CHARACTER*1 STAR,BLANK
C
DATA IDENT /'GEN','AMP','GMS','HND','G82','G86','G88','G90'/
DATA NAME /'XXXNBO.FOR'/
DATA STAR,BLANK /'*',' '/
C
DATA LFNIN,LFNOUT,LFNSRC,LFNFOR/5,6,7,8/
C
C WHICH VERSION OF THE NBO PROGRAM SHOULD BE ENABLE?
C
10 WRITE(LFNOUT,900)
READ(LFNIN,1000) ID
C
C MAKE SURE THIS IDENTIFIER IS RECOGNIZED:
C
IFLG = 0
DO 20 I = 1,NID
IF(IDENT(I).EQ.ID) IFLG = I
20 CONTINUE
IF(IFLG.EQ.0) GOTO 10
C
C OPEN THE INPUT NBO SOURCE FILE AND THE OUTPUT FORTRAN FILE:
C
OPEN(UNIT=LFNSRC, FILE='nbo.src', STATUS='OLD', ERR=800)
C
NAME(1:3) = ID
OPEN(UNIT=LFNFOR, FILE=NAME, STATUS='NEW')
C
C READ SOURCE CODE, WRITING OUT LINES LABELLED WITH THE APPROPRIATE
C IDENTIFIER:
C
ICNT = 0
30 ICNT = ICNT + 1
READ(LFNSRC,1010,ERR=810,END=50) STRING
C
C IF THE FIRST CHARACTER OF A LINE IS A '*' AND THE LINE IS LABELLED
C BY 'ID', REMOVE THE '*' (COMMENT):
C
IF(STRING(1:1).EQ.STAR) THEN
IF(STRING(73:75).EQ.ID) THEN
STRING(1:1) = BLANK
C
C IF THE FIRST CHARACTER IS A '*' AND THE LABELLED IS UNRECOGNIZED,
C HALT PROGRAM EXECUTION:
C
ELSE
JFLG = 0
DO 40 I = 1,NID
IF(STRING(73:75).EQ.IDENT(I)) JFLG = I
40 CONTINUE
IF(JFLG.EQ.0) GOTO 820
END IF
END IF
C
C WRITE THIS LINE TO THE FORTRAN FILE:
C
WRITE(LFNFOR,940) STRING
GOTO 30
C
C FINISH UP:
C
50 ICNT = ICNT - 1
WRITE(LFNOUT,950) ICNT,NAME
CLOSE(LFNSRC)
CLOSE(LFNFOR)
CALL EXIT
C
800 WRITE(LFNOUT,910)
STOP
C
810 WRITE(LFNOUT,920) ICNT
STOP
C
820 WRITE(LFNOUT,930) STRING(73:75),ICNT
STOP
C
900 FORMAT(1X,'NBO Program version to enable? ')
910 FORMAT(1X,'NBO source code (NBO.SRC) is not found.')
920 FORMAT(1X,'Error reading from NBO.SRC as line ',I5,'.')
930 FORMAT(1X,'Unknown version label (',A3,') at line ',I5,
+ ' for NBO.SRC.')
940 FORMAT(A80)
950 FORMAT(1X,I5,' lines written to ',A10,'.')
1000 FORMAT(A3)
1010 FORMAT(A80)
END
|