Sources Esope | Cast3M

vecflm
C VECFLM    SOURCE    CHAT      05/01/13    04:04:45     5004
CCC
C **********************************************************************
CCC
      SUBROUTINE VECFLMAC (X,NDIMX,VECM,NMODEL)
      IMPLICIT INTEGER(I-N)
      integer ndimx,nmodel,ndims,npcon,npcap,i,ndimv,kdummy
      real*8    x(ndimx),vecm(ndimx),p,aux
      real*8    exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .          exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
     .          exm2,eww2,cpr,cpm,cfr
      common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
     .                 exl,xnn,aaa,bbb
      common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
     .                 cpr,cpm,cfr
      ndims=ndimx-2
      npcon=ndimx-1
      npcap=ndimx
      ndimv=2
      kdummy=nmodel
      if (nmodel.eq.22) kdummy=23
      call vflsigMAC(x,ndims,x(npcon),ndimv,vecm,kdummy)
      aux=0.D0
      do i=1,3
        aux=aux+(x(i)+pcc)*vecm(i)
      enddo
      do i=4,ndims
c        aux=aux+2.D0*x(i)*vecm(i)
        aux=aux+x(i)*vecm(i)
      enddo
      if (aux.lt.0.D0) then
        write(*,*)' Trabj plas negativo:',aux
        aux=0.D0
      endif
      p=-(x(1)+x(2)+x(3))/3.D0
      vecm(npcon)=-aux*(abs((p-pcc)/paa))**(-exl)/(paa*cco)
      vecm(npcap)=-aux*(pc0/paa)**(-abs(exr))/cca/paa
      return
      end