Esope source files

   1 : C HESSMAC   SOURCE    CHAT      05/01/13    00:24:05     5004           
   2 : CCC
   3 : C **********************************************************************
   4 : CCC
   5 :       SUBROUTINE HESSMAC (X,NDIMX,AMAT,NDIMA,NNUMER,DELTAX,NMODEL)
   6 :       IMPLICIT INTEGER(I-N)
   7 :       integer ndimx,ndima,nnumer,nmodel,i,j,kdummy
   8 :       real*8 x(ndimx),Amat(ndima,ndima)
   9 :       real*8 deltax,aux1,aux2,typx(8)
  10 :       do i=1,ndimx-2
  11 :         typx(i)=1.D-2
  12 :         enddo
  13 :         typx(ndimx-1)=1.D-4
  14 :         typx(ndimx)  =1.D-4
  15 :         if ((nnumer.le.0).or.(nnumer.ge.4)) stop 'HessMAC no definido'
  16 :       kdummy=nnumer
  17 :       if (nnumer.eq.2) then
  18 :          aux1=x(ndimx-1)-deltax*(max(abs(x(ndimx-1)),typx(ndimx-1)))
  19 :          aux2=x(ndimx)-deltax*(max(abs(x(ndimx)),typx(ndimx)))
  20 :          if ((aux1.le.0.D0).or.(aux2.le.0.D0)) kdummy=1
  21 :       endif
  22 :       goto (10,20,30) kdummy
  23 :       goto 50
  23 : 10    call HessMAC1o1(x,ndimx,Amat,ndima,nmodel,deltax,typx)
  24 :       goto 50
  24 : 20    call HessMAC1o2(x,ndimx,Amat,ndima,nmodel,deltax,typx)
  25 :       goto 50
  25 : 30    call HessMAC1o2C(x,ndimx,Amat,ndima,nmodel,deltax,typx)
  26 : 50    do i=1,ndimx-2
  27 :        do j=i+1,ndimx-2
  28 :           Amat(i,j)=(Amat(i,j)+Amat(j,i))/2.D0
  29 :           Amat(j,i)=Amat(i,j)
  30 :        enddo
  31 :       enddo
  32 :       return
  33 :       end
  34 :  
  35 :