SUBROUTINE READER(GEO, NAT, NA, NB, NC, IOPT, + LR,FVECT,LF,VIBVEC,LV,CVECT, LC, + CBETA,LCB,BONDS,LB, IR, IOERR) C C Notice of Public Domain nature of this Program C C 'This computer program is a work of the United States C Government and as such is not subject to protection by C copyright (17 U.S.C. # 105.) Any person who fraudulently C places a copyright notice or does any other act contrary C to the provisions of 17 U.S. Code 506(c) shall be subject C to the penalties provided therein. This notice shall not C be altered or removed from this software and is to be on C all reproductions.' C IMPLICIT REAL (A-H,O-Z) INCLUDE 'SIZES' REAL FVECT, VIBVEC, CVECT, CBETA INTEGER OFFSET DIMENSION RIJ(3,NUMATM), FVECT(3*NUMATM, 3*NUMATM), NAT( NUMATM), . NA( NUMATM) , NB( NUMATM), NC( NUMATM), GEO( 3, NUMATM), . VIBVEC(3*NUMATM, 3*NUMATM), CVECT(1000), CBETA(1000), . BONDS( MPACK ), IA( NUMATM), IB( NUMATM), IC(NUMATM) CHARACTER*3 FTYPE CHARACTER*80 KEYWRD, KOMENT, TITLE LOGICAL LR,LF,LV,LC,LCB,LB, ERROR, FIRST, NEWDAT, FINGEO LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /FINFO/ DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE, ICHARG COMMON /FINFOC/ FTYPE * * DELTAH := HEAT OF FORMATION * RC := REACTION COORDINATE VALUE * GRAD := GRADIENT * RCGRAD := GRADIENT OF REACTION COORDINATE * VIP := VERTICAL IONISATION VALUE (KOOPMAN'S THEOREM) * ICHARG := CHARGE ON SYSTEM COMMON /SYMTRY/ ISYM( 10, NUMATM) COMMON /DATUMS/ NVAR, NUMAT, NORBS, NELECS, NALPHA, NBETA, NCLOSE, + NOPEN, NATOMS COMMON /KEYS/ KEYWRD, KOMENT, TITLE COMMON /FILEST/ FIRST COMMON /ARRAYS/ EIGS(MAXORB), EIGB(MAXORB), LOC(2,MAXPAR), + NFIRST(MAXORB), NLAST(MAXORB), + EVIBS(MAXPAR*3), + COORD(3,NUMATM), FEIGS(3*MAXPAR), Q(NUMATM), AMS(NUMATM) ************************************************************************ * GENERAL PURPOSE READER. THE ORDER OF PHARSING IS * 1: SINGLE WORDS, E.G. MNDO, UHF, NLLSQ, ETC * 2: SINGLE DATA, E.G. , HEAT OF FORMATION, CORE-CORE REPULSION. * 3: SMALL DATA, E.G. COORDINATES, SPIN POPULATIONS. * 4: * ************************************************************************ CHARACTER WORDS*7, DATUM*7, SMALL*7, LARGE*14, DUMC*1, + ELEM*2, CHARAC*1, SOPT(3)*3, LINE*80, LINE2*80 DIMENSION WORDS(30), DATUM(30), SMALL(30), LARGE(30) DIMENSION GOTW(30), GOTD(30), GOTS(30), GOTL(30) LOGICAL GOTW,GOTD,GOTS,GOTL DIMENSION VALD(30) DIMENSION IOPT(3, NUMATM) CHARACTER ATSYMB*6 COMMON /ATSYMB/ ATSYMB( 200) COMMON /FORGEO/ FORORE( 3, NUMATM), IEFOR( NUMATM) DATA GOTW,GOTD,GOTS,GOTL/120*.FALSE./ DATA WORDS/ ' MNDO ', ' UHF ', ' NLLSQ ', ' AM1 ','MINDO/3', + ' 1SCF ', 'SIGMA ', 'BIRADIC', ' C.I. ','EXCITED', + ' FORCE ', 'PRECISE', 'SADDLE ', ' SIGMA ','SYMMETR', + ' THERMO', 'TRIPLET', 13*'XXXXXXX'/ DATA DATUM/'PHA ELE','TA ELE','RADIENT','HEAT: ','VERSION', + 'NAL HEA','NIC ENE','ORE REP','ION POT','ION TIM', + 'SCF CAL',' ',' ',' OF SIN','AT OF F', + 'BLY OCC', 'LED LEV', 'LAR WEI', 'ERO POI', + 11*'XXXXXXX'/ DATA SMALL/'IST ANG','IAN COO','NAL GEO','0DIPOLE','RON POP', + 'GENVALU','OLE CON','TER DEP', 22*'XXXXXXX'/ DATA LARGE/'NTERATOMIC DIS','ALPHA EIGENVEC', . 'BETA EIGENVECT','L COORDINATE A', . 'D COORDINATE A','BOND ORDERS AN', . 'PTION OF VIBRA','QUENCIES, REDU', . ' FORCE MATRIX ','DINATE DERIVAT', . 'ATION OF MOLEC','DYNES/ANGSTROM', . 'LATED THERMODY','NCIPAL MOMENTS', . 'STIMATED TIME ','RATIONS, SHOUL','ARE THE TRANSLA', . 'ALISATION VALU',' EIGENVECTORS', + 11*'XXXXXXX'/ * * LET'S CLEAR THE VARIABLES INCASE WE ARE RE-ENTERING * NVAR = 0 NUMAT = 0 NORBS = 0 NELECS = 0 NALPHA = 0 NBETA = 0 NCLOSE = 0 NOPEN = 0 NATOMS = 0 RIJ( 1, 1) = 0 FVECT(1,1) = 0 VIBVEC(1,1) = 0 CVECT(1) = 0 CBETA(1) = 0 BONDS(1) = 0 EIGS(1)=0 EIGB(1) = 0 LOC(1,1) = 0 NAT(1) = 0 NFIRST(1) = 0 NLAST(1) = 0 EVIBS(1) = 0 FEIGS(1) = 0 Q(1) = 0 AMS(1) = 0 MODVIB = 0 * * CLEAR VARIABLES FOR RE-ENTRY CASE * DELTAH = 0.0D0 RC = 0.0D0 GRAD = 0.0D0 RCGRAD = 0.0D0 VIP = 0.0D0 DIPOLE = 0.0D0 C? ICHARG = 0 * LR=.FALSE. LF=.FALSE. LV=.FALSE. LC=.FALSE. LCB=.FALSE. LB=.FALSE. NEWDAT = .FALSE. ISP1 = NUMELE('-') ISP2 = NUMELE('--') ISP3 = NUMELE('+') ISP4 = NUMELE('++') DO 10 NWORDS=1,29 10 IF(WORDS(NWORDS+1).EQ.'XXXXXXX') GOTO 11 11 DO 12 NDATUM=1,29 12 IF(DATUM(NDATUM+1).EQ.'XXXXXXX') GOTO 13 13 DO 14 NSMALL=1,29 14 IF(SMALL(NSMALL+1).EQ.'XXXXXXX') GOTO 15 15 DO 16 NLARGE=1,29 16 IF(LARGE(NLARGE+1).EQ.'XXXXXXX') GOTO 17 17 CONTINUE KEYWRD = ' ' * * FIRST, READ IN A LINE OF TEXT. * IF (DEBUGI) THEN CALL DEBUGR(' LINES NOT UNDERSTOOD') ENDIF NKEY=2 1000 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, '**********') .GT. 0) THEN IF(DEBUGI) CALL DEBUGR('READER: START BANNER') 1001 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, '**********') .GT. 0) THEN IF(DEBUGI) CALL DEBUGR('READER: END BANNER') * HERE IS BOTTOM OF THE BANNER SECTION GOTO 1000 ELSEIF ( INDEX( LINE, ' REACTION COORDINATE = ') .GT. 0) THEN FIRST = .FALSE. RETURN ELSEIF ( INDEX( LINE, 'CHARGE ON SYSTEM') .GT. 0) THEN CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) ICHARG = READA( LINE, 1, ERROR) GOTO 1001 ELSEIF ( INDEX( LINE, 'TRIX TO BE PRINTED') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'DISTANCES NOT TO BE P') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'COORDINATES NOT TO BE') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'OVERRIDE INTERATOMIC ') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'DUMP=N') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'DAMPING FACT') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'ITERATIONS FOR SCF') .GT. 0) THEN GOTO 1001 ELSEIF ( INDEX( LINE, 'CALCULATION RESULTS') .GT. 0) THEN FIRST = .TRUE. IF (DEBUGI) CALL DEBUGR( 'IN READER: FIRST BEING SET TRUE.') GOTO 1001 ELSEIF ( INDEX( LINE, ' VERSION ') .GT. 0) THEN VERMOP = READA( LINE, INDEX( LINE, 'VERSION')+7, ERROR) IF (DEBUGI) THEN WRITE (*,'('' READER: VERSION OF MOPAC IS '',F4.2)')VERMOP ENDIF GOTO 1001 ELSE GOTO 1001 ENDIF ELSEIF ( INDEX( LINE, ' REACTION COORDINATE ') .GT. 0) THEN CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) IF ( INDEX( LINE, '=') .GT. 0) CALL POPARG( LINE, LINE) RC = READA( LINE, 1, ERROR) ELSEIF ( INDEX( LINE, ' REACTION GRADIENT ') .GT. 0) THEN CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) RCGRAD = READA( LINE, 1, ERROR) GOTO 1000 ELSEIF ( INDEX( LINE, 'TIME FOR DERIVATIVES') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'SYMMETRY WAS SPECIFIED, B') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'DEFAULT TIME OF') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX(LINE, 'CYCLE:') .GT. 0) THEN CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) GRAD = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) DELTAH = READA( LINE, 1, ERROR) GOTO 1000 ELSEIF ( INDEX(LINE, 'STEP:') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX(LINE, '- CALCULATION RES') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX(LINE, '- A TIME OF') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX(LINE, 'THE SYSTEM IS A ') .GT. 0) THEN IF ( INDEX( LINE, ' POLYMER') .GT. 0) THEN MODVIB = 3 ENDIF GOTO 1000 ELSEIF ( INDEX(LINE, 'UNIT CELL TRAN') .GT. 0) THEN READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE GOTO 1000 ELSEIF ( INDEX( LINE, ' A TIME OF ') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, ' FIRST DERIVATIVES') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'HERBERTS TEST') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'ST ON X SATISFI') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, ' TIME DEFINED FOR ') .GT. 0) THEN GOTO 1000 ELSEIF ( INDEX( LINE, ' TIME UP ') .GT. 0) THEN CALL DEBUGR( 'YOUR CALCULATION DID NOT FINISH.') CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '// . 'PARTIALLY OPTIMIZED GEOMETRY...') READ (*, '(A)') LINE 8000 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, 'CURRENT VALUE OF HEAT OF F') . .NE. 0) THEN LINE2 = LINE( INDEX( LINE, '=')+1: ) CALL LCLEAN( LINE2, LINE, .TRUE.) DELTAH = READA( LINE, 1, ERROR) IF ( ERROR ) DELTAH = 0.0D0 ELSEIF( INDEX( LINE, 'CURRENT VALUES OF GEOMETRIC V') . .NE. 0) THEN READ (*, '(A)') LINE READ (*, '(A)') LINE ELSE GOTO 8000 ENDIF CALL GEORD( IR, NATOMS, NAT, GEO, NA, NB, NC, IA, IB, IC, . ISYM, IOERR) IF ( IOERR .NE. 0 ) GOTO 999 DO 8100 I=1, NATOMS C? WRITE (*,*) NAT(I),GEO(1,I),IA(I),GEO(2,I),IB(I), C? . GEO(3,I),IC(I),NA(I),NB(I),NC(I) IOPT( 1, I) = IA( I) IOPT( 2, I) = IB( I) IOPT( 3, I) = IC( I) 8100 CONTINUE NEWDAT = .TRUE. GOTO 1000 ELSEIF ( INDEX( LINE, 'CYCLES EXCEEDED, G') .GT. 0) THEN ** * CYCLES EXCEEDED, GRADIENT NOT FULLY MINIMIZED IN NLLSQ ** CALL DEBUGR( 'YOUR CALCULATION EXCEEDED THE NLLSQ CYCLES.') CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '// . 'PARTIALLY OPTIMIZED GEOMETRY...') READ (*, '(A)') LINE GOTO 1000 ELSEIF ( INDEX( LINE, 'CALCULATION ABANDON') .GT. 0) THEN CALL DEBUGR( 'YOUR CALCULATION WAS ABANDONED...') CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '// . 'WHATEVER GEOMETRY RESULTED ...') READ (*, '(A)') LINE 8020 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, 'NC:NB:NA:I') .NE. 0 ) GOTO 8020 READ( IR,'(A)',END=999,ERR=999)LINE CALL GETGEO( IR, NAT, GEO,IOPT,NA,NB,NC,AMS,NATOMS) NEWDAT = .TRUE. C? GOTO 1000 RETURN ELSEIF ( INDEX( LINE, 'ALL CONVERGERS ARE NOW FORCED ON') . .GT. 0 ) THEN READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE GOTO 1000 ELSEIF ( INDEX( LINE, 'FINAL POINT AND DERIV') .GT. 0) THEN READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE 3 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN( LINE, LINE, .TRUE. ) IF ( LINE(1:1) .NE. ' ') GOTO 3 GOTO 1000 ELSEIF ( INDEX( LINE, 'NO POINT LOWER IN ENERGY THAN ') . .GT. 0 ) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'SINCE COS WAS JUST RESET,') . .GT. 0 ) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'NUMBER OF ITERATIONS =') . .GT. 0 ) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'ABOUT TO ENTER FLEPO FROM PATH') . .GT. 0 ) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'SCF FIELD WAS ACHIEVED') . .GT. 0 ) THEN GOTO 1000 ELSEIF ( INDEX( LINE, 'THE LINE MINIMISATION FAILED TWICE') . .GT. 0 ) THEN CALL DEBUGR( LINE( 1: 78 ) ) GOTO 1000 ENDIF * * NOW TO SEE IF IT IS BLANK * DO 19 I=1,80 19 IF(LINE( I: I ).NE.' ') GOTO 20 GOTO 1000 20 CONTINUE * * CHECK FOR SINGLE WORDS * DO 100 I=1,NWORDS 100 IF(INDEX(LINE, WORDS(I)).NE.0) GOTO 110 * * CHECK FOR SINGLE DATA * 105 CONTINUE DO 200 I=1,NDATUM ILOC=INDEX(LINE, DATUM(I)) 200 IF(ILOC.NE.0) GOTO 210 * * CHECK FOR SMALL BLOCKS OF DATA * 205 CONTINUE DO 300 I=1,NSMALL 300 IF(INDEX(LINE, SMALL(I)).NE.0) GOTO 310 * * CHECK FOR LARGE BLOCKS OF DATA * DO 400 I=1,NLARGE 400 IF(INDEX(LINE, LARGE(I)).NE.0) GOTO 410 * * LINE WAS NOT FOUND, ECHO IT BACK AS ADVICE * C? IF ( DEBUGI ) THEN IIII = LLENG( LINE ) IF ( IIII .GT. 1 ) CALL DEBUGR( LINE(1: IIII) ) C? ENDIF GOTO 1000 * * HANDLE WORDS. * 110 CONTINUE IF(.NOT. GOTW(I)) THEN KEYWRD(NKEY:NKEY+6)=WORDS(I) NKEY=NKEY+8 GOTW(I)=.TRUE. GOTO 1000 ELSE GOTO 105 ENDIF * * HANDLE A SINGLE DATUM * 210 CONTINUE LINE2 = LINE( ILOC:) LINE = LINE2( INDEX( LINE2, ' ')+1: ) CALL LCLEAN( LINE, LINE, .FALSE.) VALD(I) = READA( LINE, 1, ERROR) GOTD(I)=.TRUE. IF(I.EQ.1)NALPHA=VALD(1) IF(I.EQ.2)NBETA =VALD(2) IF(I.EQ.3)GRAD =VALD(3) IF(I.EQ.4)DELTAH =VALD(4) IF(DELTAH.EQ.0 .AND. I.EQ.6)DELTAH = VALD(6) IF(I.EQ.7)EE =VALD(7) IF(I.EQ.8)ENUCLR=VALD(8) IF(I.EQ.9)VIP =VALD(9) IF(I.EQ.10)TIME =VALD(10) IF(I.EQ.11)NSCF =VALD(11) IF(I.EQ.12)SZ =VALD(12) IF(I.EQ.13)S2 =VALD(13) IF(DELTAH.EQ.0 .AND. I.EQ.15)DELTAH = VALD(15) NCLOSE= MAX(VALD(17),VALD(16)) IF(I.EQ.14)NOPEN =VALD(14) NELECS=NCLOSE*2+NOPEN+NALPHA+NBETA IF(I.EQ.18)WEIGHT = VALD( 18) IF(I.EQ.19)ZPE = VALD( 19) NEWDAT = .TRUE. GOTO 1000 310 CONTINUE * * HANDLE SMALL BLOCKS OF DATA * NEWDAT = .TRUE. GOTO (320,330,340,350,360,370,380,390),I * 320 CONTINUE GOTS(1)=.TRUE. * * READ IN INTERNAL COORDINATES * IF (DEBUGI) CALL DEBUGR( 'READER: READING INTERNAL COORDINATES.') NEWDAT = .TRUE. FINGEO = .FALSE. READ ( IR,'(A)',END=999,ERR=999)DUMC,DUMC,DUMC NVAR=0 IF ( .NOT. GOTS(2)) THEN NUMAT=0 NORBS=0 ENDIF DO 321 I= 1, NUMATM READ ( IR, '( A )',END=999,ERR=1000) LINE CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) ELEM = LINE(1:2) ITEMP = NUMELE( ELEM) IF( ITEMP .LT. 1) GOTO 322 CALL POPARG( LINE, LINE) IF ( I .LT. 2) GOTO 326 GEO( 1, I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR. . LINE(1:1) .EQ. '+' ) THEN SOPT( 1) = ' '//LINE(1:1)//' ' CALL POPARG( LINE, LINE) ELSE SOPT( 1) = ' ' ENDIF NA(I) = 1 NB(I) = 0 NC(I) = 0 IF ( I .LT. 3) GOTO 326 GEO( 2, I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR. . LINE(1:1) .EQ. '+' ) THEN SOPT( 2) = ' '//LINE(1:1)//' ' CALL POPARG( LINE, LINE) ELSE SOPT( 2) = ' ' ENDIF IF ( I .EQ. 3) THEN NA( I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) NB( I) = READA( LINE, 1, ERROR) ENDIF IF ( I .LT. 4 ) GOTO 326 GEO( 3, I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR. . LINE(1:1) .EQ. '+' ) THEN SOPT( 3) = ' '//LINE(1:1)//' ' CALL POPARG( LINE, LINE) ELSE SOPT( 3) = ' ' ENDIF NA( I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) NB( I) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) NC( I) = READA( LINE, 1, ERROR) 326 IF(ELEM.EQ.' ')GOTO 322 IF ( ELEM(1:1) .EQ. ' ') ELEM = ELEM(2:2) DO 325 J=1,3 IF ( SOPT(J).EQ.' * ')THEN IOPT(J,I) = 1 NVAR=NVAR+1 LOC(1,NVAR)=J LOC(2,NVAR)=I ELSEIF ( SOPT(J) .EQ. ' ') THEN IOPT( J, I) = 0 ELSEIF ( SOPT(J) .EQ. ' '' ') THEN IOPT( J, I) = -1 ELSEIF ( SOPT(J) .EQ. ' + ') THEN IOPT( J, I) = -1 ELSE IOPT( J, I) = READA( SOPT(J), 1, ERROR) ENDIF 325 CONTINUE IF ( .NOT. GOTS(2)) THEN C? DO 323 J=1,99 C? 323 IF ( ATSYMB(J)(1:2) .EQ.ELEM) GOTO 324 C? 324 CONTINUE C? NAT( I)=J NAT( I)= ITEMP IF( ITEMP.LT.99 .OR. ITEMP.EQ.ISP1 .OR. ITEMP.EQ.ISP2 .OR. . ITEMP.EQ.ISP3 .OR. ITEMP.EQ.ISP4) THEN NUMAT=NUMAT+1 NFIRST(NUMAT)=NORBS+1 NORBS=NORBS+1 IF( ITEMP.EQ.1 ) THEN CONTINUE ELSEIF(ITEMP.EQ.ISP1 .OR. ITEMP.EQ.ISP2 .OR. . ITEMP.EQ.ISP3 .OR. ITEMP.EQ.ISP4 ) THEN NORBS=NORBS-1 ELSE NORBS=NORBS+3 ENDIF NLAST(NUMAT)=NORBS ENDIF ENDIF 321 CONTINUE 322 CONTINUE * ALL ATOMS ARE IN. NATOMS=I-1 IF( DEBUGI) WRITE (*,*) 'READER: NATOMS=',NATOMS IF( DEBUGI) WRITE (*,*) 'READER: NORBS=',NORBS GOTO 1000 * 330 CONTINUE * * READ IN CARTESIAN COORDINATES * IF (DEBUGI) CALL DEBUGR('READER: READING CARTESIAN COORDINATES.') READ( IR,'(A)',END=999,ERR=1000)DUMC,DUMC,DUMC DO 331 I =1, NUMATM READ ( IR, '( A )',END=999,ERR=1000) LINE CALL LCLEAN( LINE, LINE, .FALSE.) IF ( LINE( :1) .EQ. ' ') GOTO 332 331 CONTINUE 332 CONTINUE * ALL ATOMS ARE IN. GOTO 1000 * 340 CONTINUE * * READ IN ORDINARY DATA FILE * IF (DEBUGI) CALL DEBUGR( 'READER: READING ORDINARY DATA FILE.') READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC, DUMC CALL GETGEO( IR, NAT, GEO,IOPT,NA,NB,NC,AMS,NATOMS) GOTO 1000 350 CONTINUE GOTO 1000 360 CONTINUE * * ELECTRON POPULATIONS READ IN * IF (DEBUGI) CALL DEBUGR('READER: READING ELECTRON POPULATIONS.') DO 365 ITEMP = 1, NORBS/8 READ(IR,'(A)',END=999,ERR=999) LINE 365 CONTINUE IF( MOD( NORBS, 8) .NE. 0) READ(IR,'(A)',END=999,ERR=999) LINE C? GOTO 1000 C?? RETURN GOTO 1000 370 CONTINUE * * READ IN EIGENVALUES * IF (DEBUGI) CALL DEBUGR('READER: READING EIGENVALUES.') OFFSET = 0 DO 375 ITEMP = 1, NORBS/8 READ( IR,*,END=999,ERR=1000)(EIGS(OFFSET+I),I=1,8) OFFSET = OFFSET + 8 375 CONTINUE IF( MOD( NORBS, 8) .NE. 0) THEN READ( IR,*,END=999,ERR=1000)(EIGS(OFFSET+I),I=1,MOD(NORBS,8)) ENDIF GOTO 1000 380 CONTINUE * * READ IN ATOMIC CHARGES * IF (DEBUGI) CALL DEBUGR('READER: ATOMIC CHARGES.') c? READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC 381 CONTINUE READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE(1:1) .NE. '1') GOTO 381 CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) Q(1) = READA( LINE, 1, ERROR) C? DO 385 I = 2, NUMAT DO 385 I = 2, NATOMS READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) CALL POPARG( LINE, LINE) CALL POPARG( LINE, LINE) Q(I) = READA( LINE, 1, ERROR) 385 CONTINUE C? READ( IR,'(A30,F14.4)',END=999,ERR=999)(DUMC,Q(I),I=1,NUMAT) * NOW READ AND SKIP THE DIPOLE JUNK C? READ( IR,'(A)',END=999,ERR=999) LINE C? CALL LCLEAN( LINE, LINE, .TRUE.) C? IF ( LINE( 1:1) .EQ. ' ') GOTO 1000 C?? 387 READ( IR,'(A)',END=999,ERR=999) LINE C?? IF ( INDEX( LINE, 'SUM ') .EQ. 0 ) GOTO 387 GOTO 1000 * 390 CONTINUE IF ( DEBUGI) CALL DEBUGR('READER: SYMMETRY JUNK') 391 READ( IR,'(A)',END=999,ERR=999) LINE IF ( INDEX( LINE, 'FUNCTION') .EQ. 0) GOTO 391 NSYMS = 0 392 READ( IR,'(A)',END=999,ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( INDEX( LINE, 'DESCRIPTION') .NE. 0) GOTO 395 ITEMP = READA( LINE, 1, ERROR) LINE = LINE( INDEX( LINE, ' ')+1:) CALL LCLEAN( LINE, LINE, .TRUE.) IF ( ( NSYMS .EQ. 0 ) .OR. ITEMP .NE. ISYM( 1, NSYMS) ) THEN NSYMS = NSYMS + 1 JSYMS = 3 ISYM( 1, NSYMS) = ITEMP ISYM( 2, NSYMS) = READA( LINE, 1, ERROR) ELSE ITEMP = READA( LINE, 1, ERROR) IF ( ITEMP .EQ. ISYM( 2, NSYMS) ) THEN JSYMS = JSYMS + 1 ELSE NSYMS = NSYMS + 1 JSYMS = 3 ISYM( 1, NSYMS) = ISYM( 1, NSYMS-1) ISYM( 2, NSYMS) = ITEMP ENDIF ENDIF LINE = LINE( INDEX( LINE, ' ')+1:) CALL LCLEAN( LINE, LINE, .TRUE.) ISYM( JSYMS, NSYMS) = READA( LINE, 1, ERROR) GOTO 392 395 READ( IR,'(A)',END=999,ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE(1:1) .GE. '0' .AND. LINE(1:1) .LE. '9') THEN ITEMP = READA( LINE, 1, ERROR) DO 396 ITEMP = 1, NSYMS IF ( ITEMP .EQ. ISYM( 2, ITEMP) ) GOTO 395 396 CONTINUE ENDIF READ( IR,'(A)',END=999,ERR=999) KEYWRD READ( IR,'(A)',END=999,ERR=999) KOMENT READ( IR,'(A)',END=999,ERR=999) TITLE GOTO 1000 * * 410 CONTINUE GOTO (420,430,440,450,460,470,480,490,495,500,510,520,530, . 540, 550, 560, 570, 580, 590 ),I * 420 CONTINUE * * READ IN INTERATOMIC DISTANCES * IF (DEBUGI) CALL DEBUGR('READER: READING INTERATOMIC DISTANCES.') LR=.TRUE. CALL VECRED(RIJ,NUMAT, IR) *** NATOMS DOES NOT SEEM TO WORK FOR FORCE CALCULATIONS C? CALL VECRED( RIJ, NATOMS, IR) GOTO 1000 * 430 CONTINUE * * READ IN ALPHA EIGENVECTORS * IF (DEBUGI) CALL DEBUGR( 'READER: READING ALPHA EIGENVECTORS.') LC=.TRUE. CALL MATIN(CVECT,EIGS,NORBS,NORBS,NORBS,NUMAT,NFIRST,NLAST, IR) GOTO 1000 * 440 CONTINUE * * READ IN BETA EIGENVECTORS * IF (DEBUGI) CALL DEBUGR('READER: READING BETA EIGENVECTORS.') LCB=.TRUE. CALL MATIN(CBETA,EIGB,NORBS,NORBS,NORBS,NUMAT,NFIRST,NLAST, IR) GOTO 1000 * 450 CONTINUE * * READ IN FORCE CALCULATION NORMAL COORDINATE ANALYSIS * IF (DEBUGI) CALL DEBUGR( 'READER: NORMAL COORDINATE ANALYSIS.') N3=NUMAT*3 NVIBS=N3 - MODVIB LF=.TRUE. CALL MATIN(FVECT, FEIGS, NVIBS, N3,N3, NUMATM, NFIRST,NLAST, IR) GOTO 1000 * 460 CONTINUE * * READ IN FORCE CALCULATION MAS-WEIGHTED COORDINATE ANALYSIS * IF (DEBUGI) CALL DEBUGR( 'READER: MASS-WEIGHTED COORDINATE.') N3=NUMAT*3 NVIBS=N3 - MODVIB LV=.TRUE. CALL MATIN(VIBVEC, EVIBS, NVIBS, N3,3*NUMATM, . NUMATM,NFIRST,NLAST, IR) GOTO 1000 * 470 CONTINUE * * READ IN BOND ORDERS AND VALENCIES * IF (DEBUGI) CALL DEBUGR( 'READER: BOND ORDERS AND VALENCE.') LB=.TRUE. READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC CALL VECRED( BONDS, NUMAT, IR) READ( IR, '(A)',END=999,ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF( LINE(1:6) .EQ. 'CYCLE:') RETURN IF( LINE(1:5) .EQ. '*****') RETURN GOTO 1000 * 480 CONTINUE * * READ AND DISCARD DESCRIPTION OF VIBRATIONS * IF (DEBUGI) WRITE (*,*) 'READER: DISCARDING DESCRIPT OF VIBS.' READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE 482 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN (LINE, LINE, .FALSE.) CALL LCLEAN (LINE, LINE, .FALSE.) IF ( LINE( 1:1) .NE. ' ') GOTO 482 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN (LINE, LINE, .FALSE.) CALL LCLEAN (LINE, LINE, .FALSE.) IF ( LINE( 1:1) .NE. ' ') GOTO 482 GOTO 1000 * 490 CONTINUE * * READ AND DISCARD FREQUENCIES, REDUCED MASSES AND VIBRATION DIPOLES * IF (DEBUGI) WRITE (*,*) 'READER: DISCARDING FREQ, RED MASSES.' ITEMP = 0 492 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, 'DIPT(I)') .NE. 0) THEN ITEMP = ITEMP + 6 IF ( ITEMP .GE. NUMAT*3) GOTO 1000 ENDIF GOTO 492 * 495 CONTINUE * READ AND DISCARD FULL FORCE MATRIX, INVOKED BY "DFORCE" * IF (DEBUGI) . CALL DEBUGR( 'READER: DISCARDING FULL FORCE MATRIX.') JTEMP = NUMAT IF ( INDEX( LINE, 'FULL') .NE. 0) JTEMP = NUMAT*3 READ( IR,'(A)',END=999,ERR=999)LINE ITEMP = 0 496 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, '------') .NE. 0) THEN ITEMP = ITEMP + 6 ENDIF CALL LCLEAN( LINE, LINE, .FALSE.) IF ( LINE( 1:1).EQ.' ' .AND. ITEMP.GE.JTEMP) GOTO 1000 GOTO 496 * 500 CONTINUE * READ AND DISCARD INTERNAL COORDINATE DERIVATIVES * IF (DEBUGI) . CALL DEBUGR( 'READER: DISCARDING IC DERIVATIVES.') READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE 502 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN( LINE, LINE, .FALSE.) ITEMP = READA( LINE, 1, ERROR) IF ( ITEMP .LT. NUMAT ) GOTO 502 GOTO 1000 * 510 CONTINUE * READ ORIENTATION OF MOLECULE IN FORCE CALCULATION * IF (DEBUGI) CALL DEBUGR('READER: READING FORCE ORIENTATION.') READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE KTEMP = 1 512 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN( LINE, LINE, .FALSE.) JTEMP = READA( LINE, 1, ERROR) IF ( JTEMP .NE. KTEMP) GOTO 512 CALL POPARG( LINE, LINE) IEFOR( KTEMP) = READA( LINE, 1, ERROR) C? IF( IEFOR( KTEMP) .LT. 1 .AND. KTEMP.EQ.1) GOTO 512 CALL POPARG( LINE, LINE) FORORE( 1, KTEMP) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) FORORE( 2, KTEMP) = READA( LINE, 1, ERROR) CALL POPARG( LINE, LINE) FORORE( 3, KTEMP) = READA( LINE, 1, ERROR) IF ( KTEMP .LT. NUMAT ) THEN KTEMP = KTEMP + 1 GOTO 512 ENDIF GOTO 1000 * 520 CONTINUE * READ AND DISCARD FORCE CONSTANTS IN MILLIDYNES/ANGSTROM * IF (DEBUGI) CALL DEBUGR('READER: DISCARDING FORCE CONSTANTS.') READ( IR,'(A)',END=999,ERR=999)LINE 522 READ( IR,'(A)',END=999,ERR=999)LINE CALL LCLEAN( LINE, LINE, .FALSE.) IF ( LINE(:1) .NE. ' ') GOTO 522 GOTO 1000 * 530 CONTINUE * READ AND DISCARD CALCULATED THERMODYNAMIC PROPERTIES * IF (DEBUGI) CALL DEBUGR('READER: DISCARDING THERMODYNAMICS.') READ( IR,'(A)',END=999,ERR=999)LINE 532 READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, 'TOT.') .EQ. 0) GOTO 532 READ( IR,'(A)',END=999,ERR=999)LINE READ( IR,'(A)',END=999,ERR=999)LINE IF ( INDEX( LINE, 'VIB.') .NE. 0) GOTO 532 GOTO 1000 * 540 CONTINUE * * READ AND DISCARD PRINCIPAL MOMENTS OF INERTIA ... IF(DEBUGI) CALL DEBUGR( 'DISCARDING MOMENTS OF INERTIA.') READ( IR, '(A)', END=999, ERR=999)LINE READ( IR, '(A)', END=999, ERR=999)LINE GOTO 1000 * 550 CONTINUE * * READ AND DISCARD ESTIMATED TIME TO COMPLETE CALCULATION GOTO 1000 * 560 CONTINUE * * READ AND DISCARD TRIVIAL VIBRATIONS, SHOULD BE ZERO 562 READ( IR, '(A)', END=999, ERR=999)LINE IF ( INDEX( LINE, '=TX') .EQ. 0 ) GOTO 562 GOTO 1000 * 570 CONTINUE * * READ AND DISCARD THE LAST # VIBRATIONS ARE THE TRANSLATION AND ... READ( IR, '(A)', END=999, ERR=999)LINE READ( IR, '(A)', END=999, ERR=999)LINE GOTO 1000 * 580 CONTINUE * READ AND DISCARD LOCALISED ORBITALS IF ( DEBUGI ) . CALL DEBUGR('READER: DISCARDING LOCALISED ORBITALS') 581 READ( IR, '(A)', END=999, ERR=999) LINE IF ( INDEX( LINE, 'LOCALISED ORBITALS') .EQ. 0 ) GOTO 581 582 READ( IR, '(A)', END=999, ERR=999) LINE DO 588 K= 1, NCLOSE, 6 584 READ( IR, '(A)', END=999, ERR=999) LINE IF ( INDEX( LINE, 'ROOT NO') .EQ. 0 ) GOTO 584 585 READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE(1:1) .NE. 'S') GOTO 585 DO 587 I = 1, NORBS-1 586 READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE( :1) .EQ. ' ') GOTO 586 587 CONTINUE 588 CONTINUE GOTO 1000 * 590 CONTINUE * READ AND DISCARD EIGENVECTORS IF ( DEBUGI ) . CALL DEBUGR( 'READER: DISCARDING EIGENVECTORS') DO 598 K= 1, NORBS/7+1 591 READ( IR, '(A)', END=999, ERR=999) LINE IF ( INDEX( LINE, 'ROOT NO') .EQ. 0 ) GOTO 591 592 READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE(1:1) .NE. 'S') GOTO 592 DO 594 I = 1, NORBS-1 593 READ( IR, '(A)', END=999, ERR=999) LINE CALL LCLEAN( LINE, LINE, .TRUE.) IF ( LINE( :1) .EQ. ' ') GOTO 593 594 CONTINUE 598 CONTINUE GOTO 1000 * 999 CONTINUE IF (DEBUGI) WRITE (*,*) 'IN READER: INPUT ERROR, FIRST=',FIRST IF ( NEWDAT ) RETURN IF (.NOT. FIRST) THEN IOERR = 1 ENDIF RETURN END SUBROUTINE GETGEO(IREAD,LABELS,GEO,LOPT,NA,NB,NC,AMS,NATOMS) IMPLICIT REAL (A-H,O-Z) INCLUDE 'SIZES' DIMENSION GEO(3,*),NA(*),NB(*),NC(*),AMS(*), LOPT(3,*) +,LABELS(*) ***************************************************************************** * * GETGEO READS IN THE GEOMETRY. THE ELEMENT IS SPECIFIED BY IT'S CHEMICAL * SYMBOL, OR, OPTIONALLY, BY IT'S ATOMIC NUMBER. * * ON INPUT IREAD = CHANNEL NUMBER FOR READ, NORMALLY 5 * AMS = DEFAULT ATOMIC MASSES. * * ON OUTPUT LABELS = ATOMIC NUMBERS OF ALL ATOMS, INCLUDING DUMMIES. * GEO = INTERNAL COORDINATES, IN ANGSTROMS, AND DEGREES. * LOPT = INTEGER ARRAY, A '1' MEANS OPTIMISE THIS PARAMETER, * '0' MEANS DO NOT OPTIMISE, AND A '-1' LABELS THE * REACTION COORDINATE. * NA = INTEGER ARRAY OF ATOMS (SEE DATA INPUT) * NB = INTEGER ARRAY OF ATOMS (SEE DATA INPUT) * NC = INTEGER ARRAY OF ATOMS (SEE DATA INPUT) * ATMASS = ATOMIC MASSES OF ATOMS. ***************************************************************************** COMMON /ATMASS/ ATMASS(NUMATM) DIMENSION ISTART(40) LOGICAL LEADSP, ERROR CHARACTER*127 UPLINE CHARACTER ATSYMB*6, LINE*80, SPACE*1, NINE*1,ZERO*1, +TAB*1, COMMA*1, STRING*80, ELE*2 COMMON /ATSYMB/ ATSYMB( 200) DATA COMMA,SPACE,NINE,ZERO/',',' ','9','0'/ TAB=CHAR(9) NATOMS=0 NUMAT=0 10 READ(IREAD,'(A)',END=31,ERR=32)LINE IF(LINE.EQ.' ') GO TO 31 IF(NATOMS.GT.NUMATM)THEN WRITE(6,'(//10X,''**** MAX. NUMBER OF ATOMS ALLOWED:'',I4)') +NUMATM STOP ENDIF NATOMS=NATOMS+1 * CLEAN THE INPUT DATA LINE = UPLINE( LINE) DO 9 I=1,80 9 IF(LINE(I:I).EQ.TAB.OR.LINE(I:I).EQ.COMMA)LINE(I:I)=SPACE * * INITIALIZE ISTART TO INTERPRET BLANKS AS ZERO'S DO 11 I=1,10 11 ISTART(I)=80 * FIND INITIAL DIGIT OF ALL NUMBERS, CHECK FOR LEADING SPACES FOLLOWED * BY A CHARACTER AND STORE IN ISTART LEADSP=.TRUE. NVALUE=0 DO 12 I=1,80 IF (LEADSP.AND.LINE(I:I).NE.SPACE) THEN NVALUE=NVALUE+1 ISTART(NVALUE)=I END IF LEADSP=(LINE(I:I).EQ.SPACE) 12 CONTINUE * * ESTABLISH THE ELEMENT'S NAME AND ISOTOPE, CHECK FOR ERRORS OR E.O.DATA * WEIGHT=0.D0 STRING=LINE(ISTART(1):ISTART(2)-1) IF( STRING(1:1) .GE. ZERO .AND. STRING(1:1) .LE. NINE) THEN * ATOMIC NUMBER USED: NO ISOTOPE ALLOWED LABEL=READA(STRING,1, ERROR) IF (LABEL.EQ.0) GO TO 30 IF (LABEL.LT.0.OR.LABEL.GT.99) THEN CALL DEBUGR( 'ILLEGAL ATOMIC NUMBER') GO TO 33 END IF GO TO 20 END IF * ATOMIC SYMBOL USED REAL=READA(STRING,1, ERROR) IF (REAL.LT..005) THEN * NO ISOTOPE ELE=STRING(1:2) ELSE WEIGHT=REAL IF( STRING(2:2) .GE. ZERO .AND. STRING(2:2) .LE. NINE) THEN ELE=STRING(1:1) ELSE ELE=STRING(1:2) END IF END IF * CHECK FOR ERROR IN ATOMIC SYMBOL C? DO 17 I=1,200 C? IF ( ELE .EQ. ATSYMB(I)(1:2)) THEN C? LABEL=I C? GO TO 20 C? END IF C?17 CONTINUE LABEL = NUMELE( ELE ) IF( LABEL.GT.0) GOTO 20 WRITE(6,'('' UNRECOGNIZED ELEMENT NAME: <'',A,''>'')')ELE GOTO 33 * * ALL O.K. * 20 IF (LABEL.NE.99) NUMAT=NUMAT+1 IF(WEIGHT.NE.0.D0)THEN WRITE(6,'('' FOR ATOM'',I4,'' ISOTOPIC MASS:'' + ,F12.5)')NATOMS, WEIGHT ATMASS(NUMAT)=WEIGHT ELSE IF(LABEL .NE. 99) ATMASS(NUMAT)=AMS(LABEL) ENDIF LABELS(NATOMS) =LABEL GEO(1,NATOMS) =READA(LINE,ISTART(2), ERROR) LOPT(1,NATOMS) =READA(LINE,ISTART(3), ERROR) IF ( ERROR ) LOPT( 1, NATOMS ) = 0 IF ( LOPT( 1, NATOMS) .GT. 1 ) LOPT( 1, NATOMS) = 0 IF ( LOPT( 1, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0 GEO(2,NATOMS) =READA(LINE,ISTART(4), ERROR) LOPT(2,NATOMS) =READA(LINE,ISTART(5), ERROR) IF ( ERROR ) LOPT( 2, NATOMS ) = 0 IF ( LOPT( 2, NATOMS) .GT. 1 ) LOPT( 2, NATOMS) = 0 IF ( LOPT( 2, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0 GEO(3,NATOMS) =READA(LINE,ISTART(6), ERROR) LOPT(3,NATOMS) =READA(LINE,ISTART(7), ERROR) IF ( ERROR ) LOPT( 3, NATOMS ) = 0 IF ( LOPT( 3, NATOMS) .GT. 1 ) LOPT( 3, NATOMS) = 0 IF ( LOPT( 3, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0 NA(NATOMS) =READA(LINE,ISTART(8), ERROR) NB(NATOMS) =READA(LINE,ISTART(9), ERROR) NC(NATOMS) =READA(LINE,ISTART(10), ERROR) GOTO 10 * * ALL DATA READ IN, CLEAN UP AND RETURN * 30 NATOMS=NATOMS-1 31 NA(2)=1 IF(LOPT(1,1)+LOPT(2,1)+LOPT(3,1)+LOPT(2,2)+LOPT(3,2)+ + LOPT(3,3) .GT. 0)THEN LOPT(1,1)=0 LOPT(2,1)=0 LOPT(3,1)=0 LOPT(2,2)=0 LOPT(3,2)=0 LOPT(3,3)=0 WRITE(6,'(//10X,'' AN UNOPTIMIZABLE GEOMETRIC PARAMETER HAS'' +,/10X,'' BEEN MARKED FOR OPTIMIZATION. THIS IS A NON-FATAL '' +,''ERROR'')') ENDIF IF(NA(3).EQ.0) THEN NB(3)=1 NA(3)=2 ENDIF RETURN * ERROR CONDITIONS 32 IF(IREAD.EQ.5) THEN WRITE(6,'( '' ERROR DURING READ AT ATOM NUMBER '', I3 )')NATOMS ELSE NATOMS=0 RETURN ENDIF 33 J=NATOMS-1 WRITE(6,'('' DATA CURRENTLY READ IN ARE '')') DO 36 K=1,J 36 WRITE(6,42)LABELS(K),(GEO(J,K),LOPT(J,K),J=1,3),NA(K),NB(K),NC(K) 42 FORMAT(I4,2X,3(F10.5,2X,I2,2X),3(I2,1X)) C? CALL EXIT STOP ' ' END