[Bug fortran/38618] New: internal compiler error: in gfc_add_modify
ajs1 at cam dot ac dot uk
gcc-bugzilla@gcc.gnu.org
Wed Dec 24 12:41:00 GMT 2008
The command line and the resulting error messages:
gfortran -I../include -Wall -save-temps -DVAR_G77 -DSYS_LINUX -DVAR_MFDS
-DVAR_SPLITFILES -D'INSTALL_WRKMEM=20000000'
-D'INSTALL_BASDIR="/Users/ajs1/Dalton-2.0/basis/"' -O2 -std=legacy -ffast-math
-fexpensive-optimizations -funroll-loops -c abavrml.F
abavrml.F: In function 'mkvrs1':
abavrml.F:384: internal compiler error: in gfc_add_modify, at
fortran/trans.c:159
gcc -v gives:
Using built-in specs.
Target: i386-apple-darwin9.4.0
Configured with: ../gcc-4.4-20080801/configure --enable-languages=fortran,c++
Thread model: posix
gcc version 4.4.0 20080801 (experimental) (GCC)
The preprocessed fortran file, generated using cpp with the flags from the
gfortran command line, follows:
# 1 "abavrml.F"
# 1 "<built-in>"
# 1 "<command-line>"
# 1 "abavrml.F"
C
C... Copyright (c) 2005 by the authors of Dalton (see below).
C... All Rights Reserved.
C...
C... The source code in this file is part of
C... "Dalton, a molecular electronic structure program, Release 2.0
C... (2005), written by C. Angeli, K. L. Bak, V. Bakken,
C... O. Christiansen, R. Cimiraglia, S. Coriani, P. Dahle,
C... E. K. Dalskov, T. Enevoldsen, B. Fernandez, C. Haettig,
C... K. Hald, A. Halkier, H. Heiberg, T. Helgaker, H. Hettema,
C... H. J. Aa. Jensen, D. Jonsson, P. Joergensen, S. Kirpekar,
C... W. Klopper, R.Kobayashi, H. Koch, O. B. Lutnaes, K. V. Mikkelsen,
C... P. Norman, J.Olsen, M. J. Packer, T. B. Pedersen, Z. Rinkevicius,
C... E. Rudberg, T. A. Ruden, K. Ruud, P. Salek, A. Sanchez de Meras,
C... T. Saue, S. P. A. Sauer, B. Schimmelpfennig, K. O. Sylvester-Hvid,
C... P. R. Taylor, O. Vahtras, D. J. Wilson, H. Agren.
C... This source code is provided under a written licence and may be
C... used, copied, transmitted, or stored only in accord with that
C... written licence.
C...
C... In particular, no part of the source code or compiled modules may
C... be distributed outside the research group of the licence holder.
C... This means also that persons (e.g. post-docs) leaving the research
C... group of the licence holder may not take any part of Dalton,
C... including modified files, with him/her, unless that person has
C... obtained his/her own licence.
C...
C... For questions concerning this copyright write to:
C... dalton-admin@kjemi.uio.no
C...
C... For information on how to get a licence see:
C... http:
C
# 1 "../include/single.h" 1
# 35 "abavrml.F" 2
C
C
SUBROUTINE MKVRML(LAST, ATMARR, IEDIM, EVEC, EVC1, EVC2)
C
C Punch out geometry to VRML-file
C
# 1 "../include/implicit.h" 1
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
# 48 "abavrml.F" 2
# 1 "../include/mxcent.h" 1
C
C file: mxcent.h
C
C MXCENT = max number of nuclei + point charges + ghost orbital centers
C
C IF you change MXCENT you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXCENT, MXCOOR
PARAMETER (MXCENT = 120, MXCOOR = 3*MXCENT)
# 49 "abavrml.F" 2
# 1 "../include/maxorb.h" 1
C
C File: maxorb.h
C
C MXSHEL = maximum number of shells (insert shell definition here).
C MXPRIM = maximum number of primitives.
C MXCORB = maximum number of orbitals (possibly contracted).
C MAXOCC = maximum number of occupied orbitals
C
C IF you change any of these parameters you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXSHEL, MXPRIM, MXCORB, MXORBT, MAXOCC
PARAMETER (MXSHEL = 750, MXPRIM = 4000, MXCORB = 1200,
* MAXOCC = 400, MXORBT = MXCORB*(MXCORB + 1)/2)
# 50 "abavrml.F" 2
# 1 "../include/maxaqn.h" 1
INTEGER MXQN, MXAQN
PARAMETER (MXQN=7, MXAQN=MXQN*(MXQN+1)/2)
# 51 "abavrml.F" 2
# 1 "../include/nuclei.h" 1
INTEGER NUCPRE, NUCNUM, NUCDEG, ISTBNU,
& NUCIND, NUCDEP, NTRACO, ITRACO, NATOMS, NFLOAT,
& NBASIS, NLARGE, NSMALL, NPBAS, NPLRG, NPSML,
& NCHTOT, INCENT, INUNIQ, NDEGNM, ISOTOP, IZATOM,
& NBASISAUX, NPBASAUX, NAUX, NPAUX
DOUBLE PRECISION CHARGE, CORD, GNUEXP
LOGICAL NOORBT,GAUNUC
COMMON /NUCLEI/ CHARGE(MXCENT), CORD(3,MXCENT), GNUEXP(MXCENT),
& GAUNUC, NOORBT(MXCENT), NUCPRE(MXCENT),
& NUCNUM(MXCENT,8), NUCDEG(MXCENT), ISTBNU(MXCENT),
& NDEGNM(MXCENT), NUCIND, NUCDEP, NTRACO, ITRACO(3),
& NATOMS, NFLOAT, NBASIS, NLARGE, NSMALL, NPBAS,
& NPLRG, NPSML, NCHTOT, INCENT(MXCENT),
& INUNIQ(MXCENT), ISOTOP(MXCENT),IZATOM(MXCENT),
& NBASISAUX, NPBASAUX, NAUX, NPAUX
CHARACTER NAMEX*6, NAMDEP*6, NAMDPX*8, NAMN*4
COMMON /NUCLEC/ NAMEX(MXCOOR), NAMDEP(MXCENT), NAMDPX(MXCOOR),
& NAMN(MXCENT)
INTEGER MULBSI
COMMON /MULBAS/ MULBSI(MXCENT)
C MULBAS has been added for multiple basis sets (WK/UniKA/31-10-2002).
# 52 "abavrml.F" 2
# 1 "../include/molinp.h" 1
PARAMETER (KMLINE = 2000)
CHARACTER*80 MLINE
COMMON /MOLINC/ MLINE(KMLINE)
COMMON /MOLINP/ NMLINE,NCLINE(MXCENT),NMLAU
# 53 "abavrml.F" 2
# 1 "../include/optinf.h" 1
C
C File: optinf.h
C
C Information for geometry optimization
C controlled in abaopt.F, abaop2.F, and abarint.F
C
PARAMETER (MAXPRE = 10)
CHARACTER*80 SPBSTX, PREBTX
LOGICAL GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM, DOSPE, DOPRE,
& FINPRE, VRML, VRBOND, VREIGV, VRCORD, VRVIBA,
& VRSYMM, VISUAL, BOFILL, INITHS, HSFILE, BFGSR1,
& STEEPD, RANKON, PSB, DFP, BFGS, SCHLEG,
& NEWTON, QUADSD, KEEPHE, BAKER, REDINT, CARTCO,
& INRDHS, FSTORD, SNDORD, REJINI, GRDINI, MULTI,
& CHGRDT, CONOPT, MODHES, INMDHS, FINDRE, TRSTRG,
& RATFUN, GDIIS, DELINT, RSTARR, LNSRCH, SADDLE,
& REBILD, CMBMOD, HFPROP, CONFRM, NOAUX, NODIHE,
& LINDHD
COMMON /OPTINF/ TRSTRA, TRSTIN, TRSTDE, RTENBD, RTENGD, RTRJMN,
& RTRJMX, ENERGY, ERGOLD, ERGPRD, ERGPRO, STPNRM,
& STPNRO, GRADNM, THRERG, GRDTHR, THRSTP, THRSYM,
& EVLINI, DISPLA, STPDIA(8*MXCENT),
& STPSYM(8*MXCENT), STPINT(8*MXCENT),
& GRDDIA(8*MXCENT), EVAL(8*MXCENT),
& EVALOL(8*MXCENT), GRDINT(8*MXCENT),
& CRDIN1(8*MXCENT), CRDINT(8*MXCENT),
& CNDHES(0:7), INDHES(0:7), INTCRD(8*MXCENT,6),
& ICONF(0:5), ICNSTR(8*MXCENT), ISTBLZ,
& IAUXRD, ITOTRJ, KEPTIT, NSPMOD, NCNSTP,
& INDTOT, ITRNMR, ITRMAX, MAXREJ, IPRINT, NCRTOT,
& NCART, NPROJ, NTMAT, IINTCR, IREDIC, ICRTCR,
& ICONDI, ITRBRK, NUMPRE, IPRE, PREBTX(MAXPRE),
& SPBSTX, GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM,
& DOSPE, DOPRE, FINPRE, VRML, VRBOND, VREIGV,
& VRCORD, VRVIBA, VRSYMM, VISUAL, INITHS, HSFILE,
& BFGSR1, STEEPD, RANKON, PSB , DFP, BFGS,
& SCHLEG, NEWTON, QUADSD, KEEPHE, BAKER, REDINT,
& CARTCO, INRDHS, FSTORD, SNDORD, REJINI, GRDINI,
& MULTI, CHGRDT, CONOPT, MODHES, INMDHS, FINDRE,
& TRSTRG, RATFUN, GDIIS, DELINT, RSTARR, LNSRCH,
& SADDLE, REBILD, BOFILL, CMBMOD, HFPROP, CONFRM,
& NOAUX, NODIHE, LINDHD
# 54 "abavrml.F" 2
# 1 "../include/gnrinf.h" 1
c -*- mode: fortran; fortran-continuation-string: "&" -*-
c File: gnrinf.h -- general information for DALTON
c
LOGICAL TESTIN, OPTWLK, RNHERM, RNSIRI, RNABAC, GEOCNV,
& HRINPC, SRINPC, RDINPC, RDMLIN, PARCAL, DIRCAL,
& WRINDX, WLKREJ, WALKIN, RNRESP, USRIPR, SEGBAS,
& DOCCSD, OPTNEW, NEWSYM, NEWBAS, NEWPRP, RELCAL,
& TOTSYM, NMWALK, DKTRAN, GEOALL, WESTA, SEGAUX
COMMON /GNRINF/ GRADML, PANAS, TESTIN, OPTWLK, RNHERM,
& RNSIRI, RNABAC, GEOCNV, HRINPC, SRINPC, RDINPC,
& RDMLIN, PARCAL, DIRCAL, KCHARG, WRINDX,
& WLKREJ, WALKIN, RNRESP, USRIPR, ITERNR,
& ITERMX, IPRUSR, SEGBAS, DOCCSD, OPTNEW, NEWSYM,
& LENBAS, NEWBAS, NEWPRP, RELCAL, TOTSYM, NMWALK,
& DKTRAN, GEOALL, WESTA, SEGAUX
INTEGER LBASDIR
PARAMETER (LBASDIR = 600)
CHARACTER*(LBASDIR) BASDIR
COMMON /GNRCHR/ BASDIR
# 55 "abavrml.F" 2
# 1 "../include/cbiwlk.h" 1
PARAMETER (MAXTMP = 20)
LOGICAL WFPRED, REJECT, KEEPSY, VIBCNV,
* START, DOREPW, IMAGE, STRICT, NOORTH, NATCON, V3CAL,
* VIBAVE, NMODIF, ECKART, DOTEMP, DOCENT, REUSED
COMMON /CBIWLK/ TOLST, TRUSTR, TRUSTI, TRUSTD,
& REJMIN, REJMAX, RTRMIN, RTRGOD,
& XMXNUC, ZERGRD, DISPLC,
& STRMOM(3*MXCENT), ECKGEO(3,MXCOOR),
& SCALCO(3,MXCENT), THRLDP, ANHFAC, TRUMAX,
& ISTMOM(3*MXCENT), NSTMOM,
& IPRWLK, IWKTYP, IWKIND, IMODE, ISCTYP,
& IPART(MXCENT), DOREPW(0:7),
& NZEROG, IZEROG(MXCOOR), START,
& WFPRED, REJECT, KEEPSY, VIBCNV,
& IMAGE, STRICT,
& NOORTH, NATCON, V3CAL, VIBAVE, NMODIF,
& ECKART, DOTEMP, DOCENT, TEMP(MAXTMP), NTEMP,
& REUSED
# 56 "abavrml.F" 2
# 1 "../include/priunit.h" 1
C FILE: priunit.h
INTEGER LUCMD, LUPRI, LUERR , LUW4, NINFO, NWARN, IPRERR
COMMON /PRIUNT/ LUCMD, LUPRI, LUERR, LUW4, NINFO, NWARN, IPRERR
# 57 "abavrml.F" 2
# 1 "../include/symmet.h" 1
INTEGER MAXREP, MAXOPR, MULT, ISYMAX, ISYMAO, NPARSU,
& NAOS, NPARNU, IPTSYM, IPTCNT, NCRREP, IPTCOR,
& NAXREP, IPTAX, IPTXYZ, IPTNUC, ISOP,
& NROTS, NINVC, NREFL, IXVAL, NCOS, ICLASS, ICNTAO
DOUBLE PRECISION FMULT, PT
COMMON /SYMMET/ FMULT(0:7), PT(0:7), MAXREP, MAXOPR, MULT(0:7),
& ISYMAX(3,2), ISYMAO(MXQN,MXAQN), NPARSU(8),
& NAOS(8), NPARNU(8,8), IPTSYM(MXCORB,0:7),
& IPTCNT(3*MXCENT,0:7,2), NCRREP(0:7,2),
& IPTCOR(3*MXCENT,2), NAXREP(0:7,2), IPTAX(3,2),
& IPTXYZ(3,0:7,2), IPTNUC(MXCENT,0:7),ISOP(0:7),
& NROTS,NINVC,NREFL,IXVAL(0:7,0:7),NCOS(8,2),
& ICLASS(MXCORB), ICNTAO(MXCORB)
# 58 "abavrml.F" 2
LOGICAL LAST
DIMENSION ATMARR(MXCENT,8), EVEC(IEDIM,IEDIM)
DIMENSION EVC1(MXCOOR), EVC2(MXCOOR)
CHARACTER*12 FILENM
# 1 "../include/ibtfun.h" 1
IBTAND(I,J) = IAND(I,J)
IBTOR(I,J) = IOR(I,J)
IBTSHL(I,J) = ISHFT(I,J)
IBTSHR(I,J) = ISHFT(I,-J)
IBTXOR(I,J) = IEOR(I,J)
# 63 "abavrml.F" 2
C
C Initialize the ATMARR array. The first index runs over all
C atoms, the second marks the following properties:
C
C 1 - Element number
C 2 - X coordinate of atom
C 3 - Y coordinate of atom
C 4 - Z coordinate of atom
C 5 - Covalent radius
C
CALL ATMINI(ATMARR,IATOM,.FALSE.)
C
C We proceed to open the output-file
C
LUVRML = 0
FILENM = 'first.wrl'
IF (LAST) THEN
LUVRML = 0
FILENM = 'last.wrl'
END IF
CALL VRINI(LUVRML,FILENM)
C
C We create all the atoms
C
INDX = 1
CALL DRWATM(LUVRML,INDX,IATOM,.FALSE.,ATMARR)
C
C Then we draw bonds between the atoms if this is requested.
C
IF (VRBOND) CALL DRWBND(LUVRML,INDX,IATOM,.FALSE.,ATMARR)
C
C If the coordinate axes are requested they're drawn
C
IF (VRCORD) CALL DRWAXS(LUVRML,INDX,IATOM,ATMARR,EVEC)
CALL VREND(LUVRML)
C
C Finally all eigenvectors are visualized
C
IF (VREIGV) THEN
LUVRML = 0
IEIG = 1
IEVEC = 1
IF (IPRINT .GT. 0) THEN
WRITE(LUPRI,*)
CALL HEADER('VRML Visualization of Eigenvectors',-1)
WRITE(LUPRI,'(A)')
& ' Eig.Vec. Filename Symmetry Eig.Value '
WRITE(LUPRI,'(A)')
& '----------------------------------------------------'
END IF
C
C We loop over all symmetries...
C
DO 30 IREP = 0, MAXREP
IF (DOREPW(IREP)) THEN
II = 0
NCR = NCRREP(IREP,1)
DO 35 I = 0, IREP - 1
II = II + NCRREP(I,1)
35 CONTINUE
C
C ... and all vectors in each symmetry
C
DO 40 IVEC = 1, NCR
C
C Only eigenvectors with a non-zero eigenvalue is visualized,
C that is only the eigenvectors associated with.
C
IF (EVAL(IEVEC+IVEC-1) .GT. 1.0D-3) THEN
DO 50 I = 1, NCR
EVC1(I) = EVEC(II+I,II+IVEC)
50 CONTINUE
INDX = 1
FILENM = 'eigv_XXX.wrl'
WRITE(FILENM(6:8),'(I3)') IEIG
IF (IEIG .LT. 100) WRITE(FILENM(6:6),'(A1)') '0'
IF (IEIG .LT. 10) WRITE(FILENM(7:7),'(A1)') '0'
CALL VRINI(LUVRML,FILENM)
CALL DRWATM(LUVRML,INDX,IATOM,.TRUE.,ATMARR)
IF (VRBOND)
& CALL DRWBND(LUVRML,INDX,IATOM,.TRUE.,ATMARR)
CALL DRWEIG(LUVRML,INDX,ATMARR,EVC1,EVC2,IREP,NCR)
CALL VREND(LUVRML)
IF (IPRINT .GT. 0) THEN
WRITE(LUPRI,'(I5,A,A12,A,I1,A,F16.6)')
& IEIG,' ',FILENM,' ',
& IREP,' ',EVAL(IEVEC+IVEC-1)
END IF
IEIG = IEIG + 1
END IF
40 CONTINUE
END IF
IEVEC = IEVEC + NCRREP(IREP,1)
30 CONTINUE
END IF
RETURN
END
C
SUBROUTINE MKVRVB(NCORD,IATOM,GVEC,EVEC,ATCHRG,
& MODENR,FREQ,WORK,LWORK)
C
C Make VRML representation of symmetry elements.
C
# 1 "../include/implicit.h" 1
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
# 168 "abavrml.F" 2
# 1 "../include/mxcent.h" 1
C
C file: mxcent.h
C
C MXCENT = max number of nuclei + point charges + ghost orbital centers
C
C IF you change MXCENT you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXCENT, MXCOOR
PARAMETER (MXCENT = 120, MXCOOR = 3*MXCENT)
# 169 "abavrml.F" 2
# 1 "../include/maxorb.h" 1
C
C File: maxorb.h
C
C MXSHEL = maximum number of shells (insert shell definition here).
C MXPRIM = maximum number of primitives.
C MXCORB = maximum number of orbitals (possibly contracted).
C MAXOCC = maximum number of occupied orbitals
C
C IF you change any of these parameters you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXSHEL, MXPRIM, MXCORB, MXORBT, MAXOCC
PARAMETER (MXSHEL = 750, MXPRIM = 4000, MXCORB = 1200,
* MAXOCC = 400, MXORBT = MXCORB*(MXCORB + 1)/2)
# 170 "abavrml.F" 2
# 1 "../include/priunit.h" 1
C FILE: priunit.h
INTEGER LUCMD, LUPRI, LUERR , LUW4, NINFO, NWARN, IPRERR
COMMON /PRIUNT/ LUCMD, LUPRI, LUERR, LUW4, NINFO, NWARN, IPRERR
# 171 "abavrml.F" 2
DIMENSION GVEC(NCORD), EVEC(NCORD), ATCHRG(NCORD), WORK(LWORK)
KATMAR = 1
KLAST = KATMAR + 8*MXCENT
IF (KLAST .GT. LWORK) CALL STOPIT('MKVRVB',' ',KLAST,LWORK)
CALL MKVRV1(NCORD,IATOM,GVEC,EVEC,ATCHRG,MODENR,FREQ,
& WORK(KATMAR))
RETURN
END
C
SUBROUTINE MKVRV1(NCORD,IATOM,GVEC,EVEC,ATCHRG,
& MODENR,FREQ,ATMARR)
C
C Punch out geometry to VRML-file
C
# 1 "../include/implicit.h" 1
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
# 187 "abavrml.F" 2
# 1 "../include/mxcent.h" 1
C
C file: mxcent.h
C
C MXCENT = max number of nuclei + point charges + ghost orbital centers
C
C IF you change MXCENT you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXCENT, MXCOOR
PARAMETER (MXCENT = 120, MXCOOR = 3*MXCENT)
# 188 "abavrml.F" 2
# 1 "../include/maxorb.h" 1
C
C File: maxorb.h
C
C MXSHEL = maximum number of shells (insert shell definition here).
C MXPRIM = maximum number of primitives.
C MXCORB = maximum number of orbitals (possibly contracted).
C MAXOCC = maximum number of occupied orbitals
C
C IF you change any of these parameters you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXSHEL, MXPRIM, MXCORB, MXORBT, MAXOCC
PARAMETER (MXSHEL = 750, MXPRIM = 4000, MXCORB = 1200,
* MAXOCC = 400, MXORBT = MXCORB*(MXCORB + 1)/2)
# 189 "abavrml.F" 2
# 1 "../include/maxaqn.h" 1
INTEGER MXQN, MXAQN
PARAMETER (MXQN=7, MXAQN=MXQN*(MXQN+1)/2)
# 190 "abavrml.F" 2
# 1 "../include/nuclei.h" 1
INTEGER NUCPRE, NUCNUM, NUCDEG, ISTBNU,
& NUCIND, NUCDEP, NTRACO, ITRACO, NATOMS, NFLOAT,
& NBASIS, NLARGE, NSMALL, NPBAS, NPLRG, NPSML,
& NCHTOT, INCENT, INUNIQ, NDEGNM, ISOTOP, IZATOM,
& NBASISAUX, NPBASAUX, NAUX, NPAUX
DOUBLE PRECISION CHARGE, CORD, GNUEXP
LOGICAL NOORBT,GAUNUC
COMMON /NUCLEI/ CHARGE(MXCENT), CORD(3,MXCENT), GNUEXP(MXCENT),
& GAUNUC, NOORBT(MXCENT), NUCPRE(MXCENT),
& NUCNUM(MXCENT,8), NUCDEG(MXCENT), ISTBNU(MXCENT),
& NDEGNM(MXCENT), NUCIND, NUCDEP, NTRACO, ITRACO(3),
& NATOMS, NFLOAT, NBASIS, NLARGE, NSMALL, NPBAS,
& NPLRG, NPSML, NCHTOT, INCENT(MXCENT),
& INUNIQ(MXCENT), ISOTOP(MXCENT),IZATOM(MXCENT),
& NBASISAUX, NPBASAUX, NAUX, NPAUX
CHARACTER NAMEX*6, NAMDEP*6, NAMDPX*8, NAMN*4
COMMON /NUCLEC/ NAMEX(MXCOOR), NAMDEP(MXCENT), NAMDPX(MXCOOR),
& NAMN(MXCENT)
INTEGER MULBSI
COMMON /MULBAS/ MULBSI(MXCENT)
C MULBAS has been added for multiple basis sets (WK/UniKA/31-10-2002).
# 191 "abavrml.F" 2
# 1 "../include/molinp.h" 1
PARAMETER (KMLINE = 2000)
CHARACTER*80 MLINE
COMMON /MOLINC/ MLINE(KMLINE)
COMMON /MOLINP/ NMLINE,NCLINE(MXCENT),NMLAU
# 192 "abavrml.F" 2
# 1 "../include/optinf.h" 1
C
C File: optinf.h
C
C Information for geometry optimization
C controlled in abaopt.F, abaop2.F, and abarint.F
C
PARAMETER (MAXPRE = 10)
CHARACTER*80 SPBSTX, PREBTX
LOGICAL GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM, DOSPE, DOPRE,
& FINPRE, VRML, VRBOND, VREIGV, VRCORD, VRVIBA,
& VRSYMM, VISUAL, BOFILL, INITHS, HSFILE, BFGSR1,
& STEEPD, RANKON, PSB, DFP, BFGS, SCHLEG,
& NEWTON, QUADSD, KEEPHE, BAKER, REDINT, CARTCO,
& INRDHS, FSTORD, SNDORD, REJINI, GRDINI, MULTI,
& CHGRDT, CONOPT, MODHES, INMDHS, FINDRE, TRSTRG,
& RATFUN, GDIIS, DELINT, RSTARR, LNSRCH, SADDLE,
& REBILD, CMBMOD, HFPROP, CONFRM, NOAUX, NODIHE,
& LINDHD
COMMON /OPTINF/ TRSTRA, TRSTIN, TRSTDE, RTENBD, RTENGD, RTRJMN,
& RTRJMX, ENERGY, ERGOLD, ERGPRD, ERGPRO, STPNRM,
& STPNRO, GRADNM, THRERG, GRDTHR, THRSTP, THRSYM,
& EVLINI, DISPLA, STPDIA(8*MXCENT),
& STPSYM(8*MXCENT), STPINT(8*MXCENT),
& GRDDIA(8*MXCENT), EVAL(8*MXCENT),
& EVALOL(8*MXCENT), GRDINT(8*MXCENT),
& CRDIN1(8*MXCENT), CRDINT(8*MXCENT),
& CNDHES(0:7), INDHES(0:7), INTCRD(8*MXCENT,6),
& ICONF(0:5), ICNSTR(8*MXCENT), ISTBLZ,
& IAUXRD, ITOTRJ, KEPTIT, NSPMOD, NCNSTP,
& INDTOT, ITRNMR, ITRMAX, MAXREJ, IPRINT, NCRTOT,
& NCART, NPROJ, NTMAT, IINTCR, IREDIC, ICRTCR,
& ICONDI, ITRBRK, NUMPRE, IPRE, PREBTX(MAXPRE),
& SPBSTX, GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM,
& DOSPE, DOPRE, FINPRE, VRML, VRBOND, VREIGV,
& VRCORD, VRVIBA, VRSYMM, VISUAL, INITHS, HSFILE,
& BFGSR1, STEEPD, RANKON, PSB , DFP, BFGS,
& SCHLEG, NEWTON, QUADSD, KEEPHE, BAKER, REDINT,
& CARTCO, INRDHS, FSTORD, SNDORD, REJINI, GRDINI,
& MULTI, CHGRDT, CONOPT, MODHES, INMDHS, FINDRE,
& TRSTRG, RATFUN, GDIIS, DELINT, RSTARR, LNSRCH,
& SADDLE, REBILD, BOFILL, CMBMOD, HFPROP, CONFRM,
& NOAUX, NODIHE, LINDHD
# 193 "abavrml.F" 2
# 1 "../include/gnrinf.h" 1
c -*- mode: fortran; fortran-continuation-string: "&" -*-
c File: gnrinf.h -- general information for DALTON
c
LOGICAL TESTIN, OPTWLK, RNHERM, RNSIRI, RNABAC, GEOCNV,
& HRINPC, SRINPC, RDINPC, RDMLIN, PARCAL, DIRCAL,
& WRINDX, WLKREJ, WALKIN, RNRESP, USRIPR, SEGBAS,
& DOCCSD, OPTNEW, NEWSYM, NEWBAS, NEWPRP, RELCAL,
& TOTSYM, NMWALK, DKTRAN, GEOALL, WESTA, SEGAUX
COMMON /GNRINF/ GRADML, PANAS, TESTIN, OPTWLK, RNHERM,
& RNSIRI, RNABAC, GEOCNV, HRINPC, SRINPC, RDINPC,
& RDMLIN, PARCAL, DIRCAL, KCHARG, WRINDX,
& WLKREJ, WALKIN, RNRESP, USRIPR, ITERNR,
& ITERMX, IPRUSR, SEGBAS, DOCCSD, OPTNEW, NEWSYM,
& LENBAS, NEWBAS, NEWPRP, RELCAL, TOTSYM, NMWALK,
& DKTRAN, GEOALL, WESTA, SEGAUX
INTEGER LBASDIR
PARAMETER (LBASDIR = 600)
CHARACTER*(LBASDIR) BASDIR
COMMON /GNRCHR/ BASDIR
# 194 "abavrml.F" 2
# 1 "../include/cbiwlk.h" 1
PARAMETER (MAXTMP = 20)
LOGICAL WFPRED, REJECT, KEEPSY, VIBCNV,
* START, DOREPW, IMAGE, STRICT, NOORTH, NATCON, V3CAL,
* VIBAVE, NMODIF, ECKART, DOTEMP, DOCENT, REUSED
COMMON /CBIWLK/ TOLST, TRUSTR, TRUSTI, TRUSTD,
& REJMIN, REJMAX, RTRMIN, RTRGOD,
& XMXNUC, ZERGRD, DISPLC,
& STRMOM(3*MXCENT), ECKGEO(3,MXCOOR),
& SCALCO(3,MXCENT), THRLDP, ANHFAC, TRUMAX,
& ISTMOM(3*MXCENT), NSTMOM,
& IPRWLK, IWKTYP, IWKIND, IMODE, ISCTYP,
& IPART(MXCENT), DOREPW(0:7),
& NZEROG, IZEROG(MXCOOR), START,
& WFPRED, REJECT, KEEPSY, VIBCNV,
& IMAGE, STRICT,
& NOORTH, NATCON, V3CAL, VIBAVE, NMODIF,
& ECKART, DOTEMP, DOCENT, TEMP(MAXTMP), NTEMP,
& REUSED
# 195 "abavrml.F" 2
# 1 "../include/priunit.h" 1
C FILE: priunit.h
INTEGER LUCMD, LUPRI, LUERR , LUW4, NINFO, NWARN, IPRERR
COMMON /PRIUNT/ LUCMD, LUPRI, LUERR, LUW4, NINFO, NWARN, IPRERR
# 196 "abavrml.F" 2
# 1 "../include/symmet.h" 1
INTEGER MAXREP, MAXOPR, MULT, ISYMAX, ISYMAO, NPARSU,
& NAOS, NPARNU, IPTSYM, IPTCNT, NCRREP, IPTCOR,
& NAXREP, IPTAX, IPTXYZ, IPTNUC, ISOP,
& NROTS, NINVC, NREFL, IXVAL, NCOS, ICLASS, ICNTAO
DOUBLE PRECISION FMULT, PT
COMMON /SYMMET/ FMULT(0:7), PT(0:7), MAXREP, MAXOPR, MULT(0:7),
& ISYMAX(3,2), ISYMAO(MXQN,MXAQN), NPARSU(8),
& NAOS(8), NPARNU(8,8), IPTSYM(MXCORB,0:7),
& IPTCNT(3*MXCENT,0:7,2), NCRREP(0:7,2),
& IPTCOR(3*MXCENT,2), NAXREP(0:7,2), IPTAX(3,2),
& IPTXYZ(3,0:7,2), IPTNUC(MXCENT,0:7),ISOP(0:7),
& NROTS,NINVC,NREFL,IXVAL(0:7,0:7),NCOS(8,2),
& ICLASS(MXCORB), ICNTAO(MXCORB)
# 197 "abavrml.F" 2
# 1 "../include/codata.h" 1
C
C codata.h revised 1999/04/29 and combined with units.h
C
C
C From
C "CODATA Recommended Values of the Fundamental Physical Constants: 1998"
C Peter J. Mohr and Barry N. Taylor
C Journal of Physical and Chemical Reference Data, Vol. 28, No. 6, 1999
C
C -- Fundamental constants, atomic units, Avogadro''s constant
DOUBLE PRECISION CVEL, ALPHAC, ALPHA2
DOUBLE PRECISION XTANG,XFAMU,ECHARGE,HBAR,XFMOL
DOUBLE PRECISION XTJ,XTKAYS,XTHZ,XTEV,XKJMOL,XKCMOL,XTKJML,
& XTKCML,XTNM,XAJOUL,XTANGM10,XPRTMAS
DOUBLE PRECISION XFSEC,XTKMML,TESLA,AUTK,DEBYE,PMASS,EMASS,CCM
# 1 "../include/pi.h" 1
# 9 "../include/pi.h"
DOUBLE PRECISION PI, SQRTPI, R2PI52
PARAMETER (PI = 3.14159265358979323846D00,
& SQRTPI = 1.77245385090551602730D00,
& R2PI52 = 5.91496717279561287782D00)
C R2PI52 = sqrt(2 * sqrt(PI^5) ) -- used in calc. of 2-el. integrals
# 25 "../include/codata.h" 2
C
PARAMETER ( XTANG = 0.5291772083D0, XFAMU = 1822.88848D0,
& ECHARGE = 1.602176462D-19, HBAR = 1.054571596D-34)
PARAMETER ( XFMOL = 6.02214199D23 )
PARAMETER ( XTANGM10 = XTANG*1.0D-10)
C
PARAMETER ( PMASS = 1.007276470D0, EMASS = 9.10938188D-31)
C
# 1 "../include/alphac.h" 1
C
C Fine structure constant
C
PARAMETER (CCM = 299792458.0D0)
PARAMETER (CVEL = CCM*XTANGM10*EMASS/(HBAR))
PARAMETER (ALPHAC = 1.0D0/CVEL, ALPHA2 = ALPHAC*ALPHAC)
# 34 "../include/codata.h" 2
C -- conversion from hartree (au) to:
PARAMETER ( XTJ = HBAR**2/(XTANGM10*XTANGM10*EMASS),
& XTHZ = HBAR/(2.0D0*PI*XTANGM10*XTANGM10*EMASS),
& XTKAYS = 1.0D-2*XTHZ/CCM,
& XTEV = XTJ/ECHARGE,
& XKJMOL = XTJ*XFMOL*1.D-3, XKCMOL = XKJMOL/4.184D0,
& XTKJML = XKJMOL, XTKCML = XKCMOL,
& XTNM = 1.D7/XTKAYS, XAJOUL = 1.0D18*XTJ)
C
C -- other
PARAMETER ( XFSEC = HBAR/XTJ)
PARAMETER ( XTKMML = 974.864D0)
PARAMETER ( TESLA=(XTANG*XTANG*ECHARGE/HBAR)*1.D-20 )
PARAMETER ( AUTK = 3.1577465D5 )
PARAMETER ( DEBYE = ECHARGE*XTANG*CCM*1.D11 )
PARAMETER ( XPRTMAS = 1836.1526675D0 )
C
# 198 "abavrml.F" 2
DIMENSION GVEC(NCORD), EVEC(NCORD), ATCHRG(NCORD)
DIMENSION ATMARR(MXCENT,8)
CHARACTER*12 FILENM
# 1 "../include/ibtfun.h" 1
IBTAND(I,J) = IAND(I,J)
IBTOR(I,J) = IOR(I,J)
IBTSHL(I,J) = ISHFT(I,J)
IBTSHR(I,J) = ISHFT(I,-J)
IBTXOR(I,J) = IEOR(I,J)
# 202 "abavrml.F" 2
C
C This factor is a humble attempt to give the vectors a nice length
C
FAC = 0.5D0*SQRT(1.0D0*NUCDEP)
FAC = 0.25D0*NUCDEP
C
C Initialize the ATMARR array. The first index runs over all
C atoms, the second marks the following properties:
C
C 1 - Element number
C 2 - X coordinate of atom
C 3 - Y coordinate of atom
C 4 - Z coordinate of atom
C 5 - Covalent radius
C 6 - X-component of normal mode vector
C 7 - Y-component of normal mode vector
C 8 - Z-component of normal mode vector
C
DO 10 I = 1, IATOM
ATMARR(I,1) = ATCHRG(I)
DO 12 J = 1, 3
ATMARR(I,J+1) = XTANG*GVEC((I-1)*3+J)
ATMARR(I,J+5) = FAC*EVEC((I-1)*3+J)
12 CONTINUE
ATMARR(I,5) = RADIUS(NINT(ATMARR(I,1)))
10 CONTINUE
C
C We proceed to open the output-file
C
LUVRML = 0
FILENM = 'norm_XXX.wrl'
WRITE(FILENM(6:8),'(I3)') MODENR
IF (MODENR .LT. 100) WRITE(FILENM(6:6),'(A1)') '0'
IF (MODENR .LT. 10) WRITE(FILENM(7:7),'(A1)') '0'
CALL VRINI(LUVRML,FILENM)
C
C We create all the atoms
C
INDX = 1
CALL DRWATM(LUVRML,INDX,IATOM,.TRUE.,ATMARR)
C
C Then we draw bonds between the atoms if this is requested.
C
IF (VRBOND) CALL DRWBND(LUVRML,INDX,IATOM,.TRUE.,ATMARR)
C
C Finally all the vectors are drawn
C
IF ((MODENR .EQ. 1) .AND. (IPRINT .GT. 0)) THEN
CALL HEADER('VRML Visualization of Normal Modes',-1)
WRITE(LUPRI,'(A)')
& ' Nrm.Mode Filename Frequency (cm-1)'
WRITE(LUPRI,'(A)')
& '--------------------------------------------'
END IF
IF (IPRINT .GT. 0) THEN
WRITE(LUPRI,'(I5,A,A12,A,F16.6)')
& MODENR,' ',FILENM,' ',FREQ
END IF
C
C We draw all the white vectors
C
CALL DRWVEC(LUVRML,INDX,IATOM,ATMARR,1)
C
C ... then we turn all the vectors before we draw the black ones.
C
DO 20 I = 1, IATOM
ATMARR(I,6) = -ATMARR(I,6)
ATMARR(I,7) = -ATMARR(I,7)
ATMARR(I,8) = -ATMARR(I,8)
20 CONTINUE
CALL DRWVEC(LUVRML,INDX,IATOM,ATMARR,0)
CALL VREND(LUVRML)
RETURN
END
C
SUBROUTINE MKVRSY(ATM,DRTAXS,MAXAXS,DMRPLN,MAXMIR,WORK,LWORK)
C
C Make VRML representation of symmetry elements.
C
# 1 "../include/implicit.h" 1
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
# 283 "abavrml.F" 2
# 1 "../include/mxcent.h" 1
C
C file: mxcent.h
C
C MXCENT = max number of nuclei + point charges + ghost orbital centers
C
C IF you change MXCENT you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXCENT, MXCOOR
PARAMETER (MXCENT = 120, MXCOOR = 3*MXCENT)
# 284 "abavrml.F" 2
# 1 "../include/maxorb.h" 1
C
C File: maxorb.h
C
C MXSHEL = maximum number of shells (insert shell definition here).
C MXPRIM = maximum number of primitives.
C MXCORB = maximum number of orbitals (possibly contracted).
C MAXOCC = maximum number of occupied orbitals
C
C IF you change any of these parameters you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXSHEL, MXPRIM, MXCORB, MXORBT, MAXOCC
PARAMETER (MXSHEL = 750, MXPRIM = 4000, MXCORB = 1200,
* MAXOCC = 400, MXORBT = MXCORB*(MXCORB + 1)/2)
# 285 "abavrml.F" 2
# 1 "../include/priunit.h" 1
C FILE: priunit.h
INTEGER LUCMD, LUPRI, LUERR , LUW4, NINFO, NWARN, IPRERR
COMMON /PRIUNT/ LUCMD, LUPRI, LUERR, LUW4, NINFO, NWARN, IPRERR
# 286 "abavrml.F" 2
DIMENSION ATM(6,0:MXCENT)
DIMENSION DRTAXS(5,0:MAXAXS), DMRPLN(5,0:MAXMIR)
DIMENSION WORK(LWORK)
KATMAR = 1
KLAST = KATMAR + 8*MXCENT
IF (KLAST .GT. LWORK) CALL STOPIT('MKVRSY',' ',KLAST,LWORK)
CALL MKVRS1(ATM,DRTAXS,MAXAXS,DMRPLN,MAXMIR,
& WORK(KATMAR))
RETURN
END
C
SUBROUTINE MKVRS1(ATM,DRTAXS,MAXAXS,DMRPLN,MAXMIR,ATMARR)
C
C Punch out geometry to VRML-file
C
# 1 "../include/implicit.h" 1
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
# 303 "abavrml.F" 2
# 1 "../include/mxcent.h" 1
C
C file: mxcent.h
C
C MXCENT = max number of nuclei + point charges + ghost orbital centers
C
C IF you change MXCENT you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXCENT, MXCOOR
PARAMETER (MXCENT = 120, MXCOOR = 3*MXCENT)
# 304 "abavrml.F" 2
# 1 "../include/maxorb.h" 1
C
C File: maxorb.h
C
C MXSHEL = maximum number of shells (insert shell definition here).
C MXPRIM = maximum number of primitives.
C MXCORB = maximum number of orbitals (possibly contracted).
C MAXOCC = maximum number of occupied orbitals
C
C IF you change any of these parameters you should do a "make depend"
C and then rebuild the program using the command "make".
C
INTEGER MXSHEL, MXPRIM, MXCORB, MXORBT, MAXOCC
PARAMETER (MXSHEL = 750, MXPRIM = 4000, MXCORB = 1200,
* MAXOCC = 400, MXORBT = MXCORB*(MXCORB + 1)/2)
# 305 "abavrml.F" 2
# 1 "../include/maxaqn.h" 1
INTEGER MXQN, MXAQN
PARAMETER (MXQN=7, MXAQN=MXQN*(MXQN+1)/2)
# 306 "abavrml.F" 2
# 1 "../include/nuclei.h" 1
INTEGER NUCPRE, NUCNUM, NUCDEG, ISTBNU,
& NUCIND, NUCDEP, NTRACO, ITRACO, NATOMS, NFLOAT,
& NBASIS, NLARGE, NSMALL, NPBAS, NPLRG, NPSML,
& NCHTOT, INCENT, INUNIQ, NDEGNM, ISOTOP, IZATOM,
& NBASISAUX, NPBASAUX, NAUX, NPAUX
DOUBLE PRECISION CHARGE, CORD, GNUEXP
LOGICAL NOORBT,GAUNUC
COMMON /NUCLEI/ CHARGE(MXCENT), CORD(3,MXCENT), GNUEXP(MXCENT),
& GAUNUC, NOORBT(MXCENT), NUCPRE(MXCENT),
& NUCNUM(MXCENT,8), NUCDEG(MXCENT), ISTBNU(MXCENT),
& NDEGNM(MXCENT), NUCIND, NUCDEP, NTRACO, ITRACO(3),
& NATOMS, NFLOAT, NBASIS, NLARGE, NSMALL, NPBAS,
& NPLRG, NPSML, NCHTOT, INCENT(MXCENT),
& INUNIQ(MXCENT), ISOTOP(MXCENT),IZATOM(MXCENT),
& NBASISAUX, NPBASAUX, NAUX, NPAUX
CHARACTER NAMEX*6, NAMDEP*6, NAMDPX*8, NAMN*4
COMMON /NUCLEC/ NAMEX(MXCOOR), NAMDEP(MXCENT), NAMDPX(MXCOOR),
& NAMN(MXCENT)
INTEGER MULBSI
COMMON /MULBAS/ MULBSI(MXCENT)
C MULBAS has been added for multiple basis sets (WK/UniKA/31-10-2002).
# 307 "abavrml.F" 2
# 1 "../include/molinp.h" 1
PARAMETER (KMLINE = 2000)
CHARACTER*80 MLINE
COMMON /MOLINC/ MLINE(KMLINE)
COMMON /MOLINP/ NMLINE,NCLINE(MXCENT),NMLAU
# 308 "abavrml.F" 2
# 1 "../include/optinf.h" 1
C
C File: optinf.h
C
C Information for geometry optimization
C controlled in abaopt.F, abaop2.F, and abarint.F
C
PARAMETER (MAXPRE = 10)
CHARACTER*80 SPBSTX, PREBTX
LOGICAL GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM, DOSPE, DOPRE,
& FINPRE, VRML, VRBOND, VREIGV, VRCORD, VRVIBA,
& VRSYMM, VISUAL, BOFILL, INITHS, HSFILE, BFGSR1,
& STEEPD, RANKON, PSB, DFP, BFGS, SCHLEG,
& NEWTON, QUADSD, KEEPHE, BAKER, REDINT, CARTCO,
& INRDHS, FSTORD, SNDORD, REJINI, GRDINI, MULTI,
& CHGRDT, CONOPT, MODHES, INMDHS, FINDRE, TRSTRG,
& RATFUN, GDIIS, DELINT, RSTARR, LNSRCH, SADDLE,
& REBILD, CMBMOD, HFPROP, CONFRM, NOAUX, NODIHE,
& LINDHD
COMMON /OPTINF/ TRSTRA, TRSTIN, TRSTDE, RTENBD, RTENGD, RTRJMN,
& RTRJMX, ENERGY, ERGOLD, ERGPRD, ERGPRO, STPNRM,
& STPNRO, GRADNM, THRERG, GRDTHR, THRSTP, THRSYM,
& EVLINI, DISPLA, STPDIA(8*MXCENT),
& STPSYM(8*MXCENT), STPINT(8*MXCENT),
& GRDDIA(8*MXCENT), EVAL(8*MXCENT),
& EVALOL(8*MXCENT), GRDINT(8*MXCENT),
& CRDIN1(8*MXCENT), CRDINT(8*MXCENT),
& CNDHES(0:7), INDHES(0:7), INTCRD(8*MXCENT,6),
& ICONF(0:5), ICNSTR(8*MXCENT), ISTBLZ,
& IAUXRD, ITOTRJ, KEPTIT, NSPMOD, NCNSTP,
& INDTOT, ITRNMR, ITRMAX, MAXREJ, IPRINT, NCRTOT,
& NCART, NPROJ, NTMAT, IINTCR, IREDIC, ICRTCR,
& ICONDI, ITRBRK, NUMPRE, IPRE, PREBTX(MAXPRE),
& SPBSTX, GECONV, NOTRST, NOBRKS, BRKSYM, NWSYMM,
& DOSPE, DOPRE, FINPRE, VRML, VRBOND, VREIGV,
& VRCORD, VRVIBA, VRSYMM, VISUAL, INITHS, HSFILE,
& BFGSR1, STEEPD, RANKON, PSB , DFP, BFGS,
& SCHLEG, NEWTON, QUADSD, KEEPHE, BAKER, REDINT,
& CARTCO, INRDHS, FSTORD, SNDORD, REJINI, GRDINI,
& MULTI, CHGRDT, CONOPT, MODHES, INMDHS, FINDRE,
& TRSTRG, RATFUN, GDIIS, DELINT, RSTARR, LNSRCH,
& SADDLE, REBILD, BOFILL, CMBMOD, HFPROP, CONFRM,
& NOAUX, NODIHE, LINDHD
# 309 "abavrml.F" 2
# 1 "../include/gnrinf.h" 1
c -*- mode: fortran; fortran-continuation-string: "&" -*-
c File: gnrinf.h -- general information for DALTON
c
LOGICAL TESTIN, OPTWLK, RNHERM, RNSIRI, RNABAC, GEOCNV,
& HRINPC, SRINPC, RDINPC, RDMLIN, PARCAL, DIRCAL,
& WRINDX, WLKREJ, WALKIN, RNRESP, USRIPR, SEGBAS,
& DOCCSD, OPTNEW, NEWSYM, NEWBAS, NEWPRP, RELCAL,
& TOTSYM, NMWALK, DKTRAN, GEOALL, WESTA, SEGAUX
COMMON /GNRINF/ GRADML, PANAS, TESTIN, OPTWLK, RNHERM,
& RNSIRI, RNABAC, GEOCNV, HRINPC, SRINPC, RDINPC,
& RDMLIN, PARCAL, DIRCAL, KCHARG, WRINDX,
& WLKREJ, WALKIN, RNRESP, USRIPR, ITERNR,
& ITERMX, IPRUSR, SEGBAS, DOCCSD, OPTNEW, NEWSYM,
& LENBAS, NEWBAS, NEWPRP, RELCAL, TOTSYM, NMWALK,
& DKTRAN, GEOALL, WESTA, SEGAUX
INTEGER LBASDIR
PARAMETER (LBASDIR = 600)
CHARACTER*(LBASDIR) BASDIR
COMMON /GNRCHR/ BASDIR
# 310 "abavrml.F" 2
# 1 "../include/cbiwlk.h" 1
PARAMETER (MAXTMP = 20)
LOGICAL WFPRED, REJECT, KEEPSY, VIBCNV,
* START, DOREPW, IMAGE, STRICT, NOORTH, NATCON, V3CAL,
* VIBAVE, NMODIF, ECKART, DOTEMP, DOCENT, REUSED
COMMON /CBIWLK/ TOLST, TRUSTR, TRUSTI, TRUSTD,
& REJMIN, REJMAX, RTRMIN, RTRGOD,
& XMXNUC, ZERGRD, DISPLC,
& STRMOM(3*MXCENT), ECKGEO(3,MXCOOR),
& SCALCO(3,MXCENT), THRLDP, ANHFAC, TRUMAX,
& ISTMOM(3*MXCENT), NSTMOM,
& IPRWLK, IWKTYP, IWKIND, IMODE, ISCTYP,
& IPART(MXCENT), DOREPW(0:7),
& NZEROG, IZEROG(MXCOOR), START,
& WFPRED, REJECT, KEEPSY, VIBCNV,
& IMAGE, STRICT,
& NOORTH, NATCON, V3CAL, VIBAVE, NMODIF,
& ECKART, DOTEMP, DOCENT, TEMP(MAXTMP), NTEMP,
& REUSED
# 311 "abavrml.F" 2
# 1 "../include/priunit.h" 1
C FILE: priunit.h
INTEGER LUCMD, LUPRI, LUERR , LUW4, NINFO, NWARN, IPRERR
COMMON /PRIUNT/ LUCMD, LUPRI, LUERR, LUW4, NINFO, NWARN, IPRERR
# 312 "abavrml.F" 2
# 1 "../include/symmet.h" 1
INTEGER MAXREP, MAXOPR, MULT, ISYMAX, ISYMAO, NPARSU,
& NAOS, NPARNU, IPTSYM, IPTCNT, NCRREP, IPTCOR,
& NAXREP, IPTAX, IPTXYZ, IPTNUC, ISOP,
& NROTS, NINVC, NREFL, IXVAL, NCOS, ICLASS, ICNTAO
DOUBLE PRECISION FMULT, PT
COMMON /SYMMET/ FMULT(0:7), PT(0:7), MAXREP, MAXOPR, MULT(0:7),
& ISYMAX(3,2), ISYMAO(MXQN,MXAQN), NPARSU(8),
& NAOS(8), NPARNU(8,8), IPTSYM(MXCORB,0:7),
& IPTCNT(3*MXCENT,0:7,2), NCRREP(0:7,2),
& IPTCOR(3*MXCENT,2), NAXREP(0:7,2), IPTAX(3,2),
& IPTXYZ(3,0:7,2), IPTNUC(MXCENT,0:7),ISOP(0:7),
& NROTS,NINVC,NREFL,IXVAL(0:7,0:7),NCOS(8,2),
& ICLASS(MXCORB), ICNTAO(MXCORB)
# 313 "abavrml.F" 2
# 1 "../include/codata.h" 1
C
C codata.h revised 1999/04/29 and combined with units.h
C
C
C From
C "CODATA Recommended Values of the Fundamental Physical Constants: 1998"
C Peter J. Mohr and Barry N. Taylor
C Journal of Physical and Chemical Reference Data, Vol. 28, No. 6, 1999
C
C -- Fundamental constants, atomic units, Avogadro''s constant
DOUBLE PRECISION CVEL, ALPHAC, ALPHA2
DOUBLE PRECISION XTANG,XFAMU,ECHARGE,HBAR,XFMOL
DOUBLE PRECISION XTJ,XTKAYS,XTHZ,XTEV,XKJMOL,XKCMOL,XTKJML,
& XTKCML,XTNM,XAJOUL,XTANGM10,XPRTMAS
DOUBLE PRECISION XFSEC,XTKMML,TESLA,AUTK,DEBYE,PMASS,EMASS,CCM
# 1 "../include/pi.h" 1
# 9 "../include/pi.h"
DOUBLE PRECISION PI, SQRTPI, R2PI52
PARAMETER (PI = 3.14159265358979323846D00,
& SQRTPI = 1.77245385090551602730D00,
& R2PI52 = 5.91496717279561287782D00)
C R2PI52 = sqrt(2 * sqrt(PI^5) ) -- used in calc. of 2-el. integrals
# 25 "../include/codata.h" 2
C
PARAMETER ( XTANG = 0.5291772083D0, XFAMU = 1822.88848D0,
& ECHARGE = 1.602176462D-19, HBAR = 1.054571596D-34)
PARAMETER ( XFMOL = 6.02214199D23 )
PARAMETER ( XTANGM10 = XTANG*1.0D-10)
C
PARAMETER ( PMASS = 1.007276470D0, EMASS = 9.10938188D-31)
C
# 1 "../include/alphac.h" 1
C
C Fine structure constant
C
PARAMETER (CCM = 299792458.0D0)
PARAMETER (CVEL = CCM*XTANGM10*EMASS/(HBAR))
PARAMETER (ALPHAC = 1.0D0/CVEL, ALPHA2 = ALPHAC*ALPHAC)
# 34 "../include/codata.h" 2
C -- conversion from hartree (au) to:
PARAMETER ( XTJ = HBAR**2/(XTANGM10*XTANGM10*EMASS),
& XTHZ = HBAR/(2.0D0*PI*XTANGM10*XTANGM10*EMASS),
& XTKAYS = 1.0D-2*XTHZ/CCM,
& XTEV = XTJ/ECHARGE,
& XKJMOL = XTJ*XFMOL*1.D-3, XKCMOL = XKJMOL/4.184D0,
& XTKJML = XKJMOL, XTKCML = XKCMOL,
& XTNM = 1.D7/XTKAYS, XAJOUL = 1.0D18*XTJ)
C
C -- other
PARAMETER ( XFSEC = HBAR/XTJ)
PARAMETER ( XTKMML = 974.864D0)
PARAMETER ( TESLA=(XTANG*XTANG*ECHARGE/HBAR)*1.D-20 )
PARAMETER ( AUTK = 3.1577465D5 )
PARAMETER ( DEBYE = ECHARGE*XTANG*CCM*1.D11 )
PARAMETER ( XPRTMAS = 1836.1526675D0 )
C
# 314 "abavrml.F" 2
DIMENSION ATM(6,0:MXCENT)
DIMENSION DRTAXS(5,0:MAXAXS), DMRPLN(5,0:MAXMIR)
DIMENSION ATMARR(MXCENT,8)
DIMENSION VEC(3)
CHARACTER*12 FILENM
LOGICAL TURN
# 1 "../include/ibtfun.h" 1
IBTAND(I,J) = IAND(I,J)
IBTOR(I,J) = IOR(I,J)
IBTSHL(I,J) = ISHFT(I,J)
IBTSHR(I,J) = ISHFT(I,-J)
IBTXOR(I,J) = IEOR(I,J)
# 321 "abavrml.F" 2
C
C We copy the contents of ATM to ATMARR
C
CALL DZERO(ATMARR,8*MXCENT)
IATOM = NINT(ATM(1,0))
NAXS = NINT(DRTAXS(1,0))
NPLN = NINT(DMRPLN(1,0))
DO 10 I = 1, IATOM
DO 15 J = 1, 3
ATMARR(I,J+1) = ATM(J,I)*XTANG
15 CONTINUE
ATMARR(I,1) = ATM(4,I)
ATMARR(I,5) = RADIUS(NINT(ATMARR(I,1)))
10 CONTINUE
C
C We find the largest coordinate
C
CRDMX = 0.0D0
DO 17 IAT = 1, IATOM
IF (ABS(ATMARR(IAT,2)) .GT. CRDMX) CRDMX = ABS(ATMARR(IAT,2))
IF (ABS(ATMARR(IAT,3)) .GT. CRDMX) CRDMX = ABS(ATMARR(IAT,3))
IF (ABS(ATMARR(IAT,4)) .GT. CRDMX) CRDMX = ABS(ATMARR(IAT,4))
17 CONTINUE
CRDMX = CRDMX + MAX(0.20D0,MIN(1.0D0, 0.25D0*CRDMX))
C
C We proceed to open the output-file
C
LUVRML = 0
FILENM = 'firstsym.wrl'
CALL VRINI(LUVRML,FILENM)
C
C We create all the atoms
C
INDX = 1
CALL DRWATM(LUVRML,INDX,IATOM,.FALSE.,ATMARR)
C
C Then we draw bonds between the atoms if this is requested.
C
IF (VRBOND) CALL DRWBND(LUVRML,INDX,IATOM,.FALSE.,ATMARR)
C
C We draw all the rotational axes. The colour is determined by
C the order:
C 2 - Red
C 3 - Green
C 4 - Blue
C 5 - Orange
C 6 - Yellow
C 7 - Violet
C >7 - Black
C
IF (NPLN .GT. 0) THEN
CALL DZERO(ATMARR,8*MXCENT)
DO 20 II = 1, NPLN
C
C The normalvector is scaled to reflect the size it should have.
C
DO 25 I = 1, 3
ATMARR(II,I+5) = CRDMX*DMRPLN(I,II)
25 CONTINUE
20 CONTINUE
CALL DRWPLN(LUVRML,INDX,NPLN,ATMARR,.TRUE.)
END IF
IF (NAXS .GT. 0) THEN
CRDMX = CRDMX + 0.25D0
DO 30 IORD = NINT(DRTAXS(4,1)),2,-1
CALL DZERO(ATMARR,8*MXCENT)
NVEC = 0
DO 32 II = 1, NAXS
IF (DRTAXS(4,II) .EQ. IORD) THEN
NVEC = NVEC + 1
DO 34 I = 1, 3
VEC(I) = DRTAXS(I,II)
34 CONTINUE
TURN = .FALSE.
C
C All vectors are turned appropriately
C
IF (VEC(1) .LT. 0.0D0) THEN
TURN = .TRUE.
ELSE IF (ABS(VEC(1)) .LT. 1.0D-10) THEN
IF (VEC(2) .LT. 0.0D0) THEN
TURN = .TRUE.
ELSE IF (ABS(VEC(2)) .LT. 1.0D-10) THEN
IF (VEC(3) .LT. 0.0D0) TURN = .TRUE.
END IF
END IF
IF (TURN) THEN
VEC(1) = -VEC(1)
VEC(2) = -VEC(2)
VEC(3) = -VEC(3)
END IF
DO 35 I = 1, 3
ATMARR(NVEC,I+1) = -CRDMX*VEC(I)
ATMARR(NVEC,I+5) = 2.0D0*CRDMX*VEC(I)
35 CONTINUE
END IF
32 CONTINUE
CALL DRWVEC(LUVRML,INDX,NVEC,ATMARR,IORD)
30 CONTINUE
END IF
CALL VREND(LUVRML)
RETURN
END
--
Summary: internal compiler error: in gfc_add_modify
Product: gcc
Version: 4.4.0
Status: UNCONFIRMED
Severity: blocker
Priority: P3
Component: fortran
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: ajs1 at cam dot ac dot uk
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38618
More information about the Gcc-bugs
mailing list