Sources Esope | Cast3M

hessmac
C HESSMAC   SOURCE    CHAT      05/01/13    00:24:05     5004
CCC
C **********************************************************************
CCC
      SUBROUTINE HESSMAC (X,NDIMX,AMAT,NDIMA,NNUMER,DELTAX,NMODEL)
      IMPLICIT INTEGER(I-N)
      integer ndimx,ndima,nnumer,nmodel,i,j,kdummy
      real*8 x(ndimx),Amat(ndima,ndima)
      real*8 deltax,aux1,aux2,typx(8)
      do i=1,ndimx-2
        typx(i)=1.D-2
        enddo
        typx(ndimx-1)=1.D-4
        typx(ndimx)  =1.D-4
        if ((nnumer.le.0).or.(nnumer.ge.4)) stop 'HessMAC no definido'
      kdummy=nnumer
      if (nnumer.eq.2) then
         aux1=x(ndimx-1)-deltax*(max(abs(x(ndimx-1)),typx(ndimx-1)))
         aux2=x(ndimx)-deltax*(max(abs(x(ndimx)),typx(ndimx)))
         if ((aux1.le.0.D0).or.(aux2.le.0.D0)) kdummy=1
      endif
      goto (10,20,30) kdummy
      goto 50
10    call HessMAC1o1(x,ndimx,Amat,ndima,nmodel,deltax,typx)
      goto 50
20    call HessMAC1o2(x,ndimx,Amat,ndima,nmodel,deltax,typx)
      goto 50
30    call HessMAC1o2C(x,ndimx,Amat,ndima,nmodel,deltax,typx)
50    do i=1,ndimx-2
       do j=i+1,ndimx-2
          Amat(i,j)=(Amat(i,j)+Amat(j,i))/2.D0
          Amat(j,i)=Amat(i,j)
       enddo
      enddo
      return
      end