Esope source files

   1 : C DVRHIN    SOURCE    CHAT      05/01/12    22:59:15     5004           
   2 : 
   3 :       SUBROUTINE DVFLRHMCINV (SIGINV,XPP,XQQ,XQT,XTT)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       real*8 siginv(3),xqq,xqt,xtt,xpp,q,t
   6 :       real*8 kt,ktd,ktdd,aux,aux2,aux3,tat,cst,cst2,
   7 :      .       ktetmc,derktetmc,derderktetmc,aa,bb,snt
   8 :       real*8            coh,phi,ar,tmax,aap,aan,bbp,bbn
   9 :       common /rhmcdata/ coh,phi,ar,tmax,aap,aan,bbp,bbn
  10 :       q=siginv(2)
  11 :       xqq=0.D0
  12 :       xqt=0.D0
  13 :       xtt=0.D0
  14 :       xpp=0.D0
  15 :       if (abs(q).lt.1.D-17) return
  15 :       call Invari_J3_a_t2(q,siginv(3),t)
  16 :       cst = cos(3.D0*t)
  17 :       kt  = ktetMC(t)
  18 :       aux = sqrt(q*kt**2+(ar*coh)**2)
  19 :       if (abs(t).gt.tmax) then
  20 :         aa = aap
  21 :         bb = bbp
  22 :         if (t.lt.0.D0) then
  23 :          aa = aan
  24 :          bb = bbn
  25 :         endif
  26 :         snt = sin(3.D0*t)
  27 :         aux2= aa+2.D0*bb*snt
  28 :         aux3= aa-4.D0*bb*snt
  29 :         xqq = -(3.D0*bb*snt*aux3/q+(aux2*kt/aux)**2)/(4.D0*aux)
  30 :         xqt = (3.D0*sqrt(3.D0)*bb)/(4.d0*aux*sqrt(q))*
  31 :      .        (-kt*kt*aux2/aux**2+(4.D0*bb*snt-aa)/q)
  32 :         xtt = 27.D0*bb**2*(1.D0/q-(kt/aux)**2)/(q*aux*4.D0)
  33 :       else
  34 :         ktd = derktetMC(t)
  35 :         ktdd= derderktetMC(t)
  36 :         tat = tan(3.D0*t)
  37 :         cst2= cst**2
  38 :         xqq =-(kt*ktd*tat-kt*kt)**2/(4.D0*aux**3)+
  39 :      .        (tat)/(2.D0*aux*q)*(tat/2.D0*
  40 :      .        (ktd*ktd+kt*ktdd)+kt*ktd*(1.5D0/cst2-1.D0))
  41 :         xqt = sqrt(3.D0)/(4.D0*cst*aux*sqrt(q))*
  42 :      .        ((kt*kt*ktd*(kt-ktd*tat))/(aux*aux)+
  43 :      .         (tat*(ktd*ktd+kt*ktdd)+kt*ktd*(3.D0/cst2-2.D0))/q)
  44 :         xtt = (0.75D0)/(q*aux*cst2)*
  45 :      .        (-(kt*ktd/aux)**2+(ktd*ktd+kt*ktdd+3.D0*kt*ktd*tat)/q)
  46 :       endif
  47 :       return
  48 :       end
  49 :  
  50 :  
  51 :