Download cvecfl.eso

Back to the list

   1 : C CVECFL    SOURCE    CHAT      05/01/12    22:33:07     5004           
   2 : 
   3 :       SUBROUTINE C_VECFLMAC (X,NDIMX,VECM,NMODEL)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       integer ndimx,nmodel,ndims,npcon,npcap,i,ndimv,kdummy
   6 :       complex*16 x(ndimx),vecm(ndimx),p,aux
   7 :       real*8    exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
   8 :      .          exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
   9 :      .          exm2,eww2,cpr,cpm,cfr
  10 :       common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  11 :      .                 exl,xnn,aaa,bbb
  12 :       common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
  13 :      .                 cpr,cpm,cfr
  14 :       ndims=ndimx-2
  15 :       npcon=ndimx-1
  16 :       npcap=ndimx
  17 :       ndimv=2
  18 :       kdummy=nmodel
  19 :       if (nmodel.eq.22) kdummy=23
  19 :       call c_vflsigMAC(x,ndims,x(npcon),ndimv,vecm,kdummy)
  20 :       aux=0.D0
  21 :       do i=1,3
  22 :         aux=aux+(x(i)+pcc)*vecm(i)
  23 :       enddo 
  24 :       do i=4,ndims
  25 : c        aux=aux+2.D0*x(i)*vecm(i)
  26 :         aux=aux+x(i)*vecm(i)
  27 :       enddo
  28 :       if (abs(aux).eq.0.D0) then
  29 :         write(*,*)' Trabj plas negativo:',aux
  30 :         aux=0.D0
  31 :       endif 
  32 :       p=-(x(1)+x(2)+x(3))/3.D0
  33 :       vecm(npcon)=-aux*((p-pcc)/paa)**(-exl)/(paa*cco)
  34 :       vecm(npcap)=-aux*(pc0/paa)**(-abs(exr))/cca/paa
  35 :       return
  36 :       end
  37 :  
  38 :  
  39 :  

© Cast3M 2003 - All rights reserved.
Disclaimer