SUBROUTINE DRCRD(KHANEL,NATOM3,NN,A,NA,NB,NC, + LA, LB, LC, ISYM, KEYWRD, KOMENT, TITLE, IOERR ) IMPLICIT REAL (A-H,O-Z) INCLUDE 'SIZES' LOGICAL ERROR, FIRST, CARCOR, INTDIS, LARGE DIMENSION NN(NUMATM), ISYM(10,NUMATM) DIMENSION A(3,NUMATM),NC(NUMATM),NB(NUMATM),NA(NUMATM) DIMENSION LA(NUMATM),LB(NUMATM),LC(NUMATM) CHARACTER*80 KEYWRD,KOMENT,TITLE CHARACTER*80 DUMMY CHARACTER*6 METHOD CHARACTER*3 FTYPE REAL VFREQ, VIBVEC REAL VMAX LOGICAL DEBUGL, DEBUGN, DEBUGO, DEBUG, DEBUGP, DEBUGI COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI COMMON /FILEST/ FIRST COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT COMMON /FORGEO/ FORORE( 3, NUMATM), IEFOR( NUMATM) C** COMMON /FINFO/ DELTAH,RC, GRAD, RCGRAD,VIP, DIPOLE, ICHARG COMMON /FINFO/ ETIME,EXKIN,ENERR,EPOT,EKINET,REFNR,IPOINT COMMON /FINFOC/ FTYPE * * ETIME := ELAPSED TIME * EXKIN := EXCESS KINETIC ENERGY TO ADD * ENERR := ENERGY ERROR * EPOT := POTENTIAL ENERGY AT THIS POINT * EKINET := KINETIC ENERGY AT THIS POINT * REFNR := REFERENCE NUMBER * IPOINT := POINT NUMBER * * LOOK FOR THE START OF NEXT DRC POINT * IF ( DEBUGI ) THEN WRITE (DUMMY,'( '' IN DRCRD: FIRST='',L4)') FIRST CALL DEBUGR( DUMMY ) ENDIF IF (FIRST) THEN COUNT = 0 NUMAT = 0 NATOMS = 0 CARCOR = .TRUE. INTDIS = .TRUE. LARGE = .FALSE. VFREQ( 1) = 0.0D0 2 READ ( KHANEL, '(A)', END=31) DUMMY IF ( INDEX( DUMMY, 'EXCESS KINETIC ENERGY ENTER') .GT. 0) THEN IEQ = INDEX( DUMMY, '=') IF ( IEQ .EQ. 0 ) GOTO 2 DUMMY = DUMMY( IEQ: ) CALL LCLEAN( DUMMY, DUMMY, .TRUE.) EXKIN = READA( DUMMY, 1, ERROR) GOTO 2 ELSEIF( INDEX( DUMMY, 'CALCULATION RESULTS') .GT. 0) THEN CALL LCLEAN( DUMMY, DUMMY, .TRUE.) METHOD = DUMMY(1: INDEX( DUMMY, ' ') ) C? CALL DEBUGR( 'A '//METHOD//' CALCULATION.' ) GOTO 2 ELSEIF( INDEX( DUMMY, 'SIAN COORDINATES NOT TO') .GT. 0) THEN CARCOR = .FALSE. GOTO 2 ELSEIF( INDEX( DUMMY, 'EXPANDED OUTPUT TO BE PR') .GT. 0) THEN LARGE = .TRUE. GOTO 2 ELSEIF( INDEX( DUMMY, 'STANCES NOT TO BE PRINT') .GT. 0) THEN INTDIS = .FALSE. GOTO 2 ELSEIF( INDEX( DUMMY, '********************') .GT. 0) THEN COUNT = COUNT + 1 IF ( COUNT .GT. 3) THEN FIRST = .FALSE. READ ( KHANEL, '(A)', END=31) KEYWRD READ ( KHANEL, '(A)', END=31) KOMENT READ ( KHANEL, '(A)', END=31) TITLE ELSE GOTO 2 ENDIF ELSE GOTO 2 ENDIF 5 READ ( KHANEL, '(A)', END=31) DUMMY IF ( INDEX( DUMMY, ' NC:NB:NA:I ') .EQ. 0) GOTO 5 IF(DEBUGI) WRITE (*,*) 'IN DRCRD: READING INTERNAL COORDS.' READ ( KHANEL, '(A)', END=31) DUMMY 6 READ ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF( DUMMY(1:1) .NE. ' ') THEN CALL POPARG( DUMMY, DUMMY) ITEMP = NUMELE( DUMMY(1:2) ) NATOMS = NATOMS + 1 IF( ITEMP.LT.99) NUMAT = NUMAT + 1 GOTO 6 ENDIF IF ( CARCOR ) THEN * WE SEARCH TO FIND THE CARTESIAN COORDINATES 20 READ( KHANEL, '(A)', END=31) DUMMY IF ( INDEX( DUMMY, ' REF%') .NE. 0) GOTO 101 IF ( INDEX( DUMMY, 'CARTESIAN COORDINATES') .NE. 0) THEN READ( KHANEL, '(A)', END=31) DUMMY READ( KHANEL, '(A)', END=31) DUMMY READ( KHANEL, '(A)', END=31) DUMMY 22 CONTINUE READ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF( DUMMY( 1:1) .NE. ' ') GOTO 22 ELSE GOTO 20 ENDIF ENDIF IF ( INTDIS ) THEN 30 READ( KHANEL, '(A)', END=31) DUMMY IF ( INDEX( DUMMY, ' REF%') .NE. 0) GOTO 101 IF ( INDEX( DUMMY, 'INTERATOMIC DISTANCE') .NE. 0) THEN READ( KHANEL, '(A)', END=31) DUMMY CALL VECRED( VIBVEC, NUMAT, KHANEL) VIBVEC( 1,1) = 0.0 ELSE GOTO 30 ENDIF ENDIF NATOM3 = NATOMS * NOW READ AND ECHO EVERYTHING UNTIL WE FIND THE FIRST POINT 80 READ( KHANEL, '(A)', END=31) DUMMY IF ( INDEX( DUMMY, ' REF%') .NE. 0) GOTO 101 CALL DEBUGR( DUMMY( 1: 75) ) GOTO 80 ENDIF * HERE IS THE LOOP FOR EACH POINT ON THE IRC/DRC 100 CONTINUE READ( KHANEL, '(A)', END=3000) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF( DUMMY(1:1) .EQ. ' ') GOTO 100 IF(DEBUGI) CALL DEBUGR( 'DRCRD: AT TOP - '//DUMMY(1:40) ) IF ( INDEX( DUMMY, 'L ERROR REF') .NE. 0) GOTO 101 IF ( INDEX( DUMMY, 'NING OUT OF TIME, REST') .GT. 0 ) THEN CALL DEBUGR(' End of DRC file, RESTART files written ') GOTO 99 ENDIF 101 CONTINUE FIRST = .FALSE. IF ( INDEX( DUMMY, 'FEMTOSEC') .NE. 0) THEN * THIS IS DRC OUTPUT READ ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF(DEBUGI) CALL DEBUGR( 'DRCRD: (DRC) '//DUMMY(1:50) ) * MODELED TIME ETIME = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) ELSE * THIS IS IRC OUTPUT READ ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF(DEBUGI) CALL DEBUGR( 'DRCRD: (IRC) '//DUMMY(1:50) ) ENDIF * POINT NUMBER IPOINT = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) * NOW GET ENERGY INFORMATION EPOT = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) EKINET = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) CALL POPARG( DUMMY, DUMMY) ENERR = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) REFNR = READA( DUMMY, 1, ERROR) IF( LARGE ) THEN IF(DEBUGI) CALL DEBUGR( 'DRCRD: LOOKING FOR CARTESIAN...') 120 READ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF(DEBUGI) CALL DEBUGR( DUMMY ) IF( DUMMY( 1:1) .EQ. ' ') GOTO 120 IF ( INDEX( DUMMY, 'FINAL GEOMETRY OBTAINED') .GT. 0) GOTO 130 IF( INDEX( DUMMY,'=') .NE. 0) THEN CALL DEBUGR( DUMMY ) GOTO 120 ENDIF IF( INDEX( DUMMY, 'CARTESIAN GEOMETRY') .NE. 0) THEN GOTO 120 ELSE * * NEXT IS CARTESIAN GEOMETRY AND THE VELOCITY COMPONENTS * IF(DEBUGI) CALL DEBUGR( 'DRCRD: READING VELOCITY') 121 CONTINUE VFREQ( 1) = 1.0 VMAX = -4.0 IA = 1 DO 125 I= 0, (NUMAT-1)*3, 3 READ( KHANEL, '(A)', END=31) DUMMY CALL LCLEAN( DUMMY, DUMMY, .TRUE.) IF ( DUMMY(1:1) .EQ. ' ') GOTO 127 CALL POPARG( DUMMY, DUMMY) IEFOR( IA) = NUMELE( DUMMY( 1: INDEX( DUMMY, ' ') ) ) CALL POPARG( DUMMY, DUMMY) FORORE( 1, IA) = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) FORORE( 2, IA) = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) FORORE( 3, IA) = READA( DUMMY, 1, ERROR) CALL POPARG( DUMMY, DUMMY) VIBVEC( I + 1, 1) = READA( DUMMY, 1, ERROR) VMAX = MAX( VIBVEC( I+1, 1), VMAX) CALL POPARG( DUMMY, DUMMY) VIBVEC( I + 2, 1) = READA( DUMMY, 1, ERROR) VMAX = MAX( VIBVEC( I+2, 1), VMAX) CALL POPARG( DUMMY, DUMMY) VIBVEC( I + 3, 1) = READA( DUMMY, 1, ERROR) VMAX = MAX( VIBVEC( I+3, 1), VMAX) IA = IA + 1 125 CONTINUE 127 CONTINUE IF ( VMAX.NE. 0.0)THEN DO 128 I=0, (NUMAT-1)*3, 3 DO 128 J=1,3 VIBVEC( I+J, 1) = VIBVEC( I+J, 1) / VMAX 128 CONTINUE ELSE CALL DEBUGR( 'IN DRCRD: VMAX IS ZERO!') ENDIF C? GOTO 135 ENDIF ENDIF * * NEXT THE INTERNAL GEOMETRY * 130 CONTINUE IF ( INDEX( DUMMY, 'FINAL GEOMETRY OBTAINED') .LT. 1) THEN READ ( KHANEL, '(A)', END=31) DUMMY GOTO 130 ENDIF IF(DEBUGI) CALL DEBUGR( 'DRCRD: READING NEXT GEOMETRY') CALL GEORD( KHANEL, NATOM3, NN, A, NA, NB, NC, . LA, LB, LC, ISYM, IOERR ) IF ( IOERR .NE. 0 ) GOTO 99 135 CONTINUE IF ( DEBUGI ) THEN DO 140 I=1, NATOM3 WRITE (DUMMY, '( I4, 3F12.6, 3I6 )') NN(I), (A(J,I),J=1,3), . NA(I), NB(I), NC(I) CALL DEBUGR( DUMMY ) 140 CONTINUE WRITE (DUMMY,'('' TIME='',F9.3,'' POINT='',I8,''P.E.='', . F10.5,''K.E.='',F10.5,'' E.ERROR='',F10.5)') . ETIME, IPOINT, EPOT, EKINET, ENERR CALL DEBUGR( DUMMY ) ENDIF * * ALL DONE FOR NOW * RETURN ************************** 31 WRITE( *,'('' ERROR IN FORMAT OF DRC FILE '')') IOERR=1 FIRST = .TRUE. RETURN 99 WRITE( *,'('' ERROR READING DRC FILE'')') IOERR=1 FIRST = .TRUE. RETURN ** NORMAL END OF FILE 3000 IOERR = -100 FIRST = .FALSE. RETURN END