mopac606_nbo/src/depvar.f

   1       SUBROUTINE DEPVAR (A,I,W,L)
   2       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   3       DIMENSION A(3,*)
   4 C***********************************************************************
   5 C
   6 C  IN SUBROUTINE HADDON WHEN M, THE SYMMETRY OPERATION, IS 18 DEPVAR IS
   7 C  CALLED. DEPVAR SHOULD THEN CONTAIN A USER-WRITTEN SYMMETRY OPERATION.
   8 C  SEE HADDON TO GET THE IDEA ON HOW TO WRITE DEPVAR.
   9 C
  10 C ON INPUT:
  11 C           A = ARRAY OF INTERNAL COORDINATES
  12 C           I = ADDRESS OF REFERENCE ATOM
  13 C ON OUTPUT:
  14 C           L = 1 (IF A BOND-LENGTH IS THE DEPENDENT FUNCTION)
  15 C             = 2 (IF AN ANGLE IS THE DEPENDENT FUNCTION)
  16 C             = 3 (IF A DIHEDRAL ANGLE IS THE DEPENDENT FUNCTION)
  17 C           W = VALUE OF THE FUNCTION
  18 C
  19 C  NOTE:  IT IS THE WRITER'S RESPONSIBILITY TO MAKE CERTAIN THAT THE
  20 C         SUBROUTINE DOES NOT CONTAIN ANY ERRORS!
  21 C***********************************************************************
  22       COMMON /KEYWRD/ KEYWRD
  23       COMMON /NUMCAL/ NUMCAL
  24       SAVE FACT
  25       CHARACTER*241 KEYWRD
  26       DATA ICALCN/0/
  27       IF (ICALCN.NE.NUMCAL) THEN
  28          ICALCN=NUMCAL
  29          FACT=READA(KEYWRD,INDEX(KEYWRD,'DEPVAR'))
  30          WRITE(6,'(''  UNIT CELL LENGTH ='',F14.7,
  31      1'' TIMES BOND LENGTH'')')FACT
  32       ENDIF
  33       W=A(1,I)*FACT
  34       L=1
  35       RETURN
  36       END