mirror of
https://github.com/nwchemgit/nwchem.git
synced 2026-07-29 06:35:39 -04:00
new geometry printing routines
This commit is contained in:
Ricky Kendall
parent
c0977e2437
commit
ed127de78e
7 changed files with 1601 additions and 507 deletions
|
|
@ -1,6 +1,6 @@
|
|||
logical function raktest(rtdb)
|
||||
implicit none
|
||||
c $Id: raktest.F,v 1.75 1997-12-08 20:09:24 d3e129 Exp $
|
||||
c $Id: raktest.F,v 1.76 1998-01-09 15:25:28 d3e129 Exp $
|
||||
#include "mafdecls.fh"
|
||||
#include "rtdb.fh"
|
||||
#include "context.fh"
|
||||
|
|
@ -3113,13 +3113,6 @@ c
|
|||
#include "geom.fh"
|
||||
#include "stdio.fh"
|
||||
integer rtdb
|
||||
c
|
||||
*rak: logical geom_print_distance
|
||||
*rak: logical geom_print_angles
|
||||
*rak: logical geom_print_dihedrals
|
||||
*rak: external geom_print_distance
|
||||
*rak: external geom_print_angles
|
||||
*rak: external geom_print_dihedrals
|
||||
c
|
||||
integer geom
|
||||
c
|
||||
|
|
@ -3127,12 +3120,12 @@ c
|
|||
& call errquit('raktest_geomprt:create error',911)
|
||||
if (.not.geom_rtdb_load(rtdb,geom,'geometry'))
|
||||
& call errquit('raktest_geomprt:load error',911)
|
||||
*rak: if (.not.geom_print_distance(geom))
|
||||
*rak: & call errquit('raktest_geomprt:print_distance error',911)
|
||||
*rak: if (.not.geom_print_angles(geom))
|
||||
*rak: & call errquit('raktest_geomprt:print_angles error',911)
|
||||
*rak: if (.not.geom_print_dihedrals(geom))
|
||||
*rak: & call errquit('raktest_geomprt:print_dihedrals error',911)
|
||||
if (.not.geom_print_distances(geom))
|
||||
& call errquit('raktest_geomprt:print_distance error',911)
|
||||
if (.not.geom_print_angles(geom))
|
||||
& call errquit('raktest_geomprt:print_angles error',911)
|
||||
if (.not.geom_print_dihedrals(geom))
|
||||
& call errquit('raktest_geomprt:print_dihedrals error',911)
|
||||
if (.not.geom_destroy(geom))
|
||||
& call errquit('raktest_geomprt:destory',911)
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
logical function drv_opt(rtdb)
|
||||
C$Id: opt_drv.F,v 1.37 1997-11-13 23:48:43 d3g681 Exp $
|
||||
C$Id: opt_drv.F,v 1.38 1998-01-09 15:25:31 d3e129 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "rtdb.fh"
|
||||
|
|
@ -68,6 +68,7 @@ c
|
|||
parameter (mxcart=3*mxatom)
|
||||
parameter (mxzmat=1500)
|
||||
parameter (mxcoor=1500)
|
||||
PARAMETER (MXBFN=3072)
|
||||
c mxcoor=max(mxcart,mxzmat)
|
||||
common/hnd_iofile/ir,iw
|
||||
common/hnd_optmiz/x0(mxcoor),x(mxcoor),dx(mxcoor),
|
||||
|
|
@ -83,7 +84,8 @@ c mxcoor=max(mxcart,mxzmat)
|
|||
common/hnd_zmtpar/nzmat,nzvar,nvar
|
||||
common/hnd_molxyz/c(mxcart),zan(mxatom),nat
|
||||
character*16 atmlab
|
||||
common/hnd_mollab/atmlab(mxatom)
|
||||
CHARACTER*8 BFLAB
|
||||
common/hnd_mollab/atmlab(mxatom),BFLAB(MXBFN)
|
||||
dimension t0(mxcoor)
|
||||
data zero /0.0d+00/
|
||||
data pt5 /0.5d+00/
|
||||
|
|
@ -243,10 +245,18 @@ c
|
|||
write(iw,9998)
|
||||
if (.not. geom_print(geom)) call errquit
|
||||
$ ('hnd_opt_drv: geom_print?',0)
|
||||
if (util_print('bonds',print_default))
|
||||
$ call distan(nat,c)
|
||||
if (util_print('angles',print_default))
|
||||
$ call angle(nat,c)
|
||||
*rak: if (util_print('bonds',print_default))
|
||||
*rak: $ call distan(nat,c)
|
||||
*rak: if (util_print('angles',print_default))
|
||||
*rak: $ call angle(nat,c)
|
||||
if (util_print('bonds',print_default)) then
|
||||
if (.not.geom_print_distances(geom)) call errquit(
|
||||
& 'hnd_opt_drv: geom_print_distances failed',911)
|
||||
endif
|
||||
if (util_print('angles',print_default)) then
|
||||
if (.not.geom_print_angles(geom)) call errquit(
|
||||
& 'hnd_opt_drv: geom_print_angles failed',911)
|
||||
endif
|
||||
endif
|
||||
if (.not.geom_destroy(geom))
|
||||
& call errquit('hnd_opt: geom_destroy?', 911)
|
||||
|
|
@ -305,10 +315,18 @@ c
|
|||
write(iw,9998)
|
||||
if (.not. geom_print(geom)) call errquit
|
||||
$ ('hnd_opt_drv: geom_print?',0)
|
||||
if (util_print('bonds',print_default))
|
||||
$ call distan(nat,c)
|
||||
if (util_print('angles',print_default))
|
||||
$ call angle(nat,c)
|
||||
*rak: if (util_print('bonds',print_default))
|
||||
*rak: $ call distan(nat,c)
|
||||
*rak: if (util_print('angles',print_default))
|
||||
*rak: $ call angle(nat,c)
|
||||
if (util_print('bonds',print_default)) then
|
||||
if (.not.geom_print_distances(geom)) call errquit(
|
||||
& 'hnd_opt_drv: geom_print_distances failed',911)
|
||||
endif
|
||||
if (util_print('angles',print_default)) then
|
||||
if (.not.geom_print_angles(geom)) call errquit(
|
||||
& 'hnd_opt_drv: geom_print_angles failed',911)
|
||||
endif
|
||||
endif
|
||||
if (.not.geom_destroy(geom))
|
||||
& call errquit('hnd_opt: geom_destroy?', 911)
|
||||
|
|
|
|||
1958
src/geom/geom.F
1958
src/geom/geom.F
File diff suppressed because it is too large
Load diff
|
|
@ -1,5 +1,5 @@
|
|||
logical geom_check_handle
|
||||
C$Id: geom.fh,v 1.24 1997-10-20 20:28:06 d3g681 Exp $
|
||||
C$Id: geom.fh,v 1.25 1998-01-09 15:25:36 d3e129 Exp $
|
||||
logical geom_check_cent
|
||||
logical geom_rtdb_load
|
||||
logical geom_rtdb_store
|
||||
|
|
@ -66,6 +66,10 @@ c
|
|||
logical geom_ecp_center_list
|
||||
c
|
||||
logical geom_nuc_dipole
|
||||
c
|
||||
logical geom_print_distances
|
||||
logical geom_print_angles
|
||||
logical geom_print_dihedrals
|
||||
c
|
||||
external geom_check_handle
|
||||
external geom_check_cent
|
||||
|
|
@ -131,6 +135,10 @@ c
|
|||
external geom_ecp_center_list
|
||||
c
|
||||
external geom_nuc_dipole
|
||||
c
|
||||
external geom_print_distances
|
||||
external geom_print_angles
|
||||
external geom_print_dihedrals
|
||||
c
|
||||
external geom_get_user_scale
|
||||
external geom_get_user_units
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
SUBROUTINE stpr_output(STEP,COORD,BCKSTP, mxgrad)
|
||||
c $Id: stpr_output.F,v 1.8 1997-03-04 06:07:52 d3e129 Exp $
|
||||
c $Id: stpr_output.F,v 1.9 1998-01-09 15:25:37 d3e129 Exp $
|
||||
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
|
||||
#include "util.fh"
|
||||
#include "mafdecls.fh"
|
||||
|
|
@ -62,7 +62,7 @@ C initial geometry
|
|||
WRITE(6,1005)SLNGTH
|
||||
WRITE(6,1014)E2NEW
|
||||
endif
|
||||
if (util_print('old coords',print_default)) then
|
||||
if (util_print('old coords',print_high)) then
|
||||
C
|
||||
C Write old coordinates.
|
||||
C
|
||||
|
|
@ -72,7 +72,7 @@ C
|
|||
WRITE(6,1017)I,(COORD(J,I),J=1,3)
|
||||
5 CONTINUE
|
||||
endif
|
||||
if (util_print('step', print_default)) then
|
||||
if (util_print('step', print_high)) then
|
||||
C
|
||||
C Write step.
|
||||
C
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
SUBROUTINE stpr_sumstc(STEP,COORD,ATMASS,CMASS,TENIN,CNVGRD)
|
||||
c $Id: stpr_sumstc.F,v 1.4 1995-03-31 01:45:44 d3g681 Exp $
|
||||
c $Id: stpr_sumstc.F,v 1.5 1998-01-09 15:25:38 d3e129 Exp $
|
||||
IMPLICIT REAL*8(A-H,O-Z), INTEGER(I-N)
|
||||
LOGICAL CNVGRD
|
||||
COMMON / CFACE / IWCTR,NATOM,ICALC
|
||||
|
|
@ -23,26 +23,26 @@ C
|
|||
C
|
||||
C Write new coordinates.
|
||||
C
|
||||
if (util_print('new coordinates',print_low)) then
|
||||
IF(CNVGRD)THEN
|
||||
WRITE(6,1003)
|
||||
ELSE
|
||||
WRITE(6,1000)
|
||||
ENDIF
|
||||
WRITE(6,1001)
|
||||
DO 30 I = 1,NATOM
|
||||
WRITE(6,1002)I,(COORD(J,I),J=1,3)
|
||||
30 CONTINUE
|
||||
write(6,*)
|
||||
endif
|
||||
if (util_print('distances',print_default)) then
|
||||
CALL DISTAN(NATOM,COORD)
|
||||
write(6,*)
|
||||
endif
|
||||
if (util_print('angles',print_default)) then
|
||||
CALL ANGLE(NATOM,COORD)
|
||||
write(6,*)
|
||||
endif
|
||||
*rak: if (util_print('new coordinates',print_low)) then
|
||||
*rak: IF(CNVGRD)THEN
|
||||
*rak: WRITE(6,1003)
|
||||
*rak: ELSE
|
||||
*rak: WRITE(6,1000)
|
||||
*rak: ENDIF
|
||||
*rak: WRITE(6,1001)
|
||||
*rak: DO 30 I = 1,NATOM
|
||||
*rak: WRITE(6,1002)I,(COORD(J,I),J=1,3)
|
||||
*rak: 30 CONTINUE
|
||||
*rak: write(6,*)
|
||||
*rak: endif
|
||||
*rak: if (util_print('distances',print_default)) then
|
||||
*rak: CALL DISTAN(NATOM,COORD)
|
||||
*rak: write(6,*)
|
||||
*rak: endif
|
||||
*rak: if (util_print('angles',print_default)) then
|
||||
*rak: CALL ANGLE(NATOM,COORD)
|
||||
*rak: write(6,*)
|
||||
*rak: endif
|
||||
C
|
||||
C Calculate the vector of center of mass and the inertia
|
||||
C tensor for the new geometry.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
integer function stpr_walk(rtdb)
|
||||
c $Id: stpr_walk.F,v 1.31 1997-12-28 10:43:36 d3e129 Exp $
|
||||
c $Id: stpr_walk.F,v 1.32 1998-01-09 15:25:38 d3e129 Exp $
|
||||
implicit none
|
||||
c
|
||||
#include "mafdecls.fh"
|
||||
|
|
@ -14,8 +14,6 @@ c
|
|||
#include "util.fh"
|
||||
#include "stdio.fh"
|
||||
c
|
||||
* logical geom_print_distance, geom_print_angles
|
||||
* external geom_print_distance, geom_print_angles
|
||||
c
|
||||
integer rtdb ! [input] run-time-data-base handle
|
||||
c
|
||||
|
|
@ -182,12 +180,27 @@ c
|
|||
if (.not.geom_rtdb_store(rtdb,geom,new_geom_name))
|
||||
& call errquit
|
||||
& ('stpr_walk: geom_rtdb_store (of copy) failed',911)
|
||||
if (.not.geom_print(geom)) call errquit(
|
||||
& 'stpr_walk: geom_print failed',911)
|
||||
* if (.not.geom_print_distance(geom))call errquit(
|
||||
* & 'stpr_walk: geom_print_distance failed',911)
|
||||
* if (.not.geom_print_angles(geom))call errquit(
|
||||
* & 'stpr_walk: geom_print_angles failed',911)
|
||||
if (util_print('new coordinates',print_low)) then
|
||||
if (lstpr_walk) then
|
||||
write(luout,11001)
|
||||
else
|
||||
write(luout,11002)
|
||||
endif
|
||||
if (.not.geom_print(geom)) call errquit(
|
||||
& 'stpr_walk: geom_print failed',911)
|
||||
endif
|
||||
if (util_print('distances',print_default)) then
|
||||
if (.not.geom_print_distances(geom)) call errquit(
|
||||
& 'stpr_walk: geom_print_distances failed',911)
|
||||
endif
|
||||
if (util_print('angles',print_default)) then
|
||||
if (.not.geom_print_angles(geom)) call errquit(
|
||||
& 'stpr_walk: geom_print_angles failed',911)
|
||||
endif
|
||||
if (util_print('dihedrals',print_default)) then
|
||||
if (.not.geom_print_dihedrals(geom)) call errquit(
|
||||
& 'stpr_walk: geom_print_angles failed',911)
|
||||
endif
|
||||
c
|
||||
C**** #define ECCE
|
||||
#if defined(ECCE)
|
||||
|
|
@ -265,6 +278,8 @@ c
|
|||
call util_print_pop
|
||||
call ga_sync()
|
||||
c
|
||||
11001 format(/,/,/,' ',16('-'),' Converged geometry ',16('-'))
|
||||
11002 format(/,/,/,' ',19('-'),' New geometry ',19('-'))
|
||||
end
|
||||
subroutine stpr_walk_reset
|
||||
implicit none
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue