source/unres/math.f90

   1       module math
   2 !-----------------------------------------------------------------------------
   3       use io_units, only:inp,iout
   4       implicit none
   5 !-----------------------------------------------------------------------------
   6 !
   7 !
   8 !-----------------------------------------------------------------------------
   9       contains
  10 !-----------------------------------------------------------------------------
  11 ! djacob.f
  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
  17 !      COMMON INP,IOUT,IPN
  18       real(kind=8),DIMENSION(NMAX,N) :: A,C
  19       real(kind=8),DIMENSION(150) :: AJJ        !el AII
  20       real(kind=8),DIMENSION(*) :: AII
  21 !el local variables
  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
  27       SIN45 = .70710678
  28       COS45 = .70710678
  29       S45SQ = 0.50
  30       C45SQ = 0.50
  31 !     UNIT EIGENVECTOR MATRIX
  32       DO 70 I = 1,N
  33       DO 7 J = I,N
  34       A(J,I)=A(I,J)
  35       C(I,J) = 0.0
  36     7 C(J,I) = 0.0
  37    70 C(I,I) = 1.0
  38 !     DETERMINATION OF SEARCH ARGUMENT, TEST
  39       AMAX = 0.0
  40       DO 1 I = 1,N
  41       DO 1 J = 1,I
  42       TEMPA=DABS(A(I,J))
  43       IF (AMAX-TEMPA) 2,1,1
  44     2 AMAX = TEMPA
  45     1 CONTINUE
  46       TEST = AMAX*E
  47 !     SEARCH FOR LARGEST OFF DIAGONAL ELEMENT
  48       DO 72 IJAC=1,MAXJAC
  49       AIJMAX = 0.0
  50       DO 3 I = 2,N
  51       LIM = I-1
  52       DO 3 J = 1,LIM
  53       TAIJ=DABS(A(I,J))
  54        IF (AIJMAX-TAIJ) 4,3,3
  55     4 AIJMAX = TAIJ
  56       IPIV = I
  57       JPIV = J
  58     3 CONTINUE
  59       IF(AIJMAX-TEST)300,300,5
  60 !     PARAMETERS FOR ROTATION
  61     5 TAII = A(IPIV,IPIV)
  62       TAJJ = A(JPIV,JPIV)
  63       TAIJ = A(IPIV,JPIV)
  64       TMT = TAII-TAJJ
  65       IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6
  66    60 IF(TAIJ) 10,10,11
  67     6 ZAMMA=TAIJ/(2.0*TMT)
  68    90 IF(DABS(ZAMMA)-0.38268)8,8,9
  69     9 IF(ZAMMA)10,10,11
  70    10 SINT = -SIN45
  71       GO TO 12
  72    11 SINT = SIN45
  73    12 COST = COS45
  74       SINSQ = S45SQ
  75       COSSQ = C45SQ
  76       GO TO 120
  77     8 GAMSQ=ZAMMA*ZAMMA
  78       SINT=2.0*ZAMMA/(1.0+GAMSQ)
  79       COST = (1.0-GAMSQ)/(1.0+GAMSQ)
  80       SINSQ=SINT*SINT
  81       COSSQ=COST*COST
  82 !     ROTATION
  83   120 DO 13 K = 1,N
  84       TAIK = A(IPIV,K)
  85       TAJK = A(JPIV,K)
  86       A(IPIV,K) = TAIK*COST+TAJK*SINT
  87       A(JPIV,K) = TAJK*COST-TAIK*SINT
  88       TCIK = C(IPIV,K)
  89       TCJK = C(JPIV,K)
  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)
  96       DO 30 K = 1,N
  97       A(K,IPIV) = A(IPIV,K)
  98    30 A(K,JPIV) = A(JPIV,K)
  99    72 CONTINUE
 100       WRITE (IOUT,1000) AIJMAX
 101  1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE',&
 102        'MENT = ',1PE14.7)
 103 !     ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER
 104   300 DO 14 I=1,N
 105    14 AJJ(I)=A(I,I)
 106       LT=N+1
 107       DO 15 L=1,N
 108       LT=LT-1
 109       AIIMIN=1.0E+30
 110       DO 16 I=1,N
 111       IF(AJJ(I)-AIIMIN)17,16,16
 112    17 AIIMIN=AJJ(I)
 113       IT=I
 114    16 CONTINUE
 115       IN=L
 116       AII(IN)=AIIMIN
 117       AJJ(IT)=1.0E+30
 118       DO 15 K=1,N
 119    15 A(IN,K)=C(IT,K)
 120       DO 18 I=1,N
 121       IF(A(I,1))19,22,22
 122    19 T=-1.0
 123       GO TO 91
 124    22 T=1.0
 125    91 DO 18 J=1,N
 126    18 C(J,I)=T*A(I,J)
 127       return
 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)
 138       return
 139       end subroutine vecpr
 140 !-----------------------------------------------------------------------------
 141       real(kind=8) function scalar(u,v)
 142 !DIR$ INLINEALWAYS scalar
 143 !#ifndef OSF
 144 !DEC$ ATTRIBUTES FORCEINLINE::scalar
 145 !#endif
 146 !      implicit none
 147       real(kind=8),dimension(3) :: u,v
 148 !d      double precision sc
 149 !d      integer i
 150 !d      sc=0.0d0
 151 !d      do i=1,3
 152 !d        sc=sc+u(i)*v(i)
 153 !d      enddo
 154 !d      scalar=sc
 155
 156       scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
 157       return
 158       end function scalar
 159 !-----------------------------------------------------------------------------
 160 ! sort.f
 161 !-----------------------------------------------------------------------------
 162 !
 163 !
 164 !     ###################################################
 165 !     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
 166 !     ##              All Rights Reserved              ##
 167 !     ###################################################
 168 !
 169 !     #########################################################
 170 !     ##                                                     ##
 171 !     ##  subroutine sort  --  heapsort of an integer array  ##
 172 !     ##                                                     ##
 173 !     #########################################################
 174 !
 175 !
 176 !     "sort" takes an input list of integers and sorts it
 177 !     into ascending order using the Heapsort algorithm
 178 !
 179 !
 180       subroutine sort(n,list)
 181 !      implicit none
 182       integer :: i,j,k,n
 183       integer :: index,lists
 184       integer :: list(*)
 185 !
 186 !
 187 !     perform the heapsort of the input list
 188 !
 189       k = n/2 + 1
 190       index = n
 191       do while (n .gt. 1)
 192          if (k .gt. 1) then
 193             k = k - 1
 194             lists = list(k)
 195          else
 196             lists = list(index)
 197             list(index) = list(1)
 198             index = index - 1
 199             if (index .le. 1) then
 200                list(1) = lists
 201                return
 202             end if
 203          end if
 204          i = k
 205          j = k + k
 206          do while (j .le. index)
 207             if (j .lt. index) then
 208                if (list(j) .lt. list(j+1))  j = j + 1
 209             end if
 210             if (lists .lt. list(j)) then
 211                list(i) = list(j)
 212                i = j
 213                j = j + j
 214             else
 215                j = index + 1
 216             end if
 217          end do
 218          list(i) = lists
 219       end do
 220       return
 221       end subroutine sort
 222 !-----------------------------------------------------------------------------
 223 !
 224 !
 225 !     ##############################################################
 226 !     ##                                                          ##
 227 !     ##  subroutine sort2  --  heapsort of real array with keys  ##
 228 !     ##                                                          ##
 229 !     ##############################################################
 230 !
 231 !
 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
 235 !
 236 !
 237       subroutine sort2(n,list,key)
 238 !      implicit none
 239       integer :: i,j,k,n
 240       integer :: index,keys
 241       integer :: key(*)
 242       real(kind=8) :: lists
 243       real(kind=8) :: list(*)
 244 !
 245 !
 246 !     initialize index into the original ordering
 247 !
 248       do i = 1, n
 249          key(i) = i
 250       end do
 251 !
 252 !     perform the heapsort of the input list
 253 !
 254       k = n/2 + 1
 255       index = n
 256       do while (n .gt. 1)
 257          if (k .gt. 1) then
 258             k = k - 1
 259             lists = list(k)
 260             keys = key(k)
 261          else
 262             lists = list(index)
 263             keys = key(index)
 264             list(index) = list(1)
 265             key(index) = key(1)
 266             index = index - 1
 267             if (index .le. 1) then
 268                list(1) = lists
 269                key(1) = keys
 270                return
 271             end if
 272          end if
 273          i = k
 274          j = k + k
 275          do while (j .le. index)
 276             if (j .lt. index) then
 277                if (list(j) .lt. list(j+1))  j = j + 1
 278             end if
 279             if (lists .lt. list(j)) then
 280                list(i) = list(j)
 281                key(i) = key(j)
 282                i = j
 283                j = j + j
 284             else
 285                j = index + 1
 286             end if
 287          end do
 288          list(i) = lists
 289          key(i) = keys
 290       end do
 291       return
 292       end subroutine sort2
 293 !-----------------------------------------------------------------------------
 294 !
 295 !
 296 !     #################################################################
 297 !     ##                                                             ##
 298 !     ##  subroutine sort3  --  heapsort of integer array with keys  ##
 299 !     ##                                                             ##
 300 !     #################################################################
 301 !
 302 !
 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
 306 !
 307 !
 308       subroutine sort3(n,list,key)
 309 !      implicit none
 310       integer :: i,j,k,n
 311       integer :: index
 312       integer :: lists
 313       integer :: keys
 314       integer :: list(*)
 315       integer :: key(*)
 316 !
 317 !
 318 !     initialize index into the original ordering
 319 !
 320       do i = 1, n
 321          key(i) = i
 322       end do
 323 !
 324 !     perform the heapsort of the input list
 325 !
 326       k = n/2 + 1
 327       index = n
 328       do while (n .gt. 1)
 329          if (k .gt. 1) then
 330             k = k - 1
 331             lists = list(k)
 332             keys = key(k)
 333          else
 334             lists = list(index)
 335             keys = key(index)
 336             list(index) = list(1)
 337             key(index) = key(1)
 338             index = index - 1
 339             if (index .le. 1) then
 340                list(1) = lists
 341                key(1) = keys
 342                return
 343             end if
 344          end if
 345          i = k
 346          j = k + k
 347          do while (j .le. index)
 348             if (j .lt. index) then
 349                if (list(j) .lt. list(j+1))  j = j + 1
 350             end if
 351             if (lists .lt. list(j)) then
 352                list(i) = list(j)
 353                key(i) = key(j)
 354                i = j
 355                j = j + j
 356             else
 357                j = index + 1
 358             end if
 359          end do
 360          list(i) = lists
 361          key(i) = keys
 362       end do
 363       return
 364       end subroutine sort3
 365 !-----------------------------------------------------------------------------
 366 !
 367 !
 368 !     #################################################################
 369 !     ##                                                             ##
 370 !     ##  subroutine sort4  --  heapsort of integer absolute values  ##
 371 !     ##                                                             ##
 372 !     #################################################################
 373 !
 374 !
 375 !     "sort4" takes an input list of integers and sorts it into
 376 !     ascending absolute value using the Heapsort algorithm
 377 !
 378 !
 379       subroutine sort4(n,list)
 380 !      implicit none
 381       integer :: i,j,k,n
 382       integer :: index
 383       integer :: lists
 384       integer :: list(*)
 385 !
 386 !
 387 !     perform the heapsort of the input list
 388 !
 389       k = n/2 + 1
 390       index = n
 391       do while (n .gt. 1)
 392          if (k .gt. 1) then
 393             k = k - 1
 394             lists = list(k)
 395          else
 396             lists = list(index)
 397             list(index) = list(1)
 398             index = index - 1
 399             if (index .le. 1) then
 400                list(1) = lists
 401                return
 402             end if
 403          end if
 404          i = k
 405          j = k + k
 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
 409             end if
 410             if (abs(lists) .lt. abs(list(j))) then
 411                list(i) = list(j)
 412                i = j
 413                j = j + j
 414             else
 415                j = index + 1
 416             end if
 417          end do
 418          list(i) = lists
 419       end do
 420       return
 421       end subroutine sort4
 422 !-----------------------------------------------------------------------------
 423 !
 424 !
 425 !     ################################################################
 426 !     ##                                                            ##
 427 !     ##  subroutine sort5  --  heapsort of integer array modulo m  ##
 428 !     ##                                                            ##
 429 !     ################################################################
 430 !
 431 !
 432 !     "sort5" takes an input list of integers and sorts it
 433 !     into ascending order based on each value modulo "m"
 434 !
 435 !
 436       subroutine sort5(n,list,m)
 437 !      implicit none
 438       integer :: i,j,k,m,n
 439       integer :: index,smod
 440       integer :: jmod,j1mod
 441       integer :: lists
 442       integer :: list(*)
 443 !
 444 !
 445 !     perform the heapsort of the input list
 446 !
 447       k = n/2 + 1
 448       index = n
 449       do while (n .gt. 1)
 450          if (k .gt. 1) then
 451             k = k - 1
 452             lists = list(k)
 453          else
 454             lists = list(index)
 455             list(index) = list(1)
 456             index = index - 1
 457             if (index .le. 1) then
 458                list(1) = lists
 459                return
 460             end if
 461          end if
 462          i = k
 463          j = k + k
 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
 469                   j = j + 1
 470                else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then
 471                   j = j + 1
 472                end if
 473             end if
 474             smod = mod(lists,m)
 475             jmod = mod(list(j),m)
 476             if (smod .lt. jmod) then
 477                list(i) = list(j)
 478                i = j
 479                j = j + j
 480             else if (smod.eq.jmod .and. lists.lt.list(j)) then
 481                list(i) = list(j)
 482                i = j
 483                j = j + j
 484             else
 485                j = index + 1
 486             end if
 487          end do
 488          list(i) = lists
 489       end do
 490       return
 491       end subroutine sort5
 492 !-----------------------------------------------------------------------------
 493 !
 494 !
 495 !     #############################################################
 496 !     ##                                                         ##
 497 !     ##  subroutine sort6  --  heapsort of a text string array  ##
 498 !     ##                                                         ##
 499 !     #############################################################
 500 !
 501 !
 502 !     "sort6" takes an input list of character strings and sorts
 503 !     it into alphabetical order using the Heapsort algorithm
 504 !
 505 !
 506       subroutine sort6(n,list)
 507 !      implicit none
 508       integer :: i,j,k,n
 509       integer :: index
 510       character(len=256) :: lists
 511       character*(*) :: list(*)
 512 !
 513 !
 514 !     perform the heapsort of the input list
 515 !
 516       k = n/2 + 1
 517       index = n
 518       do while (n .gt. 1)
 519          if (k .gt. 1) then
 520             k = k - 1
 521             lists = list(k)
 522          else
 523             lists = list(index)
 524             list(index) = list(1)
 525             index = index - 1
 526             if (index .le. 1) then
 527                list(1) = lists
 528                return
 529             end if
 530          end if
 531          i = k
 532          j = k + k
 533          do while (j .le. index)
 534             if (j .lt. index) then
 535                if (list(j) .lt. list(j+1))  j = j + 1
 536             end if
 537             if (lists .lt. list(j)) then
 538                list(i) = list(j)
 539                i = j
 540                j = j + j
 541             else
 542                j = index + 1
 543             end if
 544          end do
 545          list(i) = lists
 546       end do
 547       return
 548       end subroutine sort6
 549 !-----------------------------------------------------------------------------
 550 !
 551 !
 552 !     ################################################################
 553 !     ##                                                            ##
 554 !     ##  subroutine sort7  --  heapsort of text strings with keys  ##
 555 !     ##                                                            ##
 556 !     ################################################################
 557 !
 558 !
 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
 562 !
 563 !
 564       subroutine sort7(n,list,key)
 565 !      implicit none
 566       integer :: i,j,k,n
 567       integer :: index
 568       integer :: keys
 569       integer :: key(*)
 570       character(len=256) :: lists
 571       character*(*) :: list(*)
 572 !
 573 !
 574 !     initialize index into the original ordering
 575 !
 576       do i = 1, n
 577          key(i) = i
 578       end do
 579 !
 580 !     perform the heapsort of the input list
 581 !
 582       k = n/2 + 1
 583       index = n
 584       do while (n .gt. 1)
 585          if (k .gt. 1) then
 586             k = k - 1
 587             lists = list(k)
 588             keys = key(k)
 589          else
 590             lists = list(index)
 591             keys = key(index)
 592             list(index) = list(1)
 593             key(index) = key(1)
 594             index = index - 1
 595             if (index .le. 1) then
 596                list(1) = lists
 597                key(1) = keys
 598                return
 599             end if
 600          end if
 601          i = k
 602          j = k + k
 603          do while (j .le. index)
 604             if (j .lt. index) then
 605                if (list(j) .lt. list(j+1))  j = j + 1
 606             end if
 607             if (lists .lt. list(j)) then
 608                list(i) = list(j)
 609                key(i) = key(j)
 610                i = j
 611                j = j + j
 612             else
 613                j = index + 1
 614             end if
 615          end do
 616          list(i) = lists
 617          key(i) = keys
 618       end do
 619       return
 620       end subroutine sort7
 621 !-----------------------------------------------------------------------------
 622 !
 623 !
 624 !     #########################################################
 625 !     ##                                                     ##
 626 !     ##  subroutine sort8  --  heapsort to unique integers  ##
 627 !     ##                                                     ##
 628 !     #########################################################
 629 !
 630 !
 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
 634 !
 635 !
 636       subroutine sort8(n,list)
 637 !      implicit none
 638       integer :: i,j,k,n
 639       integer :: index
 640       integer :: lists
 641       integer :: list(*)
 642 !
 643 !
 644 !     perform the heapsort of the input list
 645 !
 646       k = n/2 + 1
 647       index = n
 648       do while (n .gt. 1)
 649          if (k .gt. 1) then
 650             k = k - 1
 651             lists = list(k)
 652          else
 653             lists = list(index)
 654             list(index) = list(1)
 655             index = index - 1
 656             if (index .le. 1) then
 657                list(1) = lists
 658 !
 659 !     remove duplicate values from final list
 660 !
 661                j = 1
 662                do i = 2, n
 663                   if (list(i-1) .ne. list(i)) then
 664                      j = j + 1
 665                      list(j) = list(i)
 666                   end if
 667                end do
 668                if (j .lt. n)  n = j
 669                return
 670             end if
 671          end if
 672          i = k
 673          j = k + k
 674          do while (j .le. index)
 675             if (j .lt. index) then
 676                if (list(j) .lt. list(j+1))  j = j + 1
 677             end if
 678             if (lists .lt. list(j)) then
 679                list(i) = list(j)
 680                i = j
 681                j = j + j
 682             else
 683                j = index + 1
 684             end if
 685          end do
 686          list(i) = lists
 687       end do
 688       return
 689       end subroutine sort8
 690 !-----------------------------------------------------------------------------
 691 !
 692 !
 693 !     #############################################################
 694 !     ##                                                         ##
 695 !     ##  subroutine sort9  --  heapsort to unique text strings  ##
 696 !     ##                                                         ##
 697 !     #############################################################
 698 !
 699 !
 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
 703 !
 704 !
 705       subroutine sort9(n,list)
 706 !      implicit none
 707       integer :: i,j,k,n
 708       integer :: index
 709       character(len=256) :: lists
 710       character*(*) :: list(*)
 711 !
 712 !
 713 !     perform the heapsort of the input list
 714 !
 715       k = n/2 + 1
 716       index = n
 717       do while (n .gt. 1)
 718          if (k .gt. 1) then
 719             k = k - 1
 720             lists = list(k)
 721          else
 722             lists = list(index)
 723             list(index) = list(1)
 724             index = index - 1
 725             if (index .le. 1) then
 726                list(1) = lists
 727 !
 728 !     remove duplicate values from final list
 729 !
 730                j = 1
 731                do i = 2, n
 732                   if (list(i-1) .ne. list(i)) then
 733                      j = j + 1
 734                      list(j) = list(i)
 735                   end if
 736                end do
 737                if (j .lt. n)  n = j
 738                return
 739             end if
 740          end if
 741          i = k
 742          j = k + k
 743          do while (j .le. index)
 744             if (j .lt. index) then
 745                if (list(j) .lt. list(j+1))  j = j + 1
 746             end if
 747             if (lists .lt. list(j)) then
 748                list(i) = list(j)
 749                i = j
 750                j = j + j
 751             else
 752                j = index + 1
 753             end if
 754          end do
 755          list(i) = lists
 756       end do
 757       return
 758       end subroutine sort9
 759 !-----------------------------------------------------------------------------
 760 ! pinorm.f
 761 !-----------------------------------------------------------------------------
 762       real(kind=8) function pinorm(x)
 763 !      implicit real*8 (a-h,o-z)
 764 !
 765       use geometry_data, only: pi,dwapi
 766 ! this function takes an angle (in radians) and puts it in the range of
 767 ! -pi to +pi.
 768 !
 769       integer :: n
 770       real(kind=8) :: x
 771 !      include 'COMMON.GEO'
 772       n = x / dwapi
 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
 778       end if
 779       return
 780       end function pinorm
 781 !-----------------------------------------------------------------------------
 782 ! minimize_p.F
 783 !-----------------------------------------------------------------------------
 784       subroutine xx2x(x,xx)
 785
 786 !      implicit real*8 (a-h,o-z)
 787       use geometry_data
 788       use energy_data
 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)
 795
 796       do i=1,nvar
 797         x(i)=varall(i)
 798       enddo
 799
 800       ig=0
 801       igall=0
 802       do i=4,nres
 803         igall=igall+1
 804         if (mask_phi(i).eq.1) then
 805           ig=ig+1
 806           x(igall)=xx(ig)
 807         endif
 808       enddo
 809
 810       do i=3,nres
 811         igall=igall+1
 812         if (mask_theta(i).eq.1) then
 813           ig=ig+1
 814           x(igall)=xx(ig)
 815         endif
 816       enddo
 817
 818       do ij=1,2
 819       do i=2,nres-1
 820         if (itype(i).ne.10) then
 821           igall=igall+1
 822           if (mask_side(i).eq.1) then
 823             ig=ig+1
 824             x(igall)=xx(ig)
 825           endif
 826         endif
 827       enddo
 828       enddo
 829
 830       return
 831       end subroutine  xx2x
 832 !-----------------------------------------------------------------------------
 833 !-----------------------------------------------------------------------------
 834       end module math