+++ /dev/null
- subroutine distfit(debug,maxit)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- DIMENSION X(MAXRES),DIAGH(MAXRES),phiold(maxres)
- logical debug,sing
-
-cinput------------------------------------
-c NX=NRES-3
-c NY=((NRES-4)*(NRES-5))/2
-cinput------------------------------------
-ctest MAXIT=20
- TOL=0.5
- MAXMAR=10
- RL=100.0
-
- CALL TRANSFER(NRES,phi,phiold)
-
- F0=RDIF()
-
-cd WRITE (IOUT,*) 'DISTFIT: F0=',F0
-
-
- DO IT=1,MAXIT
- CALL RDERIV
- CALL HEVAL
-
- DO I=1,NX
- DIAGH(I)=H(I,I)
- ENDDO
- RL=RL*0.1
-
- DO IMAR=1,MAXMAR
- DO I=1,NX
- H(I,I)=DIAGH(I)+RL
- ENDDO
- CALL TRANSFER(NX,XX,X)
- CALL BANACH(NX,MAXRES,H,X,sing)
- AIN=0.0
- DO I=1,NX
- AIN=AIN+DABS(X(I))
- ENDDO
- IF (AIN.LT.0.1*TOL .AND. RL.LT.1.0E-4) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CONVERGENCE HAS BEEN ACHIEVED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- endif
- RETURN
- ENDIF
- DO I=4,NRES
- phi(I)=phiold(I)+mask(i)*X(I-3)
-c print *,X(I-3)
- ENDDO
-
- F1=RDIF()
-cd WRITE (IOUT,*) 'IMAR=',IMAR,' RL=',RL,' F1=',F1
- IF (F1.LT.F0) THEN
- CALL TRANSFER(NRES,phi,phiold)
- F0=F1
- GOTO 1
- ELSE IF (DABS(F1-F0).LT.1.0E-5) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CANNOT IMPROVE DISTANCE FIT'
- WRITE (IOUT,*) 'IT=',it,'F=',F1
- endif
- RETURN
- ENDIF
- RL=RL*10.0
- ENDDO
- WRITE (IOUT,*) 'DISTFIT: MARQUARDT PROCEDURE HAS FAILED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- CALL TRANSFER(NRES,phiold,phi)
- RETURN
- 1 continue
-cd write (iout,*) "it",it," imar",imar," f0",f0
- enddo
- WRITE (IOUT,*) 'DISTFIT: FINAL F=',F0,'after MAXIT=',maxit
- return
- END
-
- double precision FUNCTION RDIF()
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
-
-c print *,'in rdif'
-
- suma=0.0
- ind=0
- call chainbuild
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if (w(ind).ne.0.0) then
- DIJ=DIST(i,j)
- suma=suma+w(ind)*(DIJ-d0(ind))*(DIJ-d0(ind))
- DD(ind)=DIJ
-c print '(2i3,i4,4f12.2)',i,j,ind,dij,d0(ind),w(ind),suma
- endif
- enddo
- enddo
-
- RDIF=suma
- RETURN
- END
-
- SUBROUTINE RDERIV
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
- include 'COMMON.GEO'
- DIMENSION E12(3),R13(3),R24(3),PRODU(3)
-
- DO I=1,NY
- DO J=1,NX
- DRDG(I,J)=0.0
- ENDDO
- ENDDO
- DO I=1,NX
- I1=I+1
- I2=I+2
- CALL VEC(I1,I2,E12)
- DO J=1,I
- DO K=1,3
- R13(K)=C(K,J)-C(K,I1)
- ENDDO
- DO K=I2+1,NRES
- DO L=1,3
- R24(L)=C(L,K)-C(L,I2)
- ENDDO
- IND=((J-1)*(2*NRES-J-6))/2+K-3
- PRODU(1)=R13(2)*R24(3)-R13(3)*R24(2)
- PRODU(2)=R13(3)*R24(1)-R13(1)*R24(3)
- PRODU(3)=R13(1)*R24(2)-R13(2)*R24(1)
- DRDG(IND,I)=SCALAR(E12,PRODU)/DIST(J,K)
- ENDDO
- ENDDO
- ENDDO
- RETURN
- END
-
- SUBROUTINE HEVAL
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DISTFIT'
-
- DO I=1,NX
- XI=0.0
- HII=0.0
- DO K=1,NY
- BKI=DRDG(K,I)
- BKIWK=w(K)*BKI
- XI=XI+BKIWK*(D0(K)-DD(K))
- HII=HII+BKI*BKIWK
- ENDDO
- H(I,I)=HII
- XX(I)=XI
- DO J=I+1,NX
- HIJ=0.0
- DO K=1,NY
- HIJ=HIJ+DRDG(K,I)*DRDG(K,J)*w(K)
- ENDDO
- H(I,J)=HIJ
- H(J,I)=HIJ
- ENDDO
- ENDDO
- RETURN
- END
-
-
- SUBROUTINE VEC(I,J,U)
-*
-* Find the unit vector from atom (I) to atom (J). Store in U.
-*
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- DIMENSION U(3)
-
- ANORM=0.0
- DO K=1,3
- UK=C(K,J)-C(K,I)
- ANORM=ANORM+UK*UK
- U(K)=UK
- ENDDO
- ANORM=SQRT(ANORM)
- DO K=1,3
- U(K)=U(K)/ANORM
- ENDDO
- RETURN
- END
-
- SUBROUTINE TRANSFER(N,X1,X2)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION X1(N),X2(N)
- DO 1 I=1,N
- 1 X2(I)=X1(I)
- RETURN
- END
-
projects / unres.git / blobdiff