C*********************************************************************** PROGRAM ENABLE C*********************************************************************** C 3-Jun-11 FAW PC/linux/unix distinctions gone; 32- vs 64-bit only C 1-Jun-11 EDG Correct GAMESS errors C 12-Aug-09 FAW Support G09; G98 and G94 gone; NBO_5GA/NBO_5GB gone; C VMS gone C 3-Jun-05 EDG Support 32-bit and 64-bit Unix; UNICOS gone C 4-Nov-04 FAW Modify for NBO 5.G (NBO 5.0 for G03) C 5-Jun-01 FAW Scan .SRC for tabs and other non-printable characters C 12-Nov-00 FAW NBO 5.0 update C 8-Nov-98 EDG Add G98 interface C 1-Jun-98 EDG Add NWChem interface C 31-May-98 EDG NBO 4.0 to NBO 5.0 update C 8-May-97 FAW Segmented source code (NBO_4MA.SRC, NBO_4MB.SRC) C to bypass compression C 3-May-96 EDG Add G94 interface, G90 no longer supported C 22-Feb-94 JKB Save as xxxnbo.f for Unix and UNICOS, xxxnbo.for for C VMS and DOS (also added); HND no longer supported C 11-Feb-93 EDG Add code for UTILTY, UNICOS, UNIX, and VMS C 29-Dec-92 JKB G88, G86, and G82 no longer supported C---------------------------- IMPLICIT REAL (A-H,O-Z) C PARAMETER(NID = 6, NOS = 2) C CHARACTER*11 SRCNAM CHARACTER*11 SRCNAMU,SRCNAML CHARACTER*80 STRING CHARACTER*10 NAMET(3),NAME CHARACTER*6 UTILTY,IDOS(4) CHARACTER*3 IDENT(NID),IDENL(NID),ANS CHARACTER*1 STAR,BLANK LOGICAL NEEDED C DATA SRCNAMU /'NBO_59.SRC'/ DATA SRCNAML /'nbo_59.src'/ DATA IDENT /'GEN','G09','G03','GMS','NWC','AMP'/ DATA IDENL /'gen','g09','g03','gms','nwc','amp'/ DATA IDOS /'UNIX32','UNIX64','PC-DOS','VMS '/ DATA NAMET /'xxxnbo.f','xxxnbo.for','xxxnbo.src'/ DATA UTILTY /'UTILTY'/ DATA STAR,BLANK /'*',' '/ C DATA LFNIN,LFNOUT,LFNSRC,LFNFOR/5,6,7,8/ DATA IERR/0/ C C ASSUME DOS VERSION SAME AS VMS FOR NOW: C c IDOS(3) = IDOS(4) C C WHICH OPERATING SYSTEM? C WRITE(LFNOUT,910) READ(LFNIN,*) IOS IF(IOS.LT.1.OR.IOS.GT.NOS) THEN STOP 'Illegal selection; program aborted' END IF IF(IOS.EQ.3.OR.IOS.EQ.4) THEN NAME = NAMET(2) ELSE NAME = NAMET(1) END IF C C WHICH VERSION OF THE NBO PROGRAM SHOULD BE ENABLED? C WRITE(LFNOUT,900) READ(LFNIN,*) ID IF(ID.GE.1.AND.ID.LE.NID) THEN IF(ID.EQ.5) NAME(1:10) = NAMET(3) NAME(1:3) = IDENL(ID) IF(ID.EQ.6) NAME = 'nwnbo.F' ELSE STOP 'Illegal selection; program aborted.' END IF C C ARE THE OPERATING SYSTEM DEPENDENT AND UTILITY ROUTINES NEEDED: C NEEDED = .TRUE. IF(ID.EQ.2) NEEDED = .FALSE. IF(ID.EQ.3) NEEDED = .FALSE. C C OK TO CONTINUE? C WRITE(LFNOUT,920) NAME READ(LFNIN,1000) ANS IF(ANS(1:1).EQ.'N'.OR.ANS(1:1).EQ.'n') THEN STOP 'ENABLE aborted by user request.' END IF C C OPEN THE INPUT NBO SOURCE FILE (OR SEGMENT) AND THE OUTPUT FORTRAN FILE: C OPEN(UNIT=LFNFOR, FILE=NAME, STATUS='UNKNOWN') ICNT = 0 IPTR = 0 IUTL = 0 IOSD = 0 2 SRCNAM=SRCNAMU IMSEG=0 OPEN(UNIT=LFNSRC, FILE=SRCNAM, STATUS='OLD', ERR=4) GOTO 10 4 SRCNAM=SRCNAML IMSEG=1 OPEN(UNIT=LFNSRC, FILE=SRCNAM, STATUS='OLD', ERR=800) C C READ SOURCE CODE, WRITING OUT LINES LABELLED WITH THE APPROPRIATE C IDENTIFIER: C 10 IPTR = IPTR + 1 READ(LFNSRC,1000,ERR=810,END=50) STRING C BAD CHARACTERS IN LINE IPTR? CALL CHKSTR(STRING,SRCNAM,IPTR,IERR) C C ENABLE LINES LABELLED BY 'XXXDRV' FOR VERSION 'IDENT(ID)': C C (FOR GMS, DO NOT REMOVING THE LEADING '*' WHEN THE SECOND C CHARACTER OF THE LINE IS NON-BLANK. WE ASSUME THIS '*' IS C ASSOCIATED WITH A GAMESS COMMENT LIKE '*UNX' THAT WILL BE C DEALT WITH DURING THE GAMESS ACTIVATION STEP.) C DO 20 I = 1,NID IF(STRING(73:75).EQ.IDENT(I)) THEN IF(I.EQ.ID) THEN IF(IDENT(ID).EQ.'GMS') THEN IF(STRING(1:1).EQ.STAR.AND.STRING(2:2).EQ.BLANK) THEN STRING(1:1) = BLANK END IF ELSE IF(STRING(1:1).EQ.STAR) THEN STRING(1:1) = BLANK END IF NL = LENNB(STRING(1:72)) GOTO 40 ELSE GOTO 10 END IF END IF 20 CONTINUE C C ENABLE LINES LABELLED BY 'UTILTY' IF NEEDED: C IF(STRING(73:78).EQ.UTILTY) THEN IF(.NOT.NEEDED) GOTO 10 IF(STRING(1:1).EQ.STAR) STRING(1:1) = BLANK NL = LENNB(STRING(1:72)) IUTL = IUTL + 1 GOTO 40 END IF C C ENABLE OPERATING SYSTEM DEPENDENT CODE IF NEEDED: C DO 30 I = 1,NOS IF(STRING(73:78).EQ.IDOS(I)) THEN IF(.NOT.NEEDED) GOTO 10 IF(I.EQ.IOS) THEN IF(STRING(1:1).EQ.STAR) STRING(1:1) = BLANK NL = LENNB(STRING(1:72)) IOSD = IOSD + 1 GOTO 40 ELSE GOTO 10 END IF END IF 30 CONTINUE C C WRITE THIS LINE TO THE FORTRAN FILE: C NL = LENNB(STRING(1:80)) 40 IF(NL.GT.0) THEN WRITE(LFNFOR,950) (STRING(K:K),K=1,NL) ICNT = ICNT + 1 END IF GOTO 10 C C FINISH UP: C 50 CONTINUE C ERROR CONDITION? WRITE EMPTY FILE IF(IERR.GT.0) THEN WRITE(LFNOUT,1100) IERR 1100 FORMAT(1X,'*** ',I6,' non-printable characters detected.') 1200 FORMAT(1X) REWIND(LFNFOR) WRITE(LFNFOR,1200) CLOSE(LFNFOR) WRITE(LFNOUT,1300) 1300 FORMAT(1X,'(Probable cause: failure to convert file from ', + 1X,'DOS-format CD to linux-format text file for this OS)') STOP 'Illegal characters in source file; program aborted.' ENDIF WRITE(LFNOUT,960) SRCNAM,IPTR-1,ICNT,NAME,IUTL,IOSD CLOSE(LFNSRC) CLOSE(LFNFOR) STOP C 800 WRITE(LFNOUT,930) SRCNAM STOP C 810 WRITE(LFNOUT,940) SRCNAM,IPTR STOP C 900 FORMAT(/,1X,'Currently supported NBO versions:',//, + 1X,'(1) GEN GENNBO (standalone)',/, + 1X,'(2) G09 Gaussian 09',/, + 1X,'(3) G03 Gaussian 03',/, + 1X,'(4) GMS GAMESS',/, + 1X,'(5) NWC NWChem',/, + 1X,'(6) AM1 MOPAC or AMPAC',//, + 1X,'NBO Program version to enable (1-6)? ',$) 910 FORMAT(/,1X,'Currently supported environments:',//, + 1X,'(1) 32-bit integers',/, + 1X,'(2) 64-bit integers',/, c + 1X,'(3) DOS PC DOS',//, c + 1X,'(4) VMS VAX VMS',//, + 1X,'Environment to enable (1-3)? ',$) 920 FORMAT(/1X,'Module ',A10,' will be created;', + ' OK to proceed [Y]/N? ',$) 930 FORMAT(1X,'NBO source code (',A11,') is not found.') 940 FORMAT(1X,'Error reading from ',A11,' at line ',I5,'.') 950 FORMAT(80A1) 960 FORMAT(/1X,'NBO source (',A11,') contains ',I5, + ' lines of code.', + /1X,'A total of ',I5,' lines were written to ',A10,/3X, + 'including ',I3,' utility and ',I2,' operating system ', + 'dependent lines.') 1000 FORMAT(A) END C***************************************************************************** FUNCTION LENNB(STRING) C***************************************************************************** IMPLICIT REAL (A-H,O-Z) CHARACTER*(*) STRING C C FIND LENGTH OF NON-BLANK LEFT SUB-STRING OF STRING: C LENNB = LEN(STRING) IF(LENNB.LE.0) THEN RETURN ELSE IF (LENNB.GT.511) THEN LENNB = 511 END IF NL = LENNB DO 10 I = NL,1,-1 IF(ICHAR(STRING(I:I)).EQ.32) GOTO 10 LENNB = I RETURN 10 CONTINUE LENNB = 0 RETURN END C***************************************************************************** SUBROUTINE CHKSTR(STRING,SRCNAM,IPTR,IERR) C***************************************************************************** IMPLICIT REAL (A-H,O-Z) CHARACTER STRING*(*),C*1,SRCNAM*(*),STARS*39 DATA STARS/'***************************************'/ NS = LENNB(STRING) IERR0 = IERR DO I = 1,NS C = STRING(I:I) IC = ICHAR(C) IF(IC.GE.32.AND.IC.LE.126) THEN CONTINUE ELSE IERR = IERR + 1 WRITE(6,1000) C,IC,I ENDIF ENDDO IF(IERR.NE.IERR0) THEN WRITE(6,1100) IPTR,SRCNAM WRITE(6,1200) (STRING(K:K),K=1,NS) WRITE(6,1300) STARS,STARS ENDIF RETURN 1000 FORMAT(2X,'Illegal character (',a1,', ASCII code =',I4, + ') at position',I3) 1100 FORMAT(1X,'FATAL ERROR IN LINE',I6,' OF .SRC FILE ',A11) 1200 FORMAT(1X,80A1) 1300 FORMAT(1X,A39,A39) END C*****************************************************************************