2 !-----------------------------------------------------------------------------
3 use io_units, only:inp,iout
5 !-----------------------------------------------------------------------------
8 !-----------------------------------------------------------------------------
10 !-----------------------------------------------------------------------------
12 !-----------------------------------------------------------------------------
13 subroutine DJACOB(N,NMAX,MAXJAC,E,A,C,AII)
14 ! IMPLICIT REAL*8 (A-H,O-Z)
15 ! THE JACOBI DIAGONALIZATION PROCEDURE
16 integer :: N,NMAX,MAXJAC
18 real(kind=8),DIMENSION(NMAX,N) :: A,C
19 real(kind=8),DIMENSION(150) :: AJJ !el AII
20 real(kind=8),DIMENSION(*) :: AII
22 integer :: l,i,j,k,IPIV,JPIV,IJAC,LIM,LT,IT,IN
23 real(kind=8) :: e,SIN45,COS45,S45SQ,C45SQ
24 real(kind=8) :: TEMPA,AIJMAX,TAIJ,TAII,TAJJ,TMT
25 real(kind=8) :: ZAMMA,SINT,COST,SINSQ,COSSQ,AIIMIN
26 real(kind=8) :: TAIK,TAJK,TCIK,TCJK,TEST,AMAX,GAMSQ,T
31 ! UNIT EIGENVECTOR MATRIX
38 ! DETERMINATION OF SEARCH ARGUMENT, TEST
47 ! SEARCH FOR LARGEST OFF DIAGONAL ELEMENT
54 IF (AIJMAX-TAIJ) 4,3,3
59 IF(AIJMAX-TEST)300,300,5
60 ! PARAMETERS FOR ROTATION
65 IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6
67 6 ZAMMA=TAIJ/(2.0*TMT)
68 90 IF(DABS(ZAMMA)-0.38268)8,8,9
78 SINT=2.0*ZAMMA/(1.0+GAMSQ)
79 COST = (1.0-GAMSQ)/(1.0+GAMSQ)
86 A(IPIV,K) = TAIK*COST+TAJK*SINT
87 A(JPIV,K) = TAJK*COST-TAIK*SINT
90 C(IPIV,K) = TCIK*COST+TCJK*SINT
91 13 C(JPIV,K) = TCJK*COST-TCIK*SINT
92 A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST
93 A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST
94 A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT
95 A(JPIV,IPIV) = A(IPIV,JPIV)
98 30 A(K,JPIV) = A(JPIV,K)
100 WRITE (IOUT,1000) AIJMAX
101 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE',&
103 ! ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER
111 IF(AJJ(I)-AIIMIN)17,16,16
128 end subroutine DJACOB
129 !-----------------------------------------------------------------------------
130 ! energy_p_new_barrier.F
131 !-----------------------------------------------------------------------------
132 subroutine vecpr(u,v,w)
133 ! implicit real*8(a-h,o-z)
134 real(kind=8),dimension(3) :: u,v,w
135 w(1)=u(2)*v(3)-u(3)*v(2)
136 w(2)=-u(1)*v(3)+u(3)*v(1)
137 w(3)=u(1)*v(2)-u(2)*v(1)
140 !-----------------------------------------------------------------------------
141 real(kind=8) function scalar(u,v)
142 !DIR$ INLINEALWAYS scalar
144 !DEC$ ATTRIBUTES FORCEINLINE::scalar
147 real(kind=8),dimension(3) :: u,v
148 !d double precision sc
156 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
159 !-----------------------------------------------------------------------------
161 !-----------------------------------------------------------------------------
164 ! ###################################################
165 ! ## COPYRIGHT (C) 1990 by Jay William Ponder ##
166 ! ## All Rights Reserved ##
167 ! ###################################################
169 ! #########################################################
171 ! ## subroutine sort -- heapsort of an integer array ##
173 ! #########################################################
176 ! "sort" takes an input list of integers and sorts it
177 ! into ascending order using the Heapsort algorithm
180 subroutine sort(n,list)
183 integer :: index,lists
187 ! perform the heapsort of the input list
197 list(index) = list(1)
199 if (index .le. 1) then
206 do while (j .le. index)
207 if (j .lt. index) then
208 if (list(j) .lt. list(j+1)) j = j + 1
210 if (lists .lt. list(j)) then
222 !-----------------------------------------------------------------------------
225 ! ##############################################################
227 ! ## subroutine sort2 -- heapsort of real array with keys ##
229 ! ##############################################################
232 ! "sort2" takes an input list of reals and sorts it
233 ! into ascending order using the Heapsort algorithm;
234 ! it also returns a key into the original ordering
237 subroutine sort2(n,list,key)
240 integer :: index,keys
242 real(kind=8) :: lists
243 real(kind=8) :: list(*)
246 ! initialize index into the original ordering
252 ! perform the heapsort of the input list
264 list(index) = list(1)
267 if (index .le. 1) then
275 do while (j .le. index)
276 if (j .lt. index) then
277 if (list(j) .lt. list(j+1)) j = j + 1
279 if (lists .lt. list(j)) then
293 !-----------------------------------------------------------------------------
296 ! #################################################################
298 ! ## subroutine sort3 -- heapsort of integer array with keys ##
300 ! #################################################################
303 ! "sort3" takes an input list of integers and sorts it
304 ! into ascending order using the Heapsort algorithm;
305 ! it also returns a key into the original ordering
308 subroutine sort3(n,list,key)
318 ! initialize index into the original ordering
324 ! perform the heapsort of the input list
336 list(index) = list(1)
339 if (index .le. 1) then
347 do while (j .le. index)
348 if (j .lt. index) then
349 if (list(j) .lt. list(j+1)) j = j + 1
351 if (lists .lt. list(j)) then
365 !-----------------------------------------------------------------------------
368 ! #################################################################
370 ! ## subroutine sort4 -- heapsort of integer absolute values ##
372 ! #################################################################
375 ! "sort4" takes an input list of integers and sorts it into
376 ! ascending absolute value using the Heapsort algorithm
379 subroutine sort4(n,list)
387 ! perform the heapsort of the input list
397 list(index) = list(1)
399 if (index .le. 1) then
406 do while (j .le. index)
407 if (j .lt. index) then
408 if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1
410 if (abs(lists) .lt. abs(list(j))) then
422 !-----------------------------------------------------------------------------
425 ! ################################################################
427 ! ## subroutine sort5 -- heapsort of integer array modulo m ##
429 ! ################################################################
432 ! "sort5" takes an input list of integers and sorts it
433 ! into ascending order based on each value modulo "m"
436 subroutine sort5(n,list,m)
439 integer :: index,smod
440 integer :: jmod,j1mod
445 ! perform the heapsort of the input list
455 list(index) = list(1)
457 if (index .le. 1) then
464 do while (j .le. index)
465 if (j .lt. index) then
466 jmod = mod(list(j),m)
467 j1mod = mod(list(j+1),m)
468 if (jmod .lt. j1mod) then
470 else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then
475 jmod = mod(list(j),m)
476 if (smod .lt. jmod) then
480 else if (smod.eq.jmod .and. lists.lt.list(j)) then
492 !-----------------------------------------------------------------------------
495 ! #############################################################
497 ! ## subroutine sort6 -- heapsort of a text string array ##
499 ! #############################################################
502 ! "sort6" takes an input list of character strings and sorts
503 ! it into alphabetical order using the Heapsort algorithm
506 subroutine sort6(n,list)
510 character(len=256) :: lists
511 character*(*) :: list(*)
514 ! perform the heapsort of the input list
524 list(index) = list(1)
526 if (index .le. 1) then
533 do while (j .le. index)
534 if (j .lt. index) then
535 if (list(j) .lt. list(j+1)) j = j + 1
537 if (lists .lt. list(j)) then
549 !-----------------------------------------------------------------------------
552 ! ################################################################
554 ! ## subroutine sort7 -- heapsort of text strings with keys ##
556 ! ################################################################
559 ! "sort7" takes an input list of character strings and sorts it
560 ! into alphabetical order using the Heapsort algorithm; it also
561 ! returns a key into the original ordering
564 subroutine sort7(n,list,key)
570 character(len=256) :: lists
571 character*(*) :: list(*)
574 ! initialize index into the original ordering
580 ! perform the heapsort of the input list
592 list(index) = list(1)
595 if (index .le. 1) then
603 do while (j .le. index)
604 if (j .lt. index) then
605 if (list(j) .lt. list(j+1)) j = j + 1
607 if (lists .lt. list(j)) then
621 !-----------------------------------------------------------------------------
624 ! #########################################################
626 ! ## subroutine sort8 -- heapsort to unique integers ##
628 ! #########################################################
631 ! "sort8" takes an input list of integers and sorts it into
632 ! ascending order using the Heapsort algorithm, duplicate
633 ! values are removed from the final sorted list
636 subroutine sort8(n,list)
644 ! perform the heapsort of the input list
654 list(index) = list(1)
656 if (index .le. 1) then
659 ! remove duplicate values from final list
663 if (list(i-1) .ne. list(i)) then
674 do while (j .le. index)
675 if (j .lt. index) then
676 if (list(j) .lt. list(j+1)) j = j + 1
678 if (lists .lt. list(j)) then
690 !-----------------------------------------------------------------------------
693 ! #############################################################
695 ! ## subroutine sort9 -- heapsort to unique text strings ##
697 ! #############################################################
700 ! "sort9" takes an input list of character strings and sorts
701 ! it into alphabetical order using the Heapsort algorithm,
702 ! duplicate values are removed from the final sorted list
705 subroutine sort9(n,list)
709 character(len=256) :: lists
710 character*(*) :: list(*)
713 ! perform the heapsort of the input list
723 list(index) = list(1)
725 if (index .le. 1) then
728 ! remove duplicate values from final list
732 if (list(i-1) .ne. list(i)) then
743 do while (j .le. index)
744 if (j .lt. index) then
745 if (list(j) .lt. list(j+1)) j = j + 1
747 if (lists .lt. list(j)) then
759 !-----------------------------------------------------------------------------
761 !-----------------------------------------------------------------------------
762 real(kind=8) function pinorm(x)
763 ! implicit real*8 (a-h,o-z)
765 use geometry_data, only: pi,dwapi
766 ! this function takes an angle (in radians) and puts it in the range of
771 ! include 'COMMON.GEO'
773 pinorm = x - n * dwapi
774 if ( pinorm .gt. pi ) then
775 pinorm = pinorm - dwapi
776 else if ( pinorm .lt. - pi ) then
777 pinorm = pinorm + dwapi
781 !-----------------------------------------------------------------------------
783 !-----------------------------------------------------------------------------
784 subroutine xx2x(x,xx)
786 ! implicit real*8 (a-h,o-z)
789 ! include 'DIMENSIONS'
790 ! include 'COMMON.VAR'
791 ! include 'COMMON.CHAIN'
792 ! include 'COMMON.INTERACT'
793 integer :: i,ij,ig,igall
794 real(kind=8),dimension(6*nres) :: xx,x !(maxvar) (maxvar=6*maxres)
804 if (mask_phi(i).eq.1) then
812 if (mask_theta(i).eq.1) then
820 if (itype(i,1).ne.10) then
822 if (mask_side(i).eq.1) then
832 !-----------------------------------------------------------------------------
833 !-----------------------------------------------------------------------------