diff -r -c -b -B -N cosmomc/camb/bessels.f90 cosmomc_sampler/camb/bessels.f90
*** cosmomc/camb/bessels.f90	2009-02-20 10:10:27.000000000 +0100
--- cosmomc_sampler/camb/bessels.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1377 ****
- !CAMB spherical and hyperspherical Bessel function routines
- !This version May 2006 - minor changes to bjl (http://cosmocoffee.info/viewtopic.php?t=530)
- !Feb 2007: fixed for high l, uses Ranges
- !Feb 2009: minor fix for non-flat compiled with non-smart IF evaluation
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !Flat bessel function module
- 
-         module SpherBessels
-         use Precision
-         use ModelParams
-         use Ranges
-         implicit none
-         private
-         
- !     Bessel functions and their second derivatives for interpolation
-     
-         real(dl), dimension(:,:), allocatable ::  ajl,ajlpr, ddajlpr
- 
-         integer  num_xx, kmaxfile, file_numl,  file_l(lmax_arr)
- !      parameters for working out where the flat Bessel functions are small
- !      Both should increase for higher accuracy
- !        real(dl), parameter :: xlimmin=15._dl  , xlimfrac = 0.05_dl 
-          real(dl), parameter :: xlimmin=35._dl  , xlimfrac = 0.05_dl 
-         
-         Type(Regions):: BessRanges
- 
-         public ajl, ajlpr, ddajlpr, BessRanges, InitSpherBessels, xlimmin, xlimfrac
-         public USpherBesselWithDeriv, phi_recurs,phi_langer, bjl, Bessels_Free
-  
-        contains
- 
-          
-       subroutine InitSpherBessels
- !     This subroutine reads the jl files from disk (or generates them if not on disk)
-       use lvalues
-       implicit none
- 
-       !See if already loaded with enough (and correct) lSamp%l values and k*eta values
-       if (allocated(ajl) .and. (lSamp%l0 <= file_numl) .and. all(file_l(1:lSamp%l0)-lSamp%l(1:lSamp%l0)==0) &
-                     .and. (int(min(max_bessels_etak,CP%Max_eta_k))+1 <= kmaxfile)) return
- 
-       !Haven't made them before, so make them now
-       call GenerateBessels
-     
-       if (DebugMsgs .and. FeedbackLevel > 0) write(*,*) 'Calculated Bessels'
- 
-       end subroutine InitSpherBessels
- 
-      subroutine GenerateBessels
-        use lvalues
-        real(dl) x
-        real(dl) xlim
-        integer i,j
-        integer max_ix
- 
-  
-         if (DebugMsgs .and. FeedbackLevel > 0) write (*,*) 'Generating flat Bessels...'
-       
- 
-         file_numl= lSamp%l0 
-         file_l(1:lSamp%l0) = lSamp%l(1:lSamp%l0)
-         kmaxfile = int(min(CP%Max_eta_k,max_bessels_etak))+1
-      
- 
-         call Ranges_Init(BessRanges)
- 
-         call Ranges_Add_delta(BessRanges,0._dl, 1._dl,0.01_dl)
-         call Ranges_Add_delta(BessRanges,1._dl, 5._dl,0.1_dl)
-         call Ranges_Add_delta(BessRanges,5._dl, 25._dl,0.2_dl)
-         call Ranges_Add_delta(BessRanges,25._dl, real(kmaxfile,dl),1._dl)
- 
-         call Ranges_GetArray(bessRanges, .false.)
-         num_xx = BessRanges%npoints
- 
- 
-        max_ix = min(max_bessels_l_index,lSamp%l0)
- 
-        if (allocated(ajl)) deallocate(ajl)
-        if (allocated(ajlpr)) deallocate(ajlpr)
-        if (allocated(ddajlpr)) deallocate(ddajlpr)
-        Allocate(ajl(1:num_xx,1:max_ix))
-        Allocate(ajlpr(1:num_xx,1:max_ix))
-        Allocate(ddajlpr(1:num_xx,1:max_ix))
- 
-        do j=1,max_ix
-        
-          do  i=1,num_xx
-             x=BessRanges%points(i)
-             xlim=xlimfrac*lSamp%l(j)
-             xlim=max(xlim,xlimmin)
-             xlim=lSamp%l(j)-xlim
-             if (x > xlim) then
-                if ((lSamp%l(j)==3).and.(x <=0.2) .or. (lSamp%l(j) > 3).and.(x < 0.5) .or. &
-                             (lSamp%l(j)>5).and.(x < 1.0)) then
-                    ajl(i,j)=0
-                  else
-                   !if ( lSamp%l(j) > 40000) then
-                   ! ajl(i,j) = phi_langer(lSamp%l(j),0,1._dl,x)
-                   !else
-                    call bjl(lSamp%l(j),x,ajl(i,j))
-                   !end if
-                end if
-             else
-                   ajl(i,j)=0
-             end if
-          end do
-       end do
- 
- 
- !     get the interpolation matrix for bessel functions
- 
-       do j=1,max_ix
-          call spline(BessRanges%points,ajl(1,j),num_xx,spl_large,spl_large,ajlpr(1,j))
-          call spline(BessRanges%points,ajlpr(1,j),num_xx,spl_large,spl_large,ddajlpr(1,j))
-       end do
- 
-      end subroutine GenerateBessels
- 
-      subroutine Bessels_Free
- 
-        if (allocated(ajl)) deallocate(ajl)
-        if (allocated(ajlpr)) deallocate(ajlpr)
-        if (allocated(ddajlpr)) deallocate(ddajlpr)
-        call Ranges_Free(BessRanges)
- 
-      end  subroutine Bessels_Free
- 
-  
-          SUBROUTINE BJL(L,X,JL)
-         !!== MODIFIED SUBROUTINE FOR SPHERICAL BESSEL FUNCTIONS.                       ==!!
-         !!== CORRECTED THE SMALL BUGS IN PACKAGE CMBFAST&CAMB(for l=4,5, x~0.001-0.002)==!! 
-         !!== CORRECTED THE SIGN OF J_L(X) FOR X<0 CASE                                 ==!!
-         !!== WORKS FASTER AND MORE ACCURATE FOR LOW L, X<<L, AND L<<X cases            ==!! 
-         !!== zqhuang@astro.utoronto.ca                                                 ==!!
-         IMPLICIT NONE
-         INTEGER L
-         real(dl) X,JL
-         real(dl) AX,AX2
-         real(dl),PARAMETER::LN2=0.6931471805599453094D0
-         real(dl),PARAMETER::ONEMLN2=0.30685281944005469058277D0
-         real(dl),PARAMETER::PID2=1.5707963267948966192313217D0
-         real(dl),PARAMETER::PID4=0.78539816339744830961566084582D0
-         real(dl),parameter::ROOTPI12 = 21.269446210866192327578D0
-         real(dl),parameter::GAMMA1 =   2.6789385347077476336556D0 !/* Gamma function of 1/3 */
-         real(dl),parameter::GAMMA2 =   1.3541179394264004169452D0 !/* Gamma function of 2/3 */
-         real(dl),PARAMETER::PI=3.141592653589793238463D0
-         real(dl) NU,NU2,BETA,BETA2,COSB
-         real(dl) sx,sx2
-         real(dl) cotb,cot3b,cot6b,secb,sec2b
-         real(dl) trigarg,expterm,L3
- 
-         IF(L.LT.0)THEN
-             write(*,*) 'Can not evaluate Spherical Bessel Function with index l<0'
-             STOP
-         ENDIF
-         AX=DABS(X)
-         AX2=AX**2
-         IF(L.LT.7)THEN
-             IF(L.EQ.0)THEN
-                 IF(AX.LT.1.D-1)THEN
-                     JL=1.D0-AX2/6.D0*(1.D0-AX2/20.D0)
-                 ELSE
-                     JL=DSIN(AX)/AX
-                 ENDIF
- 
-             ELSEIF(L.EQ.1)THEN
-                 IF(AX.LT.2.D-1)THEN
-                     JL=AX/3.D0*(1.D0-AX2/10.D0*(1.D0-AX2/28.D0))
-                 ELSE
-                     JL=(DSIN(AX)/AX-DCOS(AX))/AX
-                 ENDIF
-             ELSEIF(L.EQ.2)THEN
-                 IF(AX.LT.3.D-1)THEN
-                     JL=AX2/15.D0*(1.D0-AX2/14.D0*(1.D0-AX2/36.D0))
-                 ELSE
-                     JL=(-3.0D0*DCOS(AX)/AX-DSIN(AX)*(1.D0-3.D0/AX2))/AX
-                 ENDIF
-             ELSEIF(L.EQ.3)THEN
-                 IF(AX.LT.4.D-1)THEN
-                     JL=AX*AX2/105.D0*(1.D0-AX2/18.D0*(1.D0-AX2/44.D0))
-                 ELSE
-                     JL=(DCOS(AX)*(1.D0-15.D0/AX2)-DSIN(AX)*(6.D0-15.D0/AX2)/AX)/AX
-                 ENDIF
-             ELSEIF(L.EQ.4)THEN
-                 IF(AX.LT.6.D-1)THEN
-                     JL=AX2**2/945.D0*(1.D0-AX2/22.D0*(1.D0-AX2/52.D0))
-                 ELSE
-                     JL=(DSIN(AX)*(1.D0-(45.D0-105.D0/AX2)/AX2)+DCOS(AX)*(10.D0-105.D0/AX2)/AX)/AX
-                 ENDIF
-             ELSEIF(L.EQ.5)THEN
-                 IF(AX.LT.1.D0)THEN
-                     JL=AX2**2*AX/10395.D0*(1.D0-AX2/26.D0*(1.D0-AX2/60.D0))
-                 ELSE
-                     JL=(DSIN(AX)*(15.D0-(420.D0-945.D0/AX2)/AX2)/AX-DCOS(AX)*(1.D0-(105.D0-945.0d0/AX2)/AX2))/AX
-                 ENDIF
-             ELSE
-                 IF(AX.LT.1.D0)THEN
-                     JL=AX2**3/135135.D0*(1.D0-AX2/30.D0*(1.D0-AX2/68.D0))
-                 ELSE
-                     JL=(DSIN(AX)*(-1.D0+(210.D0-(4725.D0-10395.D0/AX2)/AX2)/AX2)+ &
-                         DCOS(AX)*(-21.D0+(1260.D0-10395.D0/AX2)/AX2)/AX)/AX
-                 ENDIF
-             ENDIF
-         ELSE
-             NU=0.5D0+L
-             NU2=NU**2
-             IF(AX.LT.1.D-40)THEN
-                 JL=0.D0
-             ELSEIF((AX2/L).LT.5.D-1)THEN
-                 JL=DEXP(L*DLOG(AX/NU)-LN2+NU*ONEMLN2-(1.D0-(1.D0-3.5D0/NU2)/NU2/30.D0)/12.D0/NU) &
-                    /NU*(1.D0-AX2/(4.D0*NU+4.D0)*(1.D0-AX2/(8.D0*NU+16.D0)*(1.D0-AX2/(12.D0*NU+36.D0))))
-             ELSEIF((real(L,dl)**2/AX).LT.5.D-1)THEN
-                 BETA=AX-PID2*(L+1)
-                 JL=(DCOS(BETA)*(1.D0-(NU2-0.25D0)*(NU2-2.25D0)/8.D0/AX2*(1.D0-(NU2-6.25)*(NU2-12.25D0)/48.D0/AX2)) &
-                    -DSIN(BETA)*(NU2-0.25D0)/2.D0/AX* (1.D0-(NU2-2.25D0)*(NU2-6.25D0)/24.D0/AX2*(1.D0-(NU2-12.25)* &
-                        (NU2-20.25)/80.D0/AX2)) )/AX   
-             ELSE
-                 L3=NU**0.325
-                 IF(AX .LT. NU-1.31*L3) then
-                     COSB=NU/AX
-                     SX = DSQRT(NU2-AX2)
-                     COTB=NU/SX
-                     SECB=AX/NU
-                     BETA=DLOG(COSB+SX/AX)
-                     COT3B=COTB**3
-                     COT6B=COT3B**2
-                     SEC2B=SECB**2
-                     EXPTERM=( (2.D0+3.D0*SEC2B)*COT3B/24.D0 &
-                        - ( (4.D0+SEC2B)*SEC2B*COT6B/16.D0 &
-                        + ((16.D0-(1512.D0+(3654.D0+375.D0*SEC2B)*SEC2B)*SEC2B)*COT3B/5760.D0 &
-                        + (32.D0+(288.D0+(232.D0+13.D0*SEC2B)*SEC2B)*SEC2B)*SEC2B*COT6B/128.D0/NU)*COT6B/NU) &
-                        /NU)/NU
-                     JL=DSQRT(COTB*COSB)/(2.D0*NU)*DEXP(-NU*BETA+NU/COTB-EXPTERM)
- 
-                 !          /**************** Region 2: x >> l ****************/
- 
-                 ELSEIF (AX .GT. NU+1.48*L3) then
-                     COSB=NU/AX
-                     SX=DSQRT(AX2-NU2)
-                     COTB=NU/SX
-                     SECB=AX/NU
-                     BETA=DACOS(COSB)
-                     COT3B=COTB**3
-                     COT6B=COT3B**2
-                     SEC2B=SECB**2
-                     TRIGARG=NU/COTB-NU*BETA-PID4 &
-                            -((2.0+3.0*SEC2B)*COT3B/24.D0  &
-                            +(16.D0-(1512.D0+(3654.D0+375.D0*SEC2B)*SEC2B)*SEC2B)*COT3B*COT6B/5760.D0/NU2)/NU
-                     EXPTERM=( (4.D0+sec2b)*sec2b*cot6b/16.D0 &
-                            -(32.D0+(288.D0+(232.D0+13.D0*SEC2B)*SEC2B)*SEC2B)*SEC2B*COT6B**2/128.D0/NU2)/NU2
-                     JL=DSQRT(COTB*COSB)/NU*DEXP(-EXPTERM)*DCOS(TRIGARG)
- 
-                 !          /***************** Region 3: x near l ****************/
- 
-                 ELSE
-                     BETA=AX-NU
-                     BETA2=BETA**2
-                     SX=6.D0/AX
-                     SX2=SX**2
-                     SECB=SX**0.3333333333333333d0
-                     SEC2B=SECB**2
-                     JL=( GAMMA1*SECB + BETA*GAMMA2*SEC2B &
-                           -(BETA2/18.D0-1.D0/45.D0)*BETA*SX*SECB*GAMMA1 &
-                           -((BETA2-1.D0)*BETA2/36.D0+1.D0/420.D0)*SX*SEC2B*GAMMA2   &
-                           +(((BETA2/1620.D0-7.D0/3240.D0)*BETA2+1.D0/648.D0)*BETA2-1.D0/8100.D0)*SX2*SECB*GAMMA1 &
-                           +(((BETA2/4536.D0-1.D0/810.D0)*BETA2+19.D0/11340.D0)*BETA2-13.D0/28350.D0)*BETA*SX2*SEC2B*GAMMA2 &
-                           -((((BETA2/349920.D0-1.D0/29160.D0)*BETA2+71.D0/583200.D0)*BETA2-121.D0/874800.D0)* &
-                            BETA2+7939.D0/224532000.D0)*BETA*SX2*SX*SECB*GAMMA1)*DSQRT(SX)/ROOTPI12
-                 ENDIF
-             ENDIF
-         ENDIF
-         IF(X.LT.0.AND.MOD(L,2).NE.0)JL=-JL
-         END SUBROUTINE BJL    
- 
-  !    end module SpherBessels
- 
- 
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !                                                                      c
- ! Calculation of ultraspherical Bessel functions.                      c
- ! Fortran version of the c program hyperjl.c by Arthur Kosowsky.       c
- ! WKB approx described in astro-ph/9805173                             c
- !                                                                      c
- ! Modifications by Anthony Challinor and Antony Lewis                  c
- ! Minor modifications to correct K=1 case outside [0,pi],              c
- ! the small chi approximations for lSamp%l=0 and lSamp%l=1, and                    c
- ! the quadratic approximation to Q(x) around Q(x)=0.                   c
- ! Bug fixed in downwards recursion (phi_recurs)                        c
- !                                                                      c
- ! The routine phi_recurs uses recursion relations to calculate         c
- ! the functions, which is accurate but relatively slow.                c  
- !   ***NOT STABLE FOR K=1 or for all cases ***                         c
- !                                                                      c
- ! The routine phi_langer uses Langer's formula for a                   c
- ! uniform first-order asymptotic approximation in the open, closed     c
- ! and flat cases. This approximation is EXCELLENT for all lSamp%l >= 3.      c
- !                                                                      c
- ! The routine qintegral calculates the closed-form answer              c
- ! to the eikonal integral used in the WKB approximation.               c
- !                                                                      c
- ! The routine airy_ai returns the Airy function Ai(x) of the argument  c
- ! passed. It employs a Pade-type approximation away from zero and      c
- ! a Taylor expansion around zero. Highly accurate.                     c
- !                                                                      c
- ! The routines polevl and p1evl are auxiliary polynomial               c
- ! evaluation routines used in the airy function calculation.           c
- !                                                                      c
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
- 
- 
- ! module USpherBessels
- ! use Precision
- ! implicit none
- ! private 
-  
-  
-  !public USpherBesselWithDeriv, phi_recurs,phi_langer
-  
-  
- ! contains
- 
-         subroutine USpherBesselWithDeriv(closed,Chi,l,beta,y1,y2)
-           !returns y1=ujl*sinhChi and y2=diff(y1,Chi)
-           !aim for accuracy > 1% for all inputs
-         real(dl) Chi,beta,y1,y2,sinhChi,cothChi
-         real(dl) sin_K, cot_K
-         integer l,K
-         logical, intent(IN) :: closed
-         logical DoRecurs
-         
-         if (closed) then
-             sin_K = sin(Chi) 
-             cot_K= 1._dl/tan(Chi)
-             K=1
-          else 
-             sin_K=sinh(Chi)
-             cot_K = 1._dl/tanh(Chi)
-             K=-1
-          end if
-       
-         sinhChi = sin_K
-         cothChi = cot_K
-    
-        DoRecurs = ((l<=30).OR.((.not.closed.or.(abs(Chi-pi/2)>0.2d0)).and.(beta*l<750) &
-             .or.closed.and.(beta*l<4000)))
- 
- !Deep in the tails the closed recursion relation is not stable
- !Added July 2003 to prevent problems with very nearly flat models
-        if (DoRecurs .and. closed) then
-         if  (Chi < asin(sqrt(l*(l+1._dl))/beta) - 2/beta) then
-            if (phi_langer(l,K,beta,Chi) < 1e-7) then
-              call phi_small_closed_int(l,beta,chi,y1,y2)
-              return
-            end if 
-        end if     
-      end if        
- 
-      if (DoRecurs) then 
-              !use recursive evaluation where WKB is poor and recurs is fast anyway.
-          y1=phi_recurs(l,K,beta,Chi)*sinhChi
-          y2=y1*(l+1)*cothChi
-          if (.not.closed.or.(l+1<nint(beta))) y2=y2 - &
-               sqrt(beta**2-(K*(l+1)**2))*phi_recurs(l+1,K,beta,Chi)*sinhChi
-           !of course we could get y2 much more quickly by modifying
-           !phi_recurs to return l and l+1 for each beta,Chi...
- 
- 
-          else !WKB approx
-          y1=phi_langer(l,K,beta,Chi)*sinhChi
-          y2=y1*(l+1)*cothChi   
-          if (.not.closed.or.(l+1<nint(beta))) y2=y2 - &
-               sqrt(beta**2-(K*(l+1)**2))*phi_langer(l+1,K,beta,Chi)*sinhChi  
-          
-          end if
-         
-         end subroutine USpherBesselWithDeriv
- 
- 
- 
- !Calculates y1,y2 (noramlized to a value near the turning point)  
- !by integrating up the differential equation and normalizing to phi_recurs
- !in the region in which phi_recurs is stable
- !This allows closed functions to be computed where chi << turning point
-    subroutine phi_small_closed_int(l,beta,chi,y1,y2)
-    integer, intent(IN) :: l
-    real(dl), intent(IN) :: beta, chi
-    real(dl) y1,y2
-    
-    integer nsteps,i
-   
-    real(dl) ap1,nu2,dydchi1,dydchi2,yt1,yt2,dyt1,dyt2,dym1,dym2
-    real(dl) x0, delchi,sh, h6,x
-    real(dl) y1_x,y2_x, tmp,xh,hh
-  
-    nsteps = 200
-    ap1 = l*(l+1)
-    x0 = sqrt(ap1)/beta
-    nu2 = beta**2
- 
-    if ((beta*chi)**2/l < 0.005) then
-  !Series solution
-     
-      x = chi
-      sh = sin(x)
-      tmp=(ap1/sh**2 - nu2)
-      y1=1e-20  
-      y2 = ((l+1)/x - (nu2-ap1/3)/(2*l+3)*x) * y1
-    else
- 
-    x = max(1d-7,chi - 50._dl/l)
-    y1=1e-20  
-    y2 = (l+1)*y1/x
-    
-    delchi = (chi-x)/nSteps
-    h6=delchi/6
-    hh=delchi/2
-    sh = sin(x)
-    tmp=(ap1/sh**2 - nu2) 
-    
-           do i=1,nSteps          
- ! One step in the ujl integration
- ! fourth-order Runge-Kutta method to integrate equation for ujl
- 
-             dydchi1=y2         !deriv y1
-             dydchi2=tmp*y1     !deriv y2     
-             xh=x+hh          !midpoint of step
-             yt1=y1+hh*dydchi1  !y1 at midpoint
-             yt2=y2+hh*dydchi2  !y2 at midpoint
-             dyt1=yt2           !deriv y1 at mid
-             tmp=(ap1/sin(xh)**2 - nu2) 
-             
-             
-             dyt2=tmp*yt1       !deriv y2 at mid
-        
-             yt1=y1+hh*dyt1     !y1 at mid
-             yt2=y2+hh*dyt2     !y2 at mid
-            
-             dym1=yt2           !deriv y1 at mid
-             dym2=tmp*yt1       !deriv y2 at mid
-             yt1=y1+delchi*dym1 !y1 at end
-             dym1=dyt1+dym1     
-             yt2=y2+delchi*dym2 !y2 at end
-             dym2=dyt2+dym2
-             
-             x=x+delchi     !end point
-             sh=sin(x)    
-             dyt1=yt2           !deriv y1 at end
-             tmp=(ap1/sh**2 - nu2)
-             dyt2=tmp*yt1       !deriv y2 at end
-             y1=y1+h6*(dydchi1+dyt1+2*dym1) !add up
-             y2=y2+h6*(dydchi2+dyt2+2*dym2)       
-            if (y1 > 1d10 .or. y2> 1d10) then
-          
-               y1=y1/1d10
-               y2=y2/1d10
-         
-            end if
-          end do
- 
-       end if     
-    
-        y1_x = y1; y2_x = y2 
- 
-        delchi = (x0 - chi)/nSteps
-        h6=delchi/6
-        hh=delchi/2
- 
-           do i=1,nSteps          
- ! One step in the ujl integration
- ! fourth-order Runge-Kutta method to integrate equation for ujl
- 
-             dydchi1=y2         !deriv y1
-             dydchi2=tmp*y1     !deriv y2     
-             xh=x+hh          !midpoint of step
-             yt1=y1+hh*dydchi1  !y1 at midpoint
-             yt2=y2+hh*dydchi2  !y2 at midpoint
-             dyt1=yt2           !deriv y1 at mid
-             tmp=(ap1/sin(xh)**2 - nu2) 
-             
-             
-             dyt2=tmp*yt1       !deriv y2 at mid
-        
-             yt1=y1+hh*dyt1     !y1 at mid
-             yt2=y2+hh*dyt2     !y2 at mid
-            
-             dym1=yt2           !deriv y1 at mid
-             dym2=tmp*yt1       !deriv y2 at mid
-             yt1=y1+delchi*dym1 !y1 at end
-             dym1=dyt1+dym1     
-             yt2=y2+delchi*dym2 !y2 at end
-             dym2=dyt2+dym2
-             
-             x=x+delchi     !end point
-             sh=sin(x)    
-             dyt1=yt2           !deriv y1 at end
-             tmp=(ap1/sh**2 - nu2)
-             dyt2=tmp*yt1       !deriv y2 at end
-             y1=y1+h6*(dydchi1+dyt1+2*dym1) !add up
-             y2=y2+h6*(dydchi2+dyt2+2*dym2)       
-             if (y1 > 1d10 .or. y2 > 1d10) then
-               y1=y1/1d10
-               y2=y2/1d10
-               y1_x = y1_x/1d10
-               y2_x = y2_x/1d10
-         
-             end if
-          end do
- 
- 
-          tmp = phi_recurs(l,1,beta,x0)*sin(x0) / y1
-          y1 = y1_x * tmp
-          y2 = y2_x * tmp
- 
- 
-    end subroutine phi_small_closed_int
-  
- !***********************************************************************
- !                                                                      *
- ! Calculates Phi(l,beta,chi) using recursion on l.                     *
- ! See Abbot and Schaefer, ApJ 308, 546 (1986) for needed               *
- ! recursion relations and closed-form expressions for l=0,1.           *
- ! (Note: Their variable y is the same as chi here.)                    *
- !                                                                      *
- ! When the flag direction is negative, downwards recursion on l        *
- ! must be used because the upwards direction is unstable to roundoff   *
- ! errors. The downwards recursion begins with arbitrary values and     *
- ! continues downwards to l=1, where the desired l value is normalized  *
- ! using the closed form solution for l=1. (See, e.g., Numerical        *
- ! Recipes of Bessel functions for more detail)                         *
- !                                                                      *
- !***********************************************************************
- 
-   function phi_recurs(l, K, beta, chi)
-   !doesn't like values which give exponentially small phi
-   integer, intent(IN) :: l, K
-   real(dl), intent(IN) :: beta, chi
-   real(dl) phi_recurs
-   integer j, direction, lstart,ibeta
-   real(dl) ell, kay, arg, answer,beta2
-   real(dl) root_K
-   real(dl) phi0, phi1, phi_plus, phi_zero, phi_minus, b_zero, b_minus 
-   real(dl), parameter :: ACC=40._dl, BIG=1.d10
-   real(dl) sin_K, cot_K
- 
-   ell=dble(l)
-  
-  
-   ! Test input values
- 
-   if(l<0) then
-      write(*,*) "Bessel function index ell < 0"
-      stop
-   endif
-   if(beta<0._dl) then
-      write(*,*) "Wavenumber beta < 0"
-      stop
-   endif
-   if ((abs(K)/=1).and.(K/=0)) then
-      write(*,*) "K must be 1, 0 or -1"
-      stop
-   end if
-   
-   if(K==1) then    
-      ibeta=nint(beta)
-      if(ibeta<3) then
-         write(*,*) "Wavenumber beta < 3 for K=1"
-         stop
-      endif
-      if(ibeta<=l) then
-         write(*,*) "Wavenumber beta <= l"
-         stop
-      endif
-   endif
-  
-   if (chi<1/BIG) then
-      phi_recurs=0
-      return
-   end if
-  
-   kay = dble(K)
-   arg = beta * chi
-   beta2 = beta**2
- 
-   if(K == 0) then
-      cot_K = 1._dl/chi
-      sin_K = chi
-      root_K = beta
-   else 
-    root_K = sqrt(beta2 -kay*ell*ell)
-   
-     if(K == -1) then
-     cot_K = 1._dl/tanh(chi)
-     sin_K = sinh(chi)   
-     else
-     cot_K = 1._dl/tan(chi)
-     sin_K = sin(chi)   
-     end if
-   
-   endif
-  
-   
-   ! Closed form solution for l=0
-  
-   if (abs(chi) < 1.d-4) then
-     if (abs(arg)<1.d-4) then
-      phi0 = 1._dl-chi**2*(beta*beta-kay)/6._dl
-     else
-      phi0=sin(arg)/arg
-     end if
-   else     
-      phi0 = sin(arg) / (beta * sin_K)
-   end if
- 
-   if (l==0) then
-        phi_recurs=phi0
-        return 
-    end if
- 
- 
-      ! Closed form solution for l=1
- 
-      if((abs(chi) < 1.d-4).and.(K/=0)) then
-         if(arg < 1.d-4) then
-            phi1 = chi*sqrt(beta*beta-kay)/3._dl
-            !beta2 * chi / (3._dl * sqrt(1._dl+ kay * beta2))
-         else 
-            phi1 = (sin(arg)/arg-cos(arg))/(sqrt(beta*beta-kay)*chi)
-              !(sin(arg)/arg - cos(arg))/arg
-         end if
-      elseif ((abs(arg) < 1.d-4).and.(K == 0)) then
-         phi1 = arg / 3._dl
-      else 
-         if (K /= 0 ) then
-            phi1 = sin(arg) * cot_K / (beta * sin_K) - cos(arg) / sin_K
-            phi1 = phi1/sqrt(beta2 - kay)
-         else
-            phi1 = (sin(arg)/arg - cos(arg))/arg
-         end if
-      end if
-      if(l==1) then
-         phi_recurs=phi1
-         return
-      end if
-      ! Find recursion direction
-      !  direction = +1 for upward recursion, -1 for downward
- 
-      if(abs(cot_K) < root_K / ell) then 
-         direction = 1
-      else 
-         direction = -1
-      end if
-     
-      ! For K=1, must do upwards recursion:
-      ! NOT STABLE for all values of chi
- 
-      if(K==1) direction = 1
- 
-      ! Do upwards recursion on l
-     
-      
-      if(direction == 1)then
-         b_minus = sqrt(beta2 - kay)
-         phi_minus = phi0
-         phi_zero = phi1
-       
-         do j=2,l 
-            
-            if(K == 0) then
-               phi_plus = ((2*j-1) * cot_K * phi_zero - beta*phi_minus)/ beta
-            else 
-               b_zero = sqrt(beta2 - (K*j*j))  
-               phi_plus = ((2*j-1) * cot_K * phi_zero - b_minus * phi_minus) / b_zero
-               b_minus = b_zero
-            end if
-            phi_minus = phi_zero
-            phi_zero = phi_plus
-         end do
-       
-       
-         phi_recurs=phi_plus
-         
-      
-         return
- 
-         ! Do downwards recursion on l
- 
-      else 
-         lstart = l + 2 * int(sqrt(ell*ACC))
-       
-         b_zero = sqrt(beta2 - dble(K*lstart*lstart))
-         phi_plus = 0._dl
-         phi_zero = 1._dl
-         answer = 0._dl
-        
-         do j= lstart - 2,1,-1
-            
-            if(K == 0) then
-               phi_minus = ((2*j + 3) * cot_K * phi_zero - beta * phi_plus) / beta
-            else
-               b_minus = sqrt(beta2 - (K*(j+1)**2))  
-               phi_minus = ((2*j + 3) * cot_K * phi_zero - b_zero * phi_plus) / b_minus
-               b_zero = b_minus
-            end if
-            phi_plus = phi_zero
-            phi_zero = phi_minus
- 
-            if(j == l) answer = phi_minus
-            if((abs(phi_zero) > BIG).and.(j/=1)) then
-               phi_plus = phi_plus/BIG
-               phi_zero = phi_zero/BIG            
-               answer = answer/BIG
-            end if
-         end do
- 
-         ! Normalize answer to previously computed phi1
- 
-         answer = answer*phi1 / phi_minus
-         phi_recurs=answer    
-        
-      end if
-  
-    end function phi_recurs
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !                                                                      c
- ! Calculates Phi(l,beta,chi) using the Langer uniform approximation    c
- ! to the first-order WKB approximation.                                c
- ! See C.M. Bender and S.A. Orszag,  Mathematical Methods for           c
- ! Scientists and Engineers (McGraw-Hill, 1978; LC QA371.B43),          c
- ! chapter 10.                                                          c
- !                                                                      c
- ! Differential equation for needed function can be cast into the       c
- ! Schrodinger form      \epsilon^2 y'' = Q(x) y                        c
- ! where \epsilon^2 = 1/l(l+1) and Q(x) depends on the parameter        c
- ! alpha \equiv beta * epsilon.                                         c
- !                                                                      c
- ! In the K= +1 case, the function is                                   c
- ! determined by its value on the interval [0, pi/2] and the symmetry   c
- ! conditions Phi(chi + pi) = (-1)^{beta - l - 1} Phi(chi),             c
- !            Phi(pi - chi) = (-1)^{beta - l - 1} Phi(chi).             c
- ! This interval contains one turning point, so the Langer formula      c
- ! can be used.                                                         c
- ! Note that the second condition at chi = pi/2 gives an eigenvalue     c
- ! condition on beta, which  must corrected. For the lowest             c
- ! eigenvalue(s), the region between the turning points is not large    c
- ! enough for the asymptotic solution to be valid, so the functions     c
- ! have a small discontinuity or discontinuous derivative at pi/2;      c
- ! this behavior is corrected by employing a 4-term asymptotic          c
- ! series around the regular point chi=pi/2.                            c
- ! The exact eigenvalue condition requires that beta must be an         c
- ! integer >= 3 with beta > l. Note this implies alpha > 1.             c
- !                                                                      c
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-       
- 
- 
-       function phi_langer(l,K,beta,chi)
-       integer l,K,ibeta,kay
-       real(dl) phi_langer
-       real(dl) ell,symm, anu, alpha2
-       real(dl) beta,chi,eikonal, wkb, arg, arg2, tmp
-       real(dl) epsilon, alpha, chi0, x, a, b,achi 
-     
-       real(dl) cot_K, sin_K
-       real(dl), parameter :: PI=3.1415926536d0,ROOTPI=1.772453851d0,ROOT2PI=2.506628275d0, &
-                            PIOVER2=1.570796327d0
- 
-       ell=dble(l)
-       achi=chi
-    
-       symm=1._dl
- !
- ! Test input values
- !
-       if(l<0) then
-          write(*,*) "Bessel function index ell < 0"
-          stop
-       endif
-       if(beta<0._dl) then
-          write(*,*) "Wavenumber beta < 0"
-          stop
-       endif
-       if ((abs(K)/=1).and.(K/=0)) then
-         write(*,*) "K must be 1, 0 or -1"
-         stop
-       end if
- 
-       
-       if(K == 1) then        
-          ibeta=nint(beta)
-          if(ibeta<3) then
-             write(*,*) "Wavenumber beta < 3 for K=1"
-             stop
-          endif
-          if(ibeta<=l) then
-             write(*,*) "Wavenumber beta <= l"
-             stop
-          endif
-       endif
-    
-       kay=K
- 
- 
- ! For closed case, find equivalent chi in [0,pi/2]
- !
-       if(K==1) then
-          achi=achi-2._dl*Pi*int(achi/2._dl/PI)
-          if(achi>PI) then
-             achi=2._dl*PI-achi
-             if(2*(l/2).eq.l) then
-                symm=symm
-             else
-                symm=-symm
-             endif
-          endif
-          if(achi>PI/2._dl) then
-             achi=PI-achi
-             if(2*((ibeta-l-1)/2).eq.(ibeta-l-1)) then
-                symm=symm
-             else
-                symm=-symm
-             endif
-          endif
-       endif
- 
- ! Definitions
-       if(K == 0) then
-           sin_K = achi         
-       else 
-             if(K == -1) then
-                sin_K = sinh(achi)   
-              else
-                sin_K = sin(achi)   
-             end if           
-       endif 
- 
- ! Closed form solution for l=0
- !
-       if(l == 0) then
-          arg=beta*achi
-        
-          if((abs(achi)<1.d-4).and.(K/=0)) then
-             if(abs(arg)<1.d-4) then
-                wkb=1._dl-achi*achi*(beta*beta-kay)/6._dl
-             else
-                wkb=sin(arg)/arg
-             endif
-          else if((abs(arg)<1.d-4).and.(K==0)) then
-             wkb=1._dl-arg*arg/6._dl
-          else
-             wkb=sin(arg)/(beta*sin_K)
-          endif
-          phi_langer=symm*wkb
-          return
-       endif
- !
- ! Closed form solution for l=1
- !
-       if(l==1) then
-          arg=beta*achi
-       
-          if((abs(achi)<1.d-4).and.(K/=0)) then
-             if(abs(arg)<1.d-4) then
-                wkb=achi*sqrt(beta*beta-kay)/3._dl
-             else
-                wkb=(sin(arg)/arg-cos(arg))/(sqrt(beta*beta-kay)*achi)
-             endif
-          else if((abs(arg)<1.d-4).and.(K==0)) then
-             wkb=arg/3._dl
-          else 
-           if(K/=0) then
-             if(K==1) then
-                cot_K=1._dl/tan(achi)
-             else
-                cot_K=1._dl/tanh(achi)
-             endif
-             wkb=sin(arg)*cot_K/(beta*sin_K)-cos(arg)/sin_K
-             wkb=wkb/sqrt(beta*beta-kay)
-          else
-             wkb=(sin(arg)/arg-cos(arg))/arg
-          endif
-          end if
-          phi_langer=symm*wkb
-          return
-       endif
- !
- ! Closed form solution for K=1 and beta = l+1 (lowest eigenfunction)
- !
-       if((K==1).and.(ibeta == (l+1))) then
-          wkb=(sin_K**ell)* &
-               sqrt(sqrt(2._dl*PI/(2._dl*ell+1._dl))*ell/((ell+1._dl)*(2._dl*ell+1._dl)))
-          wkb=wkb*(1+0.1875d0/ell-0.013671875/(ell*ell))
-          phi_langer=symm*wkb
-          return
-       endif
- 
- ! Very close to 0, return 0 (exponentially damped)
- !
-       if(abs(achi)<1.d-8) then
-          phi_langer=0._dl
-          return
-       endif
- 
- 
- ! For closed case, find corrected eigenvalue beta
- !
-       if(K==1) then
-          anu=dble(ibeta)-1._dl/(8._dl*ell)+1._dl/(16._dl*ell*ell)
-       else
-          anu=beta
-       endif
- !
- ! Evaluate epsilon using asymptotic form for large l
- !
-       if(l<20) then
-          epsilon=1._dl/sqrt(ell*(ell+1._dl))
-       else
-          epsilon=1._dl/ell-0.5d0/(ell*ell)+0.375d0/(ell*ell*ell)
-       endif
-      
-       alpha=epsilon*anu
- !
- ! Calculate the turning point where Q(x)=0.
- ! Function in question has only a single simple turning point.
- !
-       if(K==-1) chi0=log((1._dl+sqrt(1._dl+alpha*alpha))/alpha)
-       if(K==0) chi0=1._dl/alpha
-       if(K==1) chi0=asin(1._dl/alpha)
-  
- 
- ! Very close to chi0, use usual wkb form to avoid dividing by zero
- !
-       if(abs(achi-chi0)<1.d-5) then
- 
- ! Calculate coefficients of linear and quadratic terms in Q(x) expansion
- ! in the neighborhood of the turning point
- ! Q(chi)=a*(chi0-chi)+b*(chi0-chi)**2
-          alpha2=alpha*alpha
-        
-          if(K==-1) then
-             a=2._dl*alpha2*sqrt(alpha2+1._dl)
-             b=3._dl*alpha2**2+2._dl*alpha2
-          endif
-          if(K==0) then
-             a=2._dl*alpha2*alpha
-             b=3._dl*alpha2**2
-          endif
-          if(K==1) then
-             a=2._dl*alpha2*sqrt(alpha2-1._dl)
-             b=3._dl*alpha2**2-2._dl*alpha2
-          endif
-        
- ! Dependent variable x for which Q(x)=0 at x=0
- ! x>0 is the evanescent region
- !
-          x=chi0-achi
- !
- ! Argument of Airy function
- !
-          arg=(x+b*x*x/(5._dl*a))/(epsilon*epsilon/a)**(0.333333333d0)
- !
- ! Evaluate Airy function
- !
-          wkb=airy_ai(arg)
- !
- ! Rest of functional dependence
- !
-          wkb=wkb*(1._dl-b*x/(5._dl*a))/sin_K 
- !  Normalization factor:
- 
-          wkb=wkb*symm*ROOTPI*((a*epsilon)**(-0.1666667d0))*sqrt(epsilon/anu)
-          phi_langer=wkb  
-         
-          return
-       endif
- 
- 
- ! Langer approximation.
- !
- ! Transport factor:
- !
-       tmp=sqrt(abs(1._dl/(sin_K*sin_K)-alpha*alpha))
-      
- ! Eikonal factor
- !
-       eikonal=qintegral(sin_K,alpha,K)
- 
-     
-      
-       arg=(1.5d0*eikonal/epsilon)**(1._dl/3._dl)
-    
-       arg2=arg*arg
-       if(achi>chi0) arg2=-arg2
-       
- ! Multiply factors together
- 
-       wkb=airy_ai(arg2)*symm*ROOTPI*sqrt(arg*epsilon/anu/tmp)/Sin_K
-       phi_langer=wkb
- 
-       end function phi_langer
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !                                                                       c
- ! Evaluates the exact solution to  the integral giving the WKB          c
- ! eikonal solution,   \int^x sqrt(abs(Q(x))) dx                         c
- !                                                                       c
- ! In the open case, this integral costs 1 or 2 square roots, an atan    c
- ! and a log; its evaluation will be roughly as expensive as the rest    c
- ! of the Phi routine. An analytic fit cannot be substantially faster    c
- ! because the dependence on alpha of the y-intercept of the linear      c
- ! region of the integrand contains a log and an atan, so at best a fit  c
- ! can only save the computation of the square roots.                    c
- !                                                                       c
- ! The integrals are very bland functions of chi and alpha and could     c
- ! be precomputed and cached to save computation time; interpolation     c
- ! on a relatively small number of points should be very accurate        c
- !                                                                       c
- ! Note that for the closed case, the variable arg must be between 0     c
- ! and alpha; for arg > alpha, symmetry properties reduce the needed     c
- ! integral to this case.                                                c
- !                                                                       c
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-       function qintegral(sin_K,alpha, K)
-       implicit none
-       real(dl) qintegral, sin_K
-       integer K
-       real(dl) alpha,exact,arg, root1, root2, dummyarg
-      
-       real(dl), parameter :: PI=3.1415926536d0,ROOTPI=1.772453851d0,ROOT2PI=2.506628275d0, &
-                            PIOVER2=1.570796327d0
- 
-       arg=alpha*sin_K
- 
-       if(K==0) then
-          if(arg>1._dl) then
-             exact=sqrt(arg*arg-1._dl)-acos(1._dl/arg)
-             qintegral=exact
-             return
-          else
-             root1=sqrt(1._dl-arg*arg)
-             exact=log((1._dl+root1)/arg)-root1
-             qintegral=exact
-             return
-          endif
-       else if(K==-1) then
-          if(arg>1._dl) then
-             root1=sqrt(arg*arg-1._dl)
-             root2=sqrt(arg*arg+alpha*alpha)
-             exact=alpha/2._dl*log((2._dl*arg*arg+alpha*alpha-1._dl+ &
-                   2._dl*root1*root2)/(1._dl+alpha*alpha))+atan(root2/ &
-                   (alpha*root1))-PIOVER2
-             qintegral=exact
-             return
-          else
-             root1=sqrt((1._dl-arg*arg)*(arg*arg+alpha*alpha))
-             exact=alpha/2._dl*atan(-2._dl*root1/(2*arg*arg+alpha*alpha- &
-                   1._dl))+0.5d0*log((2._dl*alpha*root1+2._dl*alpha*alpha+ &
-                   arg*arg*(1._dl-alpha*alpha))/(arg*arg*(1._dl+ &
-                   alpha*alpha)))
-             if(2._dl*arg*arg+alpha*alpha-1._dl<0._dl) then
-                exact=exact-alpha*PIOVER2
-             endif
-             qintegral=exact
-             return
-          endif
-       else
-          if(arg>1._dl) then
-             root1=sqrt(arg*arg-1._dl)
-             root2=sqrt(alpha*alpha-arg*arg)
-             exact=alpha/2._dl*atan(-2._dl*root1*root2/ &
-                (2._dl*arg*arg-alpha*alpha-1._dl))- &
-                atan(-root2/(root1*alpha))-PIOVER2
-             if(2._dl*arg*arg-alpha*alpha-1._dl>0._dl) then
-                exact=exact+alpha*PIOVER2
-             endif
-          else
-             root1=sqrt((1._dl-arg*arg)*(alpha*alpha-arg*arg))
-             dummyarg=alpha*(1._dl-arg*arg)/root1
-             exact=0.5d0*log((1._dl+dummyarg)/(1._dl-dummyarg))- &
-              alpha/2._dl*log((alpha*alpha-2._dl*arg*arg+1._dl+2._dl*root1)/ &
-              (alpha*alpha-1._dl))
-          endif
-          qintegral=exact
-          return
-       endif
-    
-       end function qintegral 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !                                                                      c
- !       Airy function                                                  c
- !                                                                      c
- ! Modified from original routine by Stephen Moshier, available         c
- ! as part of the Cephes library at www.netlib.com                      c
- ! Modifications: eliminates calculation of Bi(x), Ai'(x), Bi'(x)       c
- ! and translation to Fortran                                           c
- !                                                                      c
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !
- ! DESCRIPTION:
- !
- ! Solution of the differential equation
- !
- !       y"(x) = xy.
- !
- ! The function returns the two independent solutions Ai, Bi
- ! and their first derivatives Ai'(x), Bi'(x).
- !
- ! Evaluation is by power series summation for small x,
- ! by rational minimax approximations for large x.
- !
- !
- !
- ! ACCURACY:
- ! Error criterion is absolute when function <= 1, relative
- ! when function > 1, except * denotes relative error criterion.
- ! For large negative x, the absolute error increases as x^1.5.
- ! For large positive x, the relative error increases as x^1.5.
- !
- ! Arithmetic  domain   function  # trials      peak         rms
- ! IEEE        -10, 0     Ai        10000       1.6e-15     2.7e-16
- ! IEEE          0, 10    Ai        10000       2.3e-14*    1.8e-15*
- ! IEEE        -10, 0     Ai'       10000       4.6e-15     7.6e-16
- ! IEEE          0, 10    Ai'       10000       1.8e-14*    1.5e-15*
- ! IEEE        -10, 10    Bi        30000       4.2e-15     5.3e-16
- ! IEEE        -10, 10    Bi'       30000       4.9e-15     7.3e-16
- ! DEC         -10, 0     Ai         5000       1.7e-16     2.8e-17
- ! DEC           0, 10    Ai         5000       2.1e-15*    1.7e-16*
- ! DEC         -10, 0     Ai'        5000       4.7e-16     7.8e-17
- ! DEC           0, 10    Ai'       12000       1.8e-15*    1.5e-16*
- ! DEC         -10, 10    Bi        10000       5.5e-16     6.8e-17
- ! DEC         -10, 10    Bi'        7000       5.3e-16     8.7e-17
- !
- !
- ! Cephes Math Library Release 2.1:  January, 1989
- ! Copyright 1984, 1987, 1989 by Stephen lSamp%l. Moshier
- ! Direct inquiries to 30 Frost Street, Cambridge, MA 02140
- !
- 
-       function airy_ai(x)
-       implicit none
-       real(dl) airy_ai
-       real(dl) x,z, zz, t, f, g, uf, ug, zeta, theta
-       real(dl) ak
-       real(dl) AN(8),AD(8),AFN(9),AFD(9),AGN(11),AGD(10)
-       real(dl), parameter :: AMAXAIRY=25.77d0,ACC=1.d-8,PI=3.1415926536d0
-       real(dl), parameter :: c1=0.35502805388781723926d0, c2=0.258819403792806798405d0
-       real(dl), parameter :: sqrt3=1.732050807568877293527d0,sqpii=5.64189583547756286948d-1
-      
-       
-       AN(1)=3.46538101525629032477d-1
-       AN(2)=1.20075952739645805542d1
-       AN(3)=7.62796053615234516538d1
-       AN(4)=1.68089224934630576269d2
-       AN(5)=1.59756391350164413639d2
-       AN(6)=7.05360906840444183113d1
-       AN(7)=1.40264691163389668864d1
-       AN(8)=9.99999999999999995305d-1
- 
-       AD(1)=5.67594532638770212846d-1
-       AD(2)=1.47562562584847203173d1
-       AD(3)=8.45138970141474626562d1
-       AD(4)=1.77318088145400459522d2
-       AD(5)=1.64234692871529701831d2
-       AD(6)=7.14778400825575695274d1
-       AD(7)=1.40959135607834029598d1
-       AD(8)=1.00000000000000000470d0
- 
-       AFN(1)=-1.31696323418331795333d-1
-       AFN(2)=-6.26456544431912369773d-1
-       AFN(3)=-6.93158036036933542233d-1
-       AFN(4)=-2.79779981545119124951d-1
-       AFN(5)=-4.91900132609500318020d-2
-       AFN(6)=-4.06265923594885404393d-3
-       AFN(7)=-1.59276496239262096340d-4
-       AFN(8)=-2.77649108155232920844d-6
-       AFN(9)=-1.67787698489114633780d-8
- 
-       AFD(1)=1.33560420706553243746d1
-       AFD(2)=3.26825032795224613948d1
-       AFD(3)=2.67367040941499554804d1
-       AFD(4)=9.18707402907259625840d0
-       AFD(5)=1.47529146771666414581d0
-       AFD(6)=1.15687173795188044134d-1
-       AFD(7)=4.40291641615211203805d-3
-       AFD(8)=7.54720348287414296618d-5
-       AFD(9)=4.51850092970580378464d-7
- 
-       AGN(1)=1.97339932091685679179d-2
-       AGN(2)=3.91103029615688277255d-1
-       AGN(3)=1.06579897599595591108d0
-       AGN(4)=9.39169229816650230044d-1
-       AGN(5)=3.51465656105547619242d-1
-       AGN(6)=6.33888919628925490927d-2
-       AGN(7)=5.85804113048388458567d-3
-       AGN(8)=2.82851600836737019778d-4
-       AGN(9)=6.98793669997260967291d-6
-       AGN(10)=8.11789239554389293311d-8
-       AGN(11)=3.41551784765923618484d-10
- 
-       AGD(1)=9.30892908077441974853d0
-       AGD(2)=1.98352928718312140417d1
-       AGD(3)=1.55646628932864612953d1
-       AGD(4)=5.47686069422975497931d0
-       AGD(5)=9.54293611618961883998d-1
-       AGD(6)=8.64580826352392193095d-2
-       AGD(7)=4.12656523824222607191d-3
-       AGD(8)=1.01259085116509135510d-4
-       AGD(9)=1.17166733214413521882d-6
-       AGD(10)=4.91834570062930015649d-9
- !
- ! Exponentially tiny for large enough argument
- !
-       if(x>AMAXAIRY) then
-          airy_ai=0._dl
-          return
-       endif
- !
- ! Pade fit for large negative arguments
- !
-       if(x<-2.09d0) then
-          t=sqrt(-x)
-          zeta=-2._dl*x*t/3._dl
-          t=sqrt(t)
-          ak=sqpii/t
-          z=1._dl/zeta
-          zz=z*z
-          uf=1._dl+zz*polevl(zz,AFN,8)/p1evl(zz,AFD,9)
-          ug=z*polevl(zz,AGN,10)/p1evl(zz,AGD,10)
-          theta=zeta+0.25d0*PI
-          f=sin(theta)
-          g=cos(theta)
-          airy_ai=ak*(f*uf-g*ug)
-          return
-       endif
- !
- ! Pade fit for large positive arguments
- !
-       if(x>=2.09) then
-          t=sqrt(x)
-          zeta=2._dl*x*t/3._dl
-          g=exp(zeta)
-          t=sqrt(t)
-          ak=2._dl*t*g
-          z=1._dl/zeta
-          f=polevl(z,AN,7)/polevl(z,AD,7)
-          airy_ai=sqpii*f/ak
-          return
-       endif
- !
- ! Taylor series for region around x=0
- !
- 
-       f=1._dl
-       g=x
-       t=1._dl
-       uf=1._dl
-       ug=x
-       ak=1._dl
-       z=x*x*x
-      do while (t>ACC) 
-          uf=uf*z
-          ak=ak+1._dl
-          uf=uf/ak
-          ug=ug*z
-          ak=ak+1._dl
-          ug=ug/ak
-          uf=uf/ak
-          f=f+uf
-          ak=ak+1._dl
-          ug=ug/ak
-          g=g+ug
-          t=abs(uf/f)
-       end do
-      
- 
-       airy_ai=c1*f-c2*g
-       
-       end function airy_ai
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !  Evaluate polynomial                                          c
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- ! DESCRIPTION:
- !
- ! Evaluates polynomial of degree N:
- !
- !                     2          N
- ! y  =  C  + C x + C x  +...+ C x
- !        0    1     2          N
- !
- ! Coefficients are stored in reverse order:
- !
- ! coef(1) = C  , ..., coef(N+1) = C  .
- !            N                     0
- !
- ! The function p1evl() assumes that C = 1.0 and is
- !                                    N
- ! omitted from the array.  Its calling arguments are
- ! otherwise the same as polevl().
- !
- !
- ! SPEED:
- !
- ! In the interest of speed, there are no checks for out
- ! of bounds arithmetic.  This routine is used by most of
- ! the functions in the library.  Depending on available
- ! equipment features, the user may wish to rewrite the
- ! program in microcode or assembly language.
- !
- ! Cephes Math Library Release 2.1:  December, 1988
- ! Copyright 1984, 1987, 1988 by Stephen lSamp%l. Moshier
- ! Direct inquiries to 30 Frost Street, Cambridge, MA 02140
- !
-       function polevl(x,coef,N)
-       implicit none
-       real(dl) polevl
-       real(dl) x,ans
-       real(dl) coef
-       integer N,i
- 
-       dimension coef(N+1)
- 
-       ans=coef(1)
-       do i=2,N+1
-          ans=ans*x+coef(i)
-       end do
-       polevl=ans
-       
-       end function polevl
- 
- !
- !                                      
- ! Evaluate polynomial when coefficient of x  is 1.0.
- ! Otherwise same as polevl.
- !
-       function p1evl(x,coef,N)
-       implicit none
-       real(dl) p1evl
-       real(dl) x,coef,ans
-       integer N,i
-       dimension coef(N)
- 
-       ans=x+coef(1)
-       do i=2,N
-          ans=ans*x+coef(i)
-       end do
-       p1evl=ans
-      
-       end function p1evl
- 
- 
- 
-   end module SpherBessels !USpherBessels
- 
- 
- 
-         SUBROUTINE BJL_EXTERNAL(L,X,JL)
-         use SpherBessels
-         use Precision
-         !!== MODIFIED SUBROUTINE FOR SPHERICAL BESSEL FUNCTIONS.                       ==!!
-         !!== CORRECTED THE SMALL BUGS IN PACKAGE CMBFAST&CAMB(for l=4,5, x~0.001-0.002)==!! 
-         !!== CORRECTED THE SIGN OF J_L(X) FOR X<0 CASE                                 ==!!
-         !!== WORKS FASTER AND MORE ACCURATE FOR LOW L, X<<L, AND L<<X cases            ==!! 
-         !!== zqhuang@astro.utoronto.ca                                                 ==!!
-         IMPLICIT NONE
-         INTEGER L
-         real(dl) X,JL
- 
-         call BJL(L,X,JL)
-          
-         END SUBROUTINE BJL_EXTERNAL
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/camb.dsp cosmomc_sampler/camb/camb.dsp
*** cosmomc/camb/camb.dsp	2008-07-21 16:25:26.000000000 +0200
--- cosmomc_sampler/camb/camb.dsp	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,243 ****
- # Microsoft Developer Studio Project File - Name="camb" - Package Owner=<4>
- # Microsoft Developer Studio Generated Build File, Format Version 6.00
- # ** DO NOT EDIT **
- 
- # TARGTYPE "Win32 (x86) Console Application" 0x0103
- 
- CFG=camb - Win32 Debug
- !MESSAGE This is not a valid makefile. To build this project using NMAKE,
- !MESSAGE use the Export Makefile command and run
- !MESSAGE 
- !MESSAGE NMAKE /f "camb.mak".
- !MESSAGE 
- !MESSAGE You can specify a configuration when running NMAKE
- !MESSAGE by defining the macro CFG on the command line. For example:
- !MESSAGE 
- !MESSAGE NMAKE /f "camb.mak" CFG="camb - Win32 Debug"
- !MESSAGE 
- !MESSAGE Possible choices for configuration are:
- !MESSAGE 
- !MESSAGE "camb - Win32 Release" (based on "Win32 (x86) Console Application")
- !MESSAGE "camb - Win32 Debug" (based on "Win32 (x86) Console Application")
- !MESSAGE 
- 
- # Begin Project
- # PROP AllowPerConfigDependencies 0
- # PROP Scc_ProjName ""
- # PROP Scc_LocalPath ""
- CPP=cl.exe
- F90=df.exe
- RSC=rc.exe
- 
- !IF  "$(CFG)" == "camb - Win32 Release"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 0
- # PROP BASE Output_Dir "Release"
- # PROP BASE Intermediate_Dir "Release"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 0
- # PROP Output_Dir "Release"
- # PROP Intermediate_Dir "Release"
- # PROP Ignore_Export_Lib 0
- # PROP Target_Dir ""
- # ADD BASE F90 /compile_only /nologo /warn:nofileopt
- # ADD F90 /compile_only /fpp /nologo /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD BASE RSC /l 0x809 /d "NDEBUG"
- # ADD RSC /l 0x809 /d "NDEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- 
- !ELSEIF  "$(CFG)" == "camb - Win32 Debug"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 1
- # PROP BASE Output_Dir "Debug"
- # PROP BASE Intermediate_Dir "Debug"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 1
- # PROP Output_Dir "Debug"
- # PROP Intermediate_Dir "Debug"
- # PROP Ignore_Export_Lib 0
- # PROP Target_Dir ""
- # ADD BASE F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD F90 /check:bounds /compile_only /dbglibs /debug:full /fpp /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD BASE RSC /l 0x809 /d "_DEBUG"
- # ADD RSC /l 0x809 /d "_DEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"camb.exe" /pdbtype:sept
- 
- !ENDIF 
- 
- # Begin Target
- 
- # Name "camb - Win32 Release"
- # Name "camb - Win32 Debug"
- # Begin Group "Source Files"
- 
- # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
- # Begin Source File
- 
- SOURCE=.\bessels.f90
- NODEP_F90_BESSE=\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\camb.f90
- NODEP_F90_CAMB_=\
- 	".\Debug\CAMBmain.mod"\
- 	".\Debug\GaugeInterface.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lensing.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\cmbmain.f90
- NODEP_F90_CMBMA=\
- 	".\Debug\GaugeInterface.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\MassiveNu.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\NonLinear.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\SpherBessels.mod"\
- 	".\Debug\ThermoData.mod"\
- 	".\Debug\TimeSteps.mod"\
- 	".\Debug\Transfer.mod"\
- 	".\Debug\USpherBessels.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\constants.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\equations.f90
- NODEP_F90_EQUAT=\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\MassiveNu.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\ThermoData.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\halofit.f90
- NODEP_F90_HALOF=\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\inidriver.F90
- NODEP_F90_INIDR=\
- 	".\Debug\AmlUtils.mod"\
- 	".\Debug\CAMB.mod"\
- 	".\Debug\F90_UNIX.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\LambdaGeneral.mod"\
- 	".\Debug\lensing.mod"\
- 	".\Debug\RECFAST.MOD"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\inifile.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\lensing.f90
- NODEP_F90_LENSI=\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\modules.f90
- NODEP_F90_MODUL=\
- 	".\Debug\AmlUtils.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\RECFAST.MOD"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\power_tilt.f90
- NODEP_F90_POWER=\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\recfast.f90
- NODEP_F90_RECFA=\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\reionization.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\subroutines.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\utils.F90
- NODEP_F90_UTILS=\
- 	".\Debug\F90_UNIX.mod"\
- 	".\Debug\IFPORT.mod"\
- 	".\Debug\mpif.h"\
- 	".\xml_dll_use.mod"\
- 	".\XML_INCLUDE.F90"\
- 	".\xml_static_use.mod"\
- 	
- # End Source File
- # End Group
- # Begin Group "Header Files"
- 
- # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
- # End Group
- # Begin Group "Resource Files"
- 
- # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- # End Group
- # End Target
- # End Project
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/camb.f90 cosmomc_sampler/camb/camb.f90
*** cosmomc/camb/camb.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/camb.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,451 ****
-  !Interface module for CAMB. Call CAMB_GetResults to do the work.
- 
-      module CAMB
-          use Precision
-          use ModelParams
-          use ModelData
-          use Transfer
-          use GaugeInterface
-          use InitialPower
-          use Reionization
-          use Recombination
-          implicit none
- 
-          Type CAMBdata
-             Type (ClTransferData) :: ClTransScal,ClTransTens,ClTransVec
-             Type (MatterTransferData) :: MTrans
-             Type (CAMBparams) :: Params
-          end Type CAMBdata
- 
- !         public CAMB_GetTransfers, CAMB_GetResults, CAMB_GetCls, CAMB_SetDefParams, & 
- !                CAMB_ValidateParams, CAMB_GetAge,CAMB_InitCAMBdata, 
-      contains
- 
-        subroutine CAMB_GetTransfers(Params, OutData, error)
-         use CAMBmain
-         use lensing
-         type(CAMBparams) :: Params
-         type (CAMBdata)  :: OutData
-         integer, optional :: error !Zero if OK
-   
-       !Set internal types from OutData so it always 'owns' the memory, prevent leaks
-       
-         MT =  OutData%MTrans
- 
-         CTransScal = OutData%ClTransScal  
-         CTransVec  = OutData%ClTransVec  
-         CTransTens = OutData%ClTransTens
-   
- 
-         call CAMB_GetResults(Params, error)
-         OutData%Params = Params
-         OutData%MTrans = MT
-         OutData%ClTransScal = CTransScal
-         OutData%ClTransVec  = CTransVec
-         OutData%ClTransTens = CTransTens
-   
-        end subroutine CAMB_GetTransfers
- 
-        subroutine CAMB_InitCAMBdata(Dat)
-         type (CAMBdata) :: Dat
-  
- !Comment these out to try to avoid intel bugs with status deallocating uninitialized pointers   
-         call Ranges_Nullify(Dat%ClTransScal%q)
-         call Ranges_Nullify(Dat%ClTransVec%q)
-         call Ranges_Nullify(Dat%ClTransTens%q)
- 
-         nullify(Dat%ClTransScal%Delta_p_l_k)
-         nullify(Dat%ClTransVec%Delta_p_l_k)
-         nullify(Dat%ClTransTens%Delta_p_l_k)
-         nullify(Dat%MTrans%sigma_8,Dat%MTrans%TransferData,Dat%MTrans%q_trans)
-              
-        end subroutine CAMB_InitCAMBdata
- 
- 
-        subroutine CAMB_FreeCAMBdata(Dat)
-             type (CAMBdata) :: Dat
- 
-             call Free_ClTransfer(Dat%ClTransScal)
-             call Free_ClTransfer(Dat%ClTransVec)
-             call Free_ClTransfer(Dat%ClTransTens)
-             call Transfer_Free(Dat%MTrans)
- 
-        end subroutine CAMB_FreeCAMBdata
- 
- 
-        subroutine CAMB_TransfersToPowers(CData)
-         use CAMBmain
-         use lensing
-         type (CAMBdata) :: CData
- 
-         CP = CData%Params
-         call InitializePowers(CP%InitPower,CP%curv)
-         if (CData%Params%WantCls) then
-           call ClTransferToCl(CData%ClTransScal,CData%ClTransTens, CData%ClTransvec)  
-           if (CP%DoLensing) call lens_Cls
-           if (CP%OutputNormalization == outCOBE) call COBEnormalize
-         end if
-         if (CData%Params%WantTransfer) call Transfer_Get_sigma8(Cdata%MTrans,8._dl)
-      
-        end subroutine CAMB_TransfersToPowers
-   
- 
- 
-        !Call this routine with a set of parameters to generate the results you want.
-        subroutine CAMB_GetResults(Params, error)
-         use CAMBmain
-         use lensing
-         type(CAMBparams) :: Params
-         integer, optional :: error !Zero if OK
-         type(CAMBparams) P
-         logical :: separate = .true. !whether to do P_k in separate call or not
-         logical :: InReionization
-         
-         if (Params%DoLensing .and. Params%NonLinear==NonLinear_Lens) separate = .false.
-         InReionization = Params%Reion%Reionization
-         
-          if (Params%WantCls .and. Params%WantScalars) then
-           P = Params
-           if (separate) then
-           P%WantTransfer = .false.
-           P%Transfer%high_precision = .false.
-           end if
-           P%WantTensors = .false.
-           P%WantVectors = .false.
-           if (present(error)) then
-                call CAMBParams_Set(P, error) !set other derived variables in ModelParams (modules.f90) 
-               if (error /= 0) return
-               else
-                call CAMBParams_Set(P)  
-             end if
-           call cmbmain
-           call_again = .true.
-           !Need to store CP%flat etc, but must keep original P_k settings
-           CP%Transfer%high_precision = Params%Transfer%high_precision
-           CP%WantTransfer = Params%WantTransfer
-           CP%WantTensors = Params%WantTensors
-           CP%WantVectors = Params%WantVectors
-           CP%Transfer%num_redshifts = Params%Transfer%num_redshifts
-           Params = CP            
-          end if
-  
-          if (Params%WantCls .and. Params%WantTensors) then
-           P=Params
-           P%WantTransfer = .false.
-           P%Transfer%high_precision = .false.
-           P%WantScalars = .false.
-           P%WantVectors = .false.
-           if (present(error)) then
-                call CAMBParams_Set(P, error) !set other derived variables in ModelParams (modules.f90) 
-               if (error /= 0) return
-               else
-                call CAMBParams_Set(P)  
-             end if
-            call cmbmain
-            call_again = .true.
-            CP%Transfer%high_precision = Params%Transfer%high_precision
-            CP%WantTransfer = Params%WantTransfer
-            CP%WantScalars = Params%WantScalars
-            CP%WantVectors = Params%WantVectors
-            CP%Transfer%num_redshifts = Params%Transfer%num_redshifts
-            Params = CP            
-    
-          end if
-  
-          if (Params%WantCls .and. Params%WantVectors) then
-           P=Params
-           P%WantTransfer = .false.
-           P%Transfer%high_precision = .false.
-           P%WantScalars = .false.
-           P%WantTensors = .false.
-           if (present(error)) then
-                call CAMBParams_Set(P, error) !set other derived variables in ModelParams (modules.f90) 
-               if (error /= 0) return
-               else
-                call CAMBParams_Set(P)  
-             end if
-            call cmbmain
-            call_again = .true.
-           CP%Transfer%high_precision = Params%Transfer%high_precision
-           CP%WantTransfer = Params%WantTransfer
-           CP%WantTensors = Params%WantTensors
-           CP%WantScalars = Params%WantScalars
-           CP%Transfer%num_redshifts = Params%Transfer%num_redshifts
-           Params = CP            
-    
-          end if
- 
-          if (Params%WantTransfer .and. &
-           .not. (Params%WantCls .and. Params%WantScalars .and. .not. separate)) then
-           P=Params
-           P%WantCls = .false.
-           P%WantScalars = .false.
-           P%WantTensors = .false.
-           P%WantVectors = .false.
-           if (present(error)) then
-                call CAMBParams_Set(P, error) !set other derived variables in ModelParams (modules.f90) 
-               if (error /= 0) return
-               else
-                call CAMBParams_Set(P)  
-             end if
-            call cmbmain
- 
-           !Need to store num redshifts etc
-           CP%WantScalars = Params%WantScalars
-           CP%WantCls =  Params%WantCls
-           CP%WantTensors = Params%WantTensors
-           CP%WantVectors = Params%WantVectors
-           CP%Reion%Reionization = InReionization
-           Params = CP            
- 
-          end if
- 
-         call_again = .false.
-    
- 
-         if (.not. CP%OnlyTransfers) then
- 
-          if (CP%WantCls .and. CP%OutputNormalization == outCOBE) call COBEnormalize
- 
-          if (CP%DoLensing) then
-            call lens_Cls 
-          end if
- 
-         end if
- 
-         end subroutine CAMB_GetResults
- 
- 
-         !Return real (NOT double precision) arrays of the computed CMB  Cls
-         !Output is l(l+1)C_l/2pi
-         !If GC_Conventions = .false. use E-B conventions (as the rest of CAMB does)
-         subroutine CAMB_GetCls(Cls, lmax, in, GC_conventions)
-           integer, intent(IN) :: lmax, in
-           logical, intent(IN) :: GC_conventions
-           real, intent(OUT) :: Cls(2:lmax,1:4)
-           integer l
-       
-           Cls = 0
-           do l=2, lmax
-              if (CP%WantScalars .and. l<= CP%Max_l) then
-              Cls(l,1:2) = Cl_scalar(l, in,  C_Temp:C_E)
-              Cls(l,4) = Cl_scalar(l, in,  C_Cross)
-              end if
-              if (CP%WantTensors .and. l <= CP%Max_l_tensor) then
-                 Cls(l,1:4) = Cls(l,1:4) + Cl_tensor(l, in,  CT_Temp:CT_Cross)
-              end if
-           end do
-           if (GC_conventions) then
-              Cls(:,2:3) = Cls(:,2:3)/2
-              Cls(:,4)   = Cls(:,4)/sqrt(2.0)             
-           end if
-  
-         end subroutine CAMB_GetCls
- 
-         function CAMB_GetAge(P)
-            !Return age in gigayears, returns -1 on error
-            use constants
-            type(CAMBparams), intent(in) :: P
-            real(dl) CAMB_GetAge
-            real(dl) atol,a1,a2, dtda, rombint
- !           real(dl), parameter :: Mpc = 3.085678e22_dl, &
- !                 c = 2.99792458e8_dl, Gyr=3.1556926e16
-            integer error
-            external dtda,rombint
- 
- 
-            call  CAMBParams_Set(P, error, .false.)
- 
-            if (error/=0) then
-             CAMB_GetAge = -1
-            else
- 
-            atol = 1d-4
-            a1=0
-            a2=1
-            CAMB_GetAge = rombint(dtda,a1,a2,atol)*Mpc/c/Gyr
-            end if
-     
-          end function CAMB_GetAge
- 
- 
-         function CAMB_GetZreFromTau(P, tau)
-            type(CAMBparams) :: P
-            real(dl) tau
-            real(dl) CAMB_GetZreFromTau
-            integer error
- 
-             P%Reion%use_optical_depth = .true.
-             P%Reion%optical_depth = tau
-             call CAMBParams_Set(P,error)
-             
-             CAMB_GetZreFromTau = CP%Reion%redshift
- 
-         end function CAMB_GetZreFromTau
- 
-       
-         subroutine CAMB_SetDefParams(P)
-             type(CAMBparams), intent(out) :: P
- 
-             P%WantTransfer= .false.
-             P%WantCls = .true.
- 
-             P%omegab  = .045
-             P%omegac  = 0.255
-             P%omegav  = 0.7
-             P%omegan  = 0
-             P%H0      = 65
- 
-             P%TCMB    = 2.726
-             P%YHe     = 0.24
-             P%Num_Nu_massless =3.04
-             P%Num_Nu_massive  =0
-             P%Nu_mass_splittings = .false.
-             P%Nu_mass_eigenstates = 0
-            
-             P%Scalar_initial_condition =initial_adiabatic
-             P%NonLinear = NonLinear_none
-             
-             call SetDefPowerParams(P%InitPower)
- 
-             call Recombination_SetDefParams(P%Recomb)
-           
-             call Reionization_SetDefParams(P%Reion)
- 
-             P%Transfer%high_precision=.false.
-     
-             P%OutputNormalization = outNone
- 
-             P%WantScalars = .true.
-             P%WantVectors = .false.
-             P%WantTensors = .false.
-             
-             P%Max_l=1500
-             P%Max_eta_k=3000
-             P%Max_l_tensor=400
-             P%Max_eta_k_tensor=800
-             !Set up transfer just enough to get sigma_8 OK
-             P%Transfer%kmax=0.9  
-             P%Transfer%k_per_logint=0
-             P%Transfer%num_redshifts=1
-             P%Transfer%redshifts=0
- 
-             P%AccuratePolarization = .true.
-             P%AccurateReionization = .false.
-             P%AccurateBB = .false.
- 
-             P%DoLensing = .false.
- 
-             P%MassiveNuMethod = Nu_best
-             P%OnlyTransfers = .false.
- 
-          end subroutine CAMB_SetDefParams
- 
- 
-          !Stop with error is not good
-          function CAMB_ValidateParams(P) result(OK)
-             type(CAMBparams), intent(in) :: P
-             logical OK
- 
-              OK = .true.
-              if (.not. P%WantTransfer .and. .not. P%WantCls) then
-                 OK = .false.
-                 write(*,*) 'There is nothing to do! Do transfer functions or Cls.'
-              end if
- 
-              if (P%h0 < 20._dl.or.P%h0 > 100._dl) then
-                OK = .false.
-                write(*,*) '  Warning: H0 has units of km/s/Mpc. You have:', P%h0
-             end if
-              if (P%tcmb < 2.7d0.or.P%tcmb > 2.8d0) then
-                 write(*,*) '  Warning: Tcmb has units of K.  Your have:', P%tcmb
-              end if
- 
-              if (P%yhe < 0.2d0.or.P%yhe > 0.8d0) then
-                 OK = .false.
-                 write(*,*) &
-                      '  Warning: YHe is the Helium fraction of baryons.', &
-                      '  Your have:', P%yhe
-              end if
-              if (P%Num_Nu_massive < 0.or.P%Num_Nu_massive > 3.1) then
-                 OK = .false.
-                 write(*,*) &
-                      'Warning: Num_Nu_massive is strange:',P%Num_Nu_massive 
-               end if
-              if (P%Num_Nu_massless < 0.or.P%Num_Nu_massless > 3.1) then
-                 OK = .false.
-                 write(*,*) &
-                      'Warning: Num_nu_massless is strange:', P%Num_Nu_massless
-               end if
-              if (P%Num_Nu_massive < 1 .and. P%omegan > 0.0) then
-                 OK = .false.
-                 write(*,*) &
-                      'Warning: You have omega_neutrino > 0, but no massive species'
-               end if
- 
- 
-              if (P%omegab<0.001 .or. P%omegac<0 .or. P%omegab>1 .or. P%omegac>3) then
-                 OK = .false.
-                 write(*,*) 'Your matter densities are strange'
-              end if
- 
-              if (P%WantScalars .and. P%Max_eta_k < P%Max_l .or.  &
-                   P%WantTensors .and. P%Max_eta_k_tensor < P%Max_l_tensor) then
-                 OK = .false.
-                 write(*,*) 'You need Max_eta_k larger than Max_l to get good results'
-              end if
-              
-              call Reionization_Validate(P%Reion, OK)
-              call Recombination_Validate(P%Recomb, OK)
- 
-              if (P%WantTransfer) then
-               if (P%transfer%num_redshifts > max_transfer_redshifts .or. P%transfer%num_redshifts<1) then
-                 OK = .false.
-                 write(*,*) 'Maximum ',  max_transfer_redshifts, &
-                      'redshifts. You have: ', P%transfer%num_redshifts 
-               end if
-               if (P%transfer%kmax < 0.01 .or. P%transfer%kmax > 50000 .or. &
-                      P%transfer%k_per_logint>0 .and.  P%transfer%k_per_logint <1) then
-                  OK = .false.
-                  write(*,*) 'Strange transfer function settings.'
-               end if
-               if (P%transfer%num_redshifts > max_transfer_redshifts .or. P%transfer%num_redshifts<1) then
-                 OK = .false.
-                 write(*,*) 'Maximum ',  max_transfer_redshifts, &
-                      'redshifts. You have: ', P%transfer%num_redshifts 
-               end if
- 
- 
-              end if
- 
-          end function CAMB_ValidateParams
- 
-          subroutine CAMB_cleanup
-           use ThermoData
-           use SpherBessels
-           use ModelData
-           use Transfer
- 
-             !Free memory
-            call ThermoData_Free
-            call Bessels_Free
-            call ModelData_Free  
-            call Transfer_Free(MT)
- 
-          end subroutine CAMB_cleanup
- 
- 
-   end module CAMB
- 
- 
-   function dtda(a)
-           use Precision
-           implicit none
-           real(dl) dtda,dtauda,a
-           external dtauda
-           
-           dtda= dtauda(a)*a
-   end function
- 
-         
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/camb.vfproj cosmomc_sampler/camb/camb.vfproj
*** cosmomc/camb/camb.vfproj	2009-09-17 18:37:17.000000000 +0200
--- cosmomc_sampler/camb/camb.vfproj	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,45 ****
- <?xml version="1.0" encoding="UTF-8"?>
- <VisualStudioProject ProjectCreator="Intel Fortran" Keyword="Console Application" Version="11.0" ProjectIdGuid="{D4A270F2-0268-4721-844D-61DA2097F3CA}">
- 	<Platforms>
- 		<Platform Name="Win32"/></Platforms>
- 	<Configurations>
- 		<Configuration Name="Debug|Win32">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE" WarnInterfaces="true" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug"/>
- 				<Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" GenerateDebugInformation="true" SubSystem="subSystemConsole"/>
- 				<Tool Name="VFResourceCompilerTool"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration>
- 		<Configuration Name="Release|Win32">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE"/>
- 				<Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" SubSystem="subSystemConsole"/>
- 				<Tool Name="VFResourceCompilerTool"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration></Configurations>
- 	<Files>
- 		<Filter Name="Header Files" Filter="fi;fd"/>
- 		<Filter Name="Resource Files" Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"/>
- 		<Filter Name="Source Files" Filter="f90;for;f;fpp;ftn;def;odl;idl">
- 		<File RelativePath="bessels.f90"/>
- 		<File RelativePath="camb.f90"/>
- 		<File RelativePath="cmbmain.f90"/>
- 		<File RelativePath=".\constants.f90"/>
- 		<File RelativePath="equations.f90"/>
- 		<File RelativePath="halofit.f90"/>
- 		<File RelativePath="inidriver.F90"/>
- 		<File RelativePath="inifile.f90"/>
- 		<File RelativePath="lensing.f90"/>
- 		<File RelativePath="modules.f90"/>
- 		<File RelativePath="power_tilt.f90"/>
- 		<File RelativePath="recfast.f90"/>
- 		<File RelativePath=".\reionization.f90"/>
- 		<File RelativePath="subroutines.f90"/>
- 		<File RelativePath="utils.F90">
- 			<FileConfiguration Name="Debug|Win32">
- 				<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE" OpenMPConditionalCompilation="true" ErrorLimit="6" DebugParameter="debugParameterUsed"/></FileConfiguration></File></Filter></Files>
- 	<Globals/></VisualStudioProject>
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/camb.vfproj.old cosmomc_sampler/camb/camb.vfproj.old
*** cosmomc/camb/camb.vfproj.old	2008-07-21 16:23:00.000000000 +0200
--- cosmomc_sampler/camb/camb.vfproj.old	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,45 ****
- <?xml version="1.0" encoding="UTF-8"?>
- <VisualStudioProject ProjectCreator="Intel Fortran" Keyword="Console Application" Version="9.10" ProjectIdGuid="{D4A270F2-0268-4721-844D-61DA2097F3CA}">
- 	<Platforms>
- 		<Platform Name="Win32"/></Platforms>
- 	<Configurations>
- 		<Configuration Name="Debug|Win32">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE" WarnInterfaces="true" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug"/>
- 				<Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" GenerateDebugInformation="true" SubSystem="subSystemConsole"/>
- 				<Tool Name="VFResourceCompilerTool"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration>
- 		<Configuration Name="Release|Win32">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE"/>
- 				<Tool Name="VFLinkerTool" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" SubSystem="subSystemConsole"/>
- 				<Tool Name="VFResourceCompilerTool"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration></Configurations>
- 	<Files>
- 		<Filter Name="Header Files" Filter="fi;fd"/>
- 		<Filter Name="Resource Files" Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"/>
- 		<Filter Name="Source Files" Filter="f90;for;f;fpp;ftn;def;odl;idl">
- 		<File RelativePath="bessels.f90"/>
- 		<File RelativePath="camb.f90"/>
- 		<File RelativePath="cmbmain.f90"/>
- 		<File RelativePath=".\constants.f90"/>
- 		<File RelativePath="equations.f90"/>
- 		<File RelativePath="halofit.f90"/>
- 		<File RelativePath="inidriver.F90"/>
- 		<File RelativePath="inifile.f90"/>
- 		<File RelativePath="lensing.f90"/>
- 		<File RelativePath="modules.f90"/>
- 		<File RelativePath="power_tilt.f90"/>
- 		<File RelativePath="recfast.f90"/>
- 		<File RelativePath=".\reionization.f90"/>
- 		<File RelativePath="subroutines.f90"/>
- 		<File RelativePath="utils.F90">
- 			<FileConfiguration Name="Debug|Win32">
- 				<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes" PreprocessorDefinitions="RUNIDLE" OpenMPConditionalCompilation="true" ErrorLimit="6" DebugParameter="debugParameterUsed"/></FileConfiguration></File></Filter></Files>
- 	<Globals/></VisualStudioProject>
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/cmbmain.f90 cosmomc_sampler/camb/cmbmain.f90
*** cosmomc/camb/cmbmain.f90	2009-02-20 00:43:34.000000000 +0100
--- cosmomc_sampler/camb/cmbmain.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,2190 ****
- !     This this is the main CAMB program module.
- !
- !     Code for Anisotropies in the Microwave Background
- !     by Antony lewis (http://cosmologist.info) and Anthony Challinor
- !     See readme.html for documentation. 
- !     This version Feb 2009
- 
- !     Note that though the code is internally parallelised, it is not thread-safe
- !     so you cannot generate more than one model at the same time in different threads.
- !
- !     Based on CMBFAST  by  Uros Seljak and Matias Zaldarriaga, itself based
- !     on Boltzmann code written by Edmund Bertschinger, Chung-Pei Ma and Paul Bode.
- !     Original CMBFAST copyright and disclaimer:
- !
- !     Copyright 1996 by Harvard-Smithsonian Center for Astrophysics and
- !     the Massachusetts Institute of Technology.  All rights reserved.
- !
- !     THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. OR C.f.A. MAKE NO
- !     REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPlIED.
- !     By way of example, but not limitation,
- !     M.I.T. AND C.f.A MAKE NO REPRESENTATIONS OR WARRANTIES OF
- !     MERCHANTABIlITY OR FITNESS FOR ANY PARTICUlAR PURPOSE OR THAT
- !     THE USE OF THE lICENSED SOFTWARE OR DOCUMENTATION WIll NOT INFRINGE
- !     ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
- !
- !     portions of this software are based on the COSMICS package of
- !     E. Bertschinger.  See the lICENSE file of the COSMICS distribution
- !     for restrictions on the modification and distribution of this software.
- 
-   module CAMBmain
- 
- !     This code evolves the linearized perturbation equations of general relativity,
- !     the Boltzmann equations and the fluid equations for perturbations
- !     of a Friedmann-Robertson-Walker universe with a supplied system of gauge-dependent
- !     in a modules called GaugeInterface.  The sources for the line of sight integral are
- !     computed at sampled times during the evolution for various of wavenumbers. The sources
- !     are then interpolated to a denser wavenumber sampling for computing the line of
- !     sight integrals of the form Integral d(conformal time) source_k * bessel_k_l. 
- !     For CP%flat models the bessel functions are interpolated from a pre-computed table, for
- !     non-CP%flat models the hyperspherical Bessel functions are computed by integrating their
- !     differential equation. Both phases ('Evolution' and 'Integration') can do separate 
- !     wavenumbers in parallel.
- 
- !     The time variable is conformal  time dtau=dt/a(t) and the spatial dependence is Fourier transformed 
- !     with q=sqrt(k**2 + (|m|+1)K), comoving distances are x=CP%r/a(t), with a(t)=1 today.  
- !     The units of both length and time are Mpc.
- 
- !    Many elements are part of derived types (to make thread safe or to allow non-sequential code use
- !    CP = CAMB parameters
- !    EV = Time evolution variables
- !    IV = Source integration variables
- !    CT = Cl transfer data
- !    MT = matter transfer data
- 
- ! Modules are defined in modules.f90, except GaugeInterface which gives the background and gauge-dependent 
- ! perturbation equations, and InitialPower which provides the initial power spectrum.
- 
-       use precision
-       use ModelParams
-       use ModelData
-       use GaugeInterface
-       use Transfer
-       use SpherBessels
-       use lvalues
-       use MassiveNu
-       use InitialPower
- 
-       implicit none
- 
-       private
- 
-       logical ExactClosedSum  !do all nu values in sum for Cls for Omega_k>0.1
-   
- 
-       !Variables for integrating the sources with the bessel functions for each wavenumber
-        type IntegrationVars
-           integer q_ix
-           real(dl) q, dq    !q value we are doing and delta q
-   !        real(dl), dimension(:,:), pointer :: Delta_l_q
-             !Contribution to C_l integral from this k 
-           real(dl), dimension(:,:), pointer :: Source_q, ddSource_q
-             !Interpolated sources for this k
-     
-           integer SourceSteps !number of steps up to where source is zero
- 
-       end type IntegrationVars
-       
-       integer SourceNum
-       !SourceNum is total number sources (2 or 3 for scalars, 3 for tensors).
- 
-       real(dl) tautf(0:max_transfer_redshifts)  !Time of Trasfer%redshifts
-         
- 
-       real(dl), dimension(:,:,:), allocatable :: Src, ddSrc !Sources and second derivs
-         ! indices  Src( k_index, source_index, time_step_index )    
-   
-       real(dl), dimension(:,:,:), allocatable :: iCl_scalar, iCl_vector,iCl_tensor
-        ! Cls at the l values we actually compute,  iCl_xxx(l_index, Cl_type, initial_power_index)
-       
-       Type(Regions) :: Evolve_q
- 
-       real(dl),parameter :: qmin0=0.1_dl
- 
-       real(dl) :: dtaurec_q
-     
- !     qmax - CP%Max_eta_k/CP%tau0, qmin = qmin0/CP%tau0 for flat case
- 
-       real(dl) qmin, qmax 
- 
-       real(dl) max_etak_tensor , max_etak_vector, max_etak_scalar
-  !     Will only be calculated if k*tau < max_etak_xx
- 
-       integer maximum_l !Max value of l to compute
-       real(dl) :: maximum_qeta = 3000._dl
- 
-       Type(ClTransferData), pointer :: ThisCT
-                     
-       public cmbmain, ClTransferToCl 
- 
- contains  
- 
-      
-       subroutine cmbmain
-       integer q_ix 
-       type(EvolutionVars) EV
-   
- !     Timing variables for testing purposes. Used if DebugMsgs=.true. in ModelParams
-       real(sp) actual,timeprev,starttime
- 
-       if (CP%WantCls) then
-  
-          if (CP%WantTensors .and. CP%WantScalars) stop 'CMBMAIN cannot generate tensors and scalars'
-          !Use CAMB_GetResults instead
- 
-          if (CP%WantTensors) then
-             maximum_l = CP%Max_l_tensor
-             maximum_qeta = CP%Max_eta_k_tensor
-          else
-             maximum_l = CP%Max_l
-             maximum_qeta = CP%Max_eta_k
-          end if
- 
- 
-          call initlval(lSamp, maximum_l)
- 
-          if (CP%flat)  call InitSpherBessels
-          !This is only slow if not called before with same (or higher) Max_l, Max_eta_k
-          !Preferably stick to Max_l being a multiple of 50
-       end if 
- 
- 
-       if (DebugMsgs .and. Feedbacklevel > 0) then
-          actual=GetTestTime()
-          starttime=actual !times don't include reading the Bessel file
-        end if
-      
-       call InitVars !Most of single thread time spent here (in InitRECFAST)
- 
- 
-       if (DebugMsgs .and. Feedbacklevel > 0) then
-          timeprev=actual
-          actual=GetTestTime()
-          write(*,*) actual-timeprev,' Timing for InitVars'
-          write (*,*) 'r = ',real(CP%r),' scale = ',real(scale), 'age = ', real(CP%tau0)  
-       end if 
- 
-        if (.not. CP%OnlyTransfers)  call InitializePowers(CP%InitPower,CP%curv)
- 
- !     Calculation of the CMB sources.
- 
- 
-       if (CP%WantCls) call SetkValuesForSources 
- 
-       if (CP%WantTransfer) call InitTransfer
-  
- 
- !      ***note that !$ is the prefix for conditional multi-processor compilation***
-       !$ if (ThreadNum /=0) call OMP_SET_NUM_THREADS(ThreadNum)
-         
-    
-       if (CP%WantCls) then
- 
-          if (DebugMsgs .and. Feedbacklevel > 0) write(*,*) 'Set ',Evolve_q%npoints,' source k values'
-          
-          call GetSourceMem
- 
-          if (CP%WantScalars) then
-              ThisCT => CTransScal
-          else if (CP%WantVectors) then
-              ThisCT => CTransVec
-          else
-              ThisCT => CTransTens
-          end if
- 
-          ThisCT%NumSources = SourceNum
-          ThisCT%ls = lSamp
- 
- 
-          !$OMP PARAllEl DO DEFAUlT(SHARED),SCHEDUlE(DYNAMIC) &
-          !$OMP & PRIVATE(EV, q_ix)
-          do q_ix= 1,Evolve_q%npoints
-              call DoSourcek(EV,q_ix)
-          end do
-          !$OMP END PARAllEl DO
-         
-          if (DebugMsgs .and. Feedbacklevel > 0) then
-             timeprev=actual
-             actual=GetTestTime()
-             write(*,*) actual-timeprev,' Timing for source calculation'
-          end if
- 
-       endif !WantCls
- 
-    
- !     If transfer functions are requested, set remaining k values and output
-       if (CP%WantTransfer) then
-         call TransferOut
-          if (DebugMsgs .and. Feedbacklevel > 0) then
-          timeprev=actual
-          actual=GetTestTime()
-          write(*,*) actual-timeprev,' Timing for transfer k values'
-          end if  
-       end if
- 
-        if (CP%WantTransfer .and. CP%WantCls .and. CP%DoLensing &
-             .and. CP%NonLinear==NonLinear_Lens) then
-           
-           call NonLinearLensing
-           if (DebugMsgs .and. Feedbacklevel > 0) then
-              timeprev=actual
-              actual=GetTestTime()
-              write(*,*) actual-timeprev,' Timing for NonLinear'
-           end if
- 
-        end if
- 
-        if (CP%WantTransfer .and. .not. CP%OnlyTransfers) &
-           call Transfer_Get_sigma8(MT,8._dl) 
-            !Can call with other arguments if need different size
-  
- !     if CMB calculations are requested, calculate the Cl by
- !     integrating the sources over time and over k.
- 
-       if (CP%WantCls) then
- 
-          call InitSourceInterpolation   
-        
-          ExactClosedSum = CP%curv > 5e-9_dl .or. scale < 0.93_dl
-      
-          call SetkValuesForInt
- 
-          if (DebugMsgs .and. Feedbacklevel > 0) write(*,*) 'Set ',ThisCT%q%npoints,' integration k values'
- 
-     
-       !Begin k-loop and integrate Sources*Bessels over time
-       
-       !$OMP PARAllEl DO DEFAUlT(SHARED),SHARED(TimeSteps), SCHEDUlE(STATIC,4) 
-           do q_ix=1,ThisCT%q%npoints
-             call SourceToTransfers(q_ix)
-          end do !q loop
-        !$OMP END PARAllEl DO 
-   
-         if (DebugMsgs .and. Feedbacklevel > 0) then
-          timeprev=actual
-          actual=GetTestTime()
-          write(*,*)actual-timeprev,' Timing For Integration'
-         end if
-   
- 
-         call FreeSourceMem
- 
-         !Final calculations for CMB output unless want the Cl transfer functions only.
- 
-         if (.not. CP%OnlyTransfers) call ClTransferToCl(CTransScal,CTransTens, CTransVec)
- 
-       end if
- 
-       if (DebugMsgs .and. Feedbacklevel > 0) then
-          timeprev=actual
-          actual = GetTestTime()
-          write(*,*) actual - timeprev,' Timing for final output'
-          write(*,*) actual -starttime,' Timing for whole of cmbmain'
-       end if
- 
-       end subroutine cmbmain
- 
-      subroutine ClTransferToCl(CTransS,CTransT, CTransV)
-         Type(ClTransferData) :: CTransS,CTransT, CTransV
- 
-        if (CP%WantScalars) then
-            lSamp = CTransS%ls
-            allocate(iCl_Scalar(CTransS%ls%l0,C_Temp:C_last,CP%InitPower%nn))
-            iCl_scalar = 0
-            call CalcScalCls(CTransS)
-            if (DebugMsgs .and. Feedbacklevel > 0) write (*,*) 'CalcScalCls'
-        end if    
- 
-        if (CP%WantVectors) then
-            allocate(iCl_vector(CTransV%ls%l0,C_Temp:CT_Cross,CP%InitPower%nn))
-            iCl_vector = 0
-            call CalcVecCls(CTransV,GetInitPowerArrayVec)
-            if (DebugMsgs .and. Feedbacklevel > 0) write (*,*) 'CalcVecCls'
-        end if    
- 
- 
-        if (CP%WantTensors) then
-            allocate(iCl_Tensor(CTransT%ls%l0,CT_Temp:CT_Cross,CP%InitPower%nn))
-            iCl_tensor = 0
-            call CalcTensCls(CTransT,GetInitPowerArrayTens)
-            if (DebugMsgs .and. Feedbacklevel > 0) write (*,*) 'CalcTensCls'
-        end if
- 
-        call Init_Cls
-  !     Calculating Cls for every l.
-        call InterpolateCls(CTransS,CTransT, CTransV)
-    
-        if (DebugMsgs .and. Feedbacklevel > 0) write (*,*) 'InterplolateCls'
- 
-        if (CP%WantScalars) deallocate(iCl_scalar)
-        if (CP%WantVectors) deallocate(iCl_vector)
-        if (CP%WantTensors) deallocate(iCl_tensor)
-  
-        if (CP%OutputNormalization >=2) call NormalizeClsAtl(CP%OutputNormalization)
-        !Normalize to C_l=1 at l=OutputNormalization 
-   
-      
-      end subroutine ClTransferToCl
-     
- 
-      subroutine SourceToTransfers(q_ix)
-       integer q_ix
-       type(IntegrationVars) :: IV
-     
-           allocate(IV%Source_q(TimeSteps%npoints,SourceNum))
-           if (.not.CP%flat) allocate(IV%ddSource_q(TimeSteps%npoints,SourceNum))
- 
-             call IntegrationVars_init(IV)
- 
-             IV%q_ix = q_ix
-             IV%q =ThisCT%q%points(q_ix)
-             IV%dq= ThisCT%q%dpoints(q_ix)
- 
-             call InterpolateSources(IV)
-            
-             call DoSourceIntegration(IV)
- 
-           if (.not.CP%flat) deallocate(IV%ddSource_q) 
-           deallocate(IV%Source_q)
-          
-      end subroutine SourceToTransfers
-     
- 
-       subroutine InitTransfer
-         integer nu,lastnu, ntodo, nq, q_ix, first_i
-         real(dl) dlog_lowk1,dlog_lowk, d_osc,dlog_osc, dlog_highk, boost
-         real(dl) amin,q_switch_lowk,q_switch_lowk1,q_switch_osc,q_switch_highk
-         real(dl), dimension(:), allocatable :: q_transfer
- 
-        if (CP%Transfer%k_per_logint==0) then
-         !Optimized spacing
-         !Large log spacing on superhorizon scales
-         !Linear spacing for horizon scales and first few baryon osciallations
-         !Log spacing for last few osciallations
-         !large log spacing for small scales
- 
-            boost = AccuracyBoost
-            if (CP%Transfer%high_precision) boost = boost*1.5
- 
-            q_switch_lowk1 = 0.7/taurst
-            dlog_lowk1=2*boost
- 
-            q_switch_lowk = 8/taurst
-            dlog_lowk=8*boost
- 
-            q_switch_osc = min(CP%Transfer%kmax,30/taurst)
-            d_osc= 200*boost
- 
-            q_switch_highk = min(CP%Transfer%kmax,60/taurst)
-            dlog_osc = 17*boost
- 
-            !Then up to kmax
-            dlog_highk = 3*boost
-             
-            amin = 5e-5_dl
- 
-            nq=int((log(CP%Transfer%kmax/amin))*d_osc)+1 
-            allocate(q_transfer(nq))
-      
-            nq=int((log(q_switch_lowk1/amin))*dlog_lowk1)+1 
-            do q_ix=1, nq
-             q_transfer(q_ix) = amin*exp((q_ix-1)/dlog_lowk1)
-            end do
-            MT%num_q_trans = nq
- 
-            nq=int(log( q_switch_lowk/q_transfer(MT%num_q_trans))*dlog_lowk) +1
-            do q_ix=1, nq
-             q_transfer(MT%num_q_trans+q_ix) = q_transfer(MT%num_q_trans)*exp(q_ix/dlog_lowk)
-            end do
-            MT%num_q_trans = MT%num_q_trans + nq
- 
-            nq=int((q_switch_osc-q_transfer(MT%num_q_trans))*d_osc)+1 
-            do q_ix=1, nq
-             q_transfer(MT%num_q_trans+q_ix) = q_transfer(MT%num_q_trans)+ q_ix/d_osc
-            end do
-            MT%num_q_trans = MT%num_q_trans + nq
- 
-            if (CP%Transfer%kmax > q_transfer(MT%num_q_trans)) then
-             nq=int(log( q_switch_highk/q_transfer(MT%num_q_trans))*dlog_osc) +1
-             do q_ix=1, nq
-              q_transfer(MT%num_q_trans+q_ix) = q_transfer(MT%num_q_trans)*exp(q_ix/dlog_osc)
-             end do
-             MT%num_q_trans = MT%num_q_trans + nq
-            end if
- 
-            if (CP%Transfer%kmax > q_transfer(MT%num_q_trans)) then
-             nq=int(log(CP%Transfer%kmax/q_transfer(MT%num_q_trans))*dlog_highk)+1 
-             do q_ix=1, nq
-              q_transfer(MT%num_q_trans+q_ix) = q_transfer(MT%num_q_trans)*exp(q_ix/dlog_highk)
-             end do
-             MT%num_q_trans = MT%num_q_trans + nq
-            end if
-    
-         else
-          !Fixed spacing
-           MT%num_q_trans=int((log(CP%Transfer%kmax)-log(qmin))*CP%Transfer%k_per_logint)+1
-           allocate(q_transfer(MT%num_q_trans))
-           do q_ix=1, MT%num_q_trans
-             q_transfer(q_ix) = qmin*exp(real(q_ix)/CP%Transfer%k_per_logint)
-           end do
-         end if
- 
-          if (CP%closed) then
-               lastnu=0
-               ntodo = 0
-                do q_ix=1,MT%num_q_trans
-                 nu =nint(CP%r*q_transfer(q_ix))
-                 if (.not. ((nu<3).or.(nu<=lastnu))) then
-                    ntodo=ntodo+1
-                    q_transfer(ntodo)= nu/CP%r
-                    lastnu=nu
-                 end if
-                end do
-               MT%num_q_trans = ntodo
-          end if
- 
-          if (CP%WantCls) then
-                ntodo = MT%num_q_trans
-                first_i = ntodo+1
-                do q_ix = 1,ntodo
-                 if (q_transfer(q_ix) > qmax) then
-                       first_i=q_ix 
-                       exit
-                 end if
-                end do            
-            
-                if (first_i > ntodo) then
-                MT%num_q_trans = Evolve_q%npoints 
-               else
-                MT%num_q_trans = Evolve_q%npoints + (ntodo - first_i+1) 
-               end if
-               call Transfer_Allocate(MT)
- 
-               MT%q_trans(1:Evolve_q%npoints) = Evolve_q%points(1:Evolve_q%npoints)
-               if (MT%num_q_trans > Evolve_q%npoints) then
-                MT%q_trans(Evolve_q%npoints+1:MT%num_q_trans) = q_transfer(first_i:ntodo)
-           end if
- 
-          else
-              Evolve_q%npoints = 0
-              call Transfer_Allocate(MT)
-              MT%q_trans = q_transfer(1:MT%num_q_trans)
-          end if
-           
-          deallocate(q_transfer)
-   
-       end  subroutine InitTransfer
- 
-       function GetTauStart(q)
-         real(dl), intent(IN) :: q
-         real(dl) taustart, GetTauStart
- 
- !     Begin when wave is far outside horizon.
- !     Conformal time (in Mpc) in the radiation era, for photons plus 3 species
- !     of relativistic neutrinos.
-             if (CP%flat) then
-               taustart=0.001_dl/q
-             else
-               taustart=0.001_dl/sqrt(q**2-CP%curv)
-              end if
- 
- !     Make sure to start early in the radiation era.
-           taustart=min(taustart,0.1_dl)
- 
- !     Start when massive neutrinos are strongly relativistic.
-             if (CP%Num_nu_massive>0) then
-                taustart=min(taustart,1.d-3/maxval(nu_masses(1:CP%Nu_mass_eigenstates))/adotrad)
-             end if
- 
-             GetTauStart=taustart
-       end function GetTauStart
- 
- 
-       subroutine DoSourcek(EV,q_ix)
-         integer q_ix
-         real(dl) taustart
-         type(EvolutionVars) EV
- 
-             EV%q=Evolve_q%points(q_ix) 
-  
-             EV%q2=EV%q**2
- 
-             EV%q_ix = q_ix
-             EV%TransferOnly=.false.
-       
-             taustart = GetTauStart(EV%q)
-    
-             call GetNumEqns(EV)
- 
-             if (CP%WantScalars) call CalcScalarSources(EV,taustart)
-             if (CP%WantVectors) call CalcVectorSources(EV,taustart)
-             if (CP%WantTensors) call CalcTensorSources(EV,taustart)
- 
-       end subroutine DoSourcek
- 
-        subroutine GetSourceMem
-      
-         if (CP%WantScalars) then
-            if (CP%Dolensing) then
-             SourceNum=3
-             C_last = C_PhiTemp
-          else
-             SourceNum=2
-             C_last = C_Cross
-            end if
-         else
-            SourceNum=3 
-         end if
-        
-         allocate(Src(Evolve_q%npoints,SourceNum,TimeSteps%npoints))
-         Src=0
-         allocate(ddSrc(Evolve_q%npoints,SourceNum,TimeSteps%npoints))
-     
-        end subroutine GetSourceMem
- 
- 
-        subroutine FreeSourceMem
-          
-         deallocate(Src, ddSrc)
-         call Ranges_Free(Evolve_q)
- 
-        end subroutine FreeSourceMem
- 
- 
- !  initial variables, number of steps, etc.
-       subroutine InitVars
-       use ThermoData
-       use precision
-       use ModelParams
-       
-       implicit none
-       real(dl) taumin, maxq
-       integer itf
- 
- 
- 
-  ! Maximum and minimum k-values.      
-       if (CP%flat) then
-       qmax=maximum_qeta/CP%tau0
-       qmin=qmin0/CP%tau0/AccuracyBoost
-       else              
-         qmax=maximum_qeta/CP%r/CP%chi0
-         qmin=qmin0/CP%r/CP%chi0/AccuracyBoost
-       end if
- !     Timesteps during recombination (tentative, the actual
- !     timestep is the minimum between this value and taurst/40,
- !     where taurst is the time when recombination starts - see inithermo
- 
-       dtaurec_q=4/qmax/AccuracyBoost 
-       if (.not. CP%flat) dtaurec_q=dtaurec_q/6
-       !AL:Changed Dec 2003, dtaurec feeds back into the non-flat integration via the step size
-       dtaurec = dtaurec_q
-       !dtau rec may be changed by inithermo
- 
-       max_etak_tensor = AccuracyBoost*maximum_qeta /10  
-       max_etak_scalar = AccuracyBoost*max(1700._dl,maximum_qeta) /20 
-       if (maximum_qeta <3500 .and. AccuracyBoost < 2) max_etak_scalar = max_etak_scalar * 1.5
-         !tweak to get large scales right
-       max_etak_vector = max_etak_scalar
-       
-       if (CP%WantCls) then     
-          maxq = qmax
-          if (CP%WantTransfer) maxq=max(qmax,CP%Transfer%kmax)
-       else
-          maxq=CP%Transfer%kmax
-       end if
- 
-       taumin=GetTauStart(maxq)
-    
- !     Initialize baryon temperature and ionization fractions vs. time.
- !     This subroutine also fixes the timesteps where the sources are
- !     saved in order to do the integration. So TimeSteps is set here.
-       !These routines in ThermoData (modules.f90)
-   
-       call inithermo(taumin,CP%tau0)
- 
-    
-       if (DebugMsgs .and. Feedbacklevel > 0) write (*,*) 'inithermo'
- 
- !Do any array initialization for propagation equations
-       call GaugeInterface_Init
-  
-       if (Feedbacklevel > 0)  &
-            write(*,'("tau_recomb/Mpc       = ",f7.2,"  tau_now/Mpc = ",f8.1)') tau_maxvis,CP%tau0
- 
- !     Calculating the times for the outputs of the transfer functions.
- !
-       if (CP%WantTransfer) then
-          do itf=1,CP%Transfer%num_redshifts
-             tautf(itf)=min(TimeOfz(CP%Transfer%redshifts(itf)),CP%tau0)
-             if (itf>1) then
-              if (tautf(itf) <= tautf(itf-1)) then
-                stop 'Transfer redshifts not set or out of order'
-              end if
-             end if
-          end do
-       endif
-  
-       end subroutine InitVars
- 
-       subroutine SetkValuesForSources
-       implicit none
-       real(dl) dlnk0, dkn1, dkn2, q_switch
-       real(dl) qmax_log
- 
- !     set k values for which the sources for the anisotropy and
- !     polarization will be calculated. For low values of k we
- !     use a logarithmic spacing. closed case dealt with by SetClosedkValues
-          if (CP%WantScalars .and. CP%Reion%Reionization .and. CP%AccuratePolarization) then
-             dlnk0=2._dl/10/AccuracyBoost
-             !Need this to get accurate low l polarization
-          else
-             dlnk0=5._dl/10/AccuracyBoost
-             if (CP%closed) dlnk0=dlnk0/2
-          end if
- 
-          if (CP%AccurateReionization) dlnk0 = dlnk0/2
- 
-          dkn1=0.6_dl/taurst/AccuracyBoost 
-          dkn2=1.1_dl/taurst/AccuracyBoost 
-           if (CP%WantTensors .or. CP%WantVectors) then
-               dkn1=dkn1  *0.8_dl
-               dlnk0=dlnk0/2 !*0.3_dl
-               dkn2=dkn2*0.7_dl
-           end if
- 
-          qmax_log = dkn1/dlnk0
-          q_switch = 2*6.3/taurst
-            !Want linear spacing for wavenumbers which come inside horizon
-            !Could use sound horizon, but for tensors that is not relevant
- 
-          call Ranges_Init(Evolve_q)
-          call Ranges_Add_delta(Evolve_q, qmin, qmax_log, dlnk0, IsLog = .true.)
-          call Ranges_Add_delta(Evolve_q, qmax_log, min(qmax,q_switch), dkn1)
-          if (qmax > q_switch) then
-            call Ranges_Add_delta(Evolve_q, q_switch, qmax, dkn2)
-          end if
- 
-          call Ranges_GetArray(Evolve_q, .false.)
- 
-          if (CP%closed) &
-            call SetClosedkValuesFromArr(Evolve_q) 
-  
- 
-       end subroutine SetkValuesForSources
- 
- 
-       subroutine SetClosedkValuesFromArr(R)
-       Type(Regions) :: R
-       integer i,nu,lastnu,nmax
-        !nu = 3,4,5... in CP%closed case, so set nearest integers from arr array
-                 
-        lastnu=3
-        nmax=1
-       
-        do i=2,R%npoints
-          nu=nint(R%points(i)*CP%r)
-          if (nu > lastnu) then
-           nmax=nmax+1
-           lastnu=nu         
-           R%points(nmax)=nu/CP%r 
-          end if
-        
-        end do  
-        R%points(1)=3/CP%r
-        R%Lowest = R%points(1) 
-        R%Highest = R%points(nmax)
-        R%npoints=nmax
- 
-       end subroutine SetClosedkValuesFromArr
- 
- 
- 
-       subroutine CalcScalarSources(EV,taustart)
-       use Transfer
-       implicit none
-       type(EvolutionVars) EV
-       real(dl) tau,tol1,tauend, taustart
-       integer j,ind,itf
-       real(dl) c(24),w(EV%nvar,9), y(EV%nvar), sources(SourceNum)
- 
- !
- !EV%q=0.2
- !EV%q2=EV%q**2
- 
-          w=0
-          y=0
-          call initial(EV,y, taustart)
- 
-        
-          tau=taustart
-          ind=1
- 
- !!Example code for plotting out variable evolution
- !if (.true.) then
- !           tol1=tol/exp(AccuracyBoost-1)
-        
- !        do j=1,6000      
- !          tauend = taustart * exp(j/6000._dl*log(CP%tau0/taustart))
- !          call GaugeInterface_EvolveScal(EV,tau,y,tauend,tol1,ind,c,w)
-          
- !          write (*,'(4E15.5)') 1/y(1)-1, y(3), y(EV%w_ix) ,y(EV%w_ix+1)                           
- !         end do
- !     stop
- !end if
- 
- 
- !     Begin timestep loop.
- 
-            itf=1
-            tol1=tol/exp(AccuracyBoost-1)
-            if (CP%WantTransfer .and. CP%Transfer%high_precision) tol1=tol1/100
- 
-            do j=2,TimeSteps%npoints               
-              tauend=TimeSteps%points(j)  
- 
-              if (.not. DebugEvolution .and. (EV%q*tauend > max_etak_scalar .and. tauend > taurend) &
-                   .and. .not. CP%Dolensing .and. &
-                   (.not.CP%WantTransfer.or.tau > tautf(CP%Transfer%num_redshifts))) then
-       
-               Src(EV%q_ix,1:SourceNum,j)=0
-  
-              else
-              
-              !Integrate over time, calulate end point derivs and calc output
-              call GaugeInterface_EvolveScal(EV,tau,y,tauend,tol1,ind,c,w)
-  
-              call output(EV,y, EV%ScalEqsToPropagate,j,tau,sources)
-              Src(EV%q_ix,1:SourceNum,j)=sources
-  
-              if (CP%Num_Nu_Massive > 0 .and.(EV%NuMethod==Nu_trunc).and..not.EV%MassiveNuApprox.and. &
-                   .not.CP%Transfer%high_precision.and. &
-                  ((EV%q<0.1_dl .and.EV%w_nu < 0.015/AccuracyBoost/lAccuracyBoost).or.&
-                   (EV%w_nu < 0.008/AccuracyBoost/lAccuracyBoost))) then 
-      
-                 !Neutrinos no longer highly relativistic so make approximation               
-                 if ( .not.CP%DoLensing.and..not. CP%WantTransfer &
-                        .or. EV%w_nu < 1e-8/EV%q**2/AccuracyBoost/lAccuracyBoost)  &
-                            call SwitchToMassiveNuApprox(EV, y)
-               end if
-              
- !     Calculation of transfer functions.
- 101          if (CP%WantTransfer.and.itf <= CP%Transfer%num_redshifts) then
-                 if (j < TimeSteps%npoints) then
-                   if (tauend < tautf(itf) .and.TimeSteps%points(j+1)  > tautf(itf)) then
-                           
-                      call GaugeInterface_EvolveScal(EV,tau,y,tautf(itf),tol1,ind,c,w)
- 
-                   endif
-                 end if  
- !     output transfer functions for this k-value.
-                       
-                   if (abs(tau-tautf(itf)) < 1.e-5_dl) then
-                            call outtransf(EV,y, MT%TransferData(:,EV%q_ix,itf))
-                          
-                            itf=itf+1
-                            if (j < TimeSteps%npoints) then
-                             if (itf <= CP%Transfer%num_redshifts.and. &
-                                 TimeSteps%points(j+1) > tautf(itf)) goto 101
-                            end if    
-                   endif
- 
-                   end if
-              end if
- 
-             end do !time step loop
- 
-       end subroutine
- 
- 
-       subroutine CalcTensorSources(EV,taustart)
- 
-       implicit none
-       type(EvolutionVars) EV
-       real(dl) tau,tol1,tauend, taustart
-       integer j,ind
-       real(dl) c(24),wt(EV%nvart,9), yt(EV%nvart)
- 
- 
-            call initialt(EV,yt, taustart)
-      
-            tau=taustart
-            ind=1 
-            tol1=tol/exp(AccuracyBoost-1)
- 
- !     Begin timestep loop.    
-            do j=2,TimeSteps%npoints
-                   tauend=TimeSteps%points(j)        
-                   if (EV%q*tauend > max_etak_tensor) then
-                      Src(EV%q_ix,1:SourceNum,j) = 0
-                    else
-       
-                      if (CP%flat) then
-                       call dverk(EV,EV%nvart,fderivst,tau,yt,tauend,tol1,ind,c,EV%nvart,wt) !tauend
-                      else 
-                       call dverk(EV,EV%nvart, derivst,tau,yt,tauend,tol1,ind,c,EV%nvart,wt)
-                      end if
-  
-                      call outputt(EV,yt,EV%nvart,j,tau,Src(EV%q_ix,CT_Temp,j),&
-                                   Src(EV%q_ix,CT_E,j),Src(EV%q_ix,CT_B,j))
-            
-                    end if
-               end do
-     
-       end subroutine CalcTensorSources
- 
- 
-       subroutine CalcVectorSources(EV,taustart)
- 
-       implicit none
-       type(EvolutionVars) EV
-       real(dl) tau,tol1,tauend, taustart
-       integer j,ind
-       real(dl) c(24),wt(EV%nvarv,9), yv(EV%nvarv)!,yvprime(EV%nvarv)
-         
-            
- !EV%q=0.2
- !EV%q2=EV%q**2
- 
-            call initialv(EV,yv, taustart)
-      
-            tau=taustart
-            ind=1 
-            tol1=tol*0.01/exp(AccuracyBoost-1)
- 
- !!Example code for plotting out variable evolution
- !if (.false.) then
- !        do j=1,6000      
- !          tauend = taustart * exp(j/6000._dl*log(CP%tau0/taustart))
- !         call dverk(EV,EV%nvarv,fderivsv,tau,yv,tauend,tol1,ind,c,EV%nvarv,wt) !tauend
- !          call fderivsv(EV,EV%nvarv,tau,yv,yvprime)
- !
- !          write (*,'(7E15.5)') yv(1), yv(2), yv(3),yv(4), &
- !                   yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+1), &
- !                yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+2),yv(5)                            
- !         end do
- !       stop
- !nd if
- 
- !     Begin timestep loop.            
-                do j=2,TimeSteps%npoints
-                   tauend=TimeSteps%points(j)
- 
-                   if ( EV%q*tauend > max_etak_vector) then
-                      Src(EV%q_ix,1:SourceNum,j) = 0
-                    else
-       
-                       call dverk(EV,EV%nvarv,fderivsv,tau,yv,tauend,tol1,ind,c,EV%nvarv,wt) !tauend
-                  
-                       call outputv(EV,yv,EV%nvarv,j,tau,Src(EV%q_ix,CT_Temp,j),&
-                                   Src(EV%q_ix,CT_E,j),Src(EV%q_ix,CT_B,j))
-            
-                    end if
-               end do
- 
-       end subroutine CalcVectorSources
- 
- 
-      subroutine TransferOut
-     !Output transfer functions for k larger than used for C_l computation
-       implicit none
-       integer q_ix
-       real(dl) tau
-       type(EvolutionVars) EV
-     
- 
-        if (DebugMsgs .and. Feedbacklevel > 0) & 
-          write(*,*) MT%num_q_trans-Evolve_q%npoints, 'transfer k values'
- 
-       !$OMP PARAllEl DO DEFAUlT(SHARED),SCHEDUlE(DYNAMIC) &
-       !$OMP & PRIVATE(EV, tau, q_ix) 
- 
- !     loop over wavenumbers.
-          do q_ix=Evolve_q%npoints+1,MT%num_q_trans
-       
-             EV%TransferOnly=.true. !in case we want to do something to speed it up
-           
-             EV%q= MT%q_trans(q_ix)
- 
-             EV%q2=EV%q**2
-             EV%q_ix = q_ix
-           
-             tau = GetTauStart(EV%q)
- 
-             call GetNumEqns(EV)
- 
-             call GetTransfer(EV, tau)
- 
-          end do
-      !$OMP END PARAllEl DO 
- 
-      end subroutine TransferOut
-       
-      subroutine GetTransfer(EV,tau)
-        type(EvolutionVars) EV
-        real(dl) tau
-        integer ind, i
-        real(dl) c(24),w(EV%nvar,9), y(EV%nvar)
-        real(dl) atol
-        
-        atol=tol/exp(AccuracyBoost-1)
-        if (CP%Transfer%high_precision) atol=atol/10000
- 
-        ind=1
-        call initial(EV,y, tau)  
-          
-        do i=1,CP%Transfer%num_redshifts
-           call GaugeInterface_EvolveScal(EV,tau,y,tautf(i),atol,ind,c,w)
-           call outtransf(EV,y,MT%TransferData(:,EV%q_ix,i))
-        end do
-  
-      end subroutine GetTransfer
- 
- 
-      subroutine NonLinearLensing
-         !Scale lensing source terms by non-linear scaling at each redshift and wavenumber
-         use NonLinear
-         integer i,ik,first_step
-         real (dl) tau
-         real(dl) scaling(CP%Transfer%num_redshifts), ddScaling(CP%Transfer%num_redshifts)
-         real(dl) ho,a0,b0, ascale
-         integer tf_lo, tf_hi
-         type(MatterPowerData) :: CAMB_Pk
- 
-         call Transfer_GetMatterPowerData(MT, CAMB_PK, 1)
- 
-         call NonLinear_GetNonLinRatios(CAMB_PK)
-  
-          if (CP%InitPower%nn > 1) stop 'Non-linear lensing only does one initial power'
- 
-         first_step=1
-         do while(TimeSteps%points(first_step) < tautf(1))
-            first_step = first_step + 1 
-         end do
-  
-         do ik=1, Evolve_q%npoints
-           if (Evolve_q%points(ik)/(CP%H0/100) >  Min_kh_nonlinear) then
- 
-             !Interpolate non-linear scaling in conformal time
-             do i = 1, CP%Transfer%num_redshifts
-                 scaling(i) = CAMB_Pk%nonlin_ratio(ik,i)
-             end do
-             if (all(abs(scaling-1) < 5e-4)) cycle
-             call spline(tautf,scaling(1),CP%Transfer%num_redshifts,&
-                                  spl_large,spl_large,ddScaling(1))
-        
-             tf_lo=1
-             tf_hi=tf_lo+1
- 
-             do i=first_step,TimeSteps%npoints-1
-   
-               tau = TimeSteps%points(i)
-             
-               do while (tau > tautf(tf_hi))
-                   tf_lo = tf_lo + 1
-                   tf_hi = tf_hi + 1
-               end do
- 
-               ho=tautf(tf_hi)-tautf(tf_lo) 
-               a0=(tautf(tf_hi)-tau)/ho
-               b0=1-a0
-               
-               ascale = a0*scaling(tf_lo)+ b0*scaling(tf_hi)+&
-                   ((a0**3-a0)* ddscaling(tf_lo) &
-                        +(b0**3-b0)*ddscaling(tf_hi))*ho**2/6
-                         
-               Src(ik,3,i) = Src(ik,3,i) * ascale
-             end  do
- 
-           end if
-        end do
-        
-        call MatterPowerdata_Free(CAMB_pk)
-  
-       end subroutine NonLinearLensing
- 
- 
-       subroutine InitSourceInterpolation
-       integer i,j
- !     get the interpolation matrix for the sources to interpolate them
- !     for other k-values
-       !$OMP PARAllEl DO DEFAUlT(SHARED), SCHEDUlE(STATIC), PRIVATE(i,j) , SHARED(Evolve_q)
-         do  i=1,TimeSteps%npoints
-            do j=1, SourceNum
-                call spline(Evolve_q%points,Src(1,j,i),Evolve_q%npoints,spl_large,spl_large,ddSrc(1,j,i))
-           end do
-         end do
-        !$OMP END PARAllEl DO 
-        end subroutine InitSourceInterpolation
- 
- 
-      subroutine SetkValuesForInt
-       implicit none
-        
-       integer no
-       real(dl) dk,dk0,dlnk1, dk2, max_k_dk, k_max_log, k_max_0
-       integer lognum
-       real(dl)  qmax_int,IntSampleBoost
-       
- 
-        qmax_int = min(qmax,max_bessels_etak/CP%tau0)
- 
- 
-        IntSampleBoost=AccuracyBoost
- 
- !     Fixing the # of k for the integration. 
-       
-        call Ranges_Init(ThisCT%q)
- 
-       if (CP%closed.and.ExactClosedSum) then
-        
-         call Ranges_Add(ThisCT%q,3/CP%r, nint(qmax_int*CP%r)/CP%r, nint(qmax_int*CP%r)-3) !fix jun08
-         call Init_ClTransfer(ThisCT)
-         call Ranges_Getdpoints(ThisCT%q,half_ends = .false.) !Jun08
-       else
- 
-       !Split up into logarithmically spaced intervals from qmin up to k=lognum*dk0
-       !then no-lognum*dk0 linearly spaced at dk0 up to no*dk0
-       !then at dk up to max_k_dk, then dk2 up to qmax_int
-          if (CP%closed) then
-             lognum=nint(20*IntSampleBoost)
-             dlnk1=1._dl/lognum 
-             no=nint(1300*IntSampleBoost)
-             dk=1.2/CP%r/CP%chi0/IntSampleBoost
-             dk0=0.4_dl/CP%r/CP%chi0/IntSampleBoost
-          else 
-             lognum=nint(10*IntSampleBoost) 
-             dlnk1=1._dl/lognum  
-             no=nint(600*IntSampleBoost)
-             dk0=1.8_dl/CP%r/CP%chi0/IntSampleBoost   
-             dk=3._dl/CP%r/CP%chi0/IntSampleBoost   
-          end if
- 
-          k_max_log = lognum*dk0
-          k_max_0  = no*dk0
- 
-          dk2 = 0.04/IntSampleBoost !very small scales
- 
-          call Ranges_Add_delta(ThisCT%q, qmin, k_max_log, dlnk1, IsLog = .true.)
-          call Ranges_Add_delta(ThisCT%q, k_max_log, min(qmax_int,k_max_0), dk0)     
-        
-          if (qmax_int > k_max_0) then
- 
-          max_k_dk = max(3000, 2*maximum_l)/CP%tau0
-        
-           call Ranges_Add_delta(ThisCT%q, k_max_0, min(qmax_int, max_k_dk), dk)
-           if (qmax_int > max_k_dk) then
-            !This allows inclusion of high k modes for computing BB lensed spectrum accurately
-            !without taking ages to compute.
-             call Ranges_Add_delta(ThisCT%q, max_k_dk, qmax_int, dk2)
-           end if    
- 
-          end if           
- 
-          call Init_ClTransfer(ThisCT)
- 
-        if (CP%closed) then
-         call SetClosedkValuesFromArr(ThisCT%q)
-         call Ranges_Getdpoints(ThisCT%q,half_ends = .false.)
-         ThisCT%q%dpoints(1) = 1/CP%r
-      
-        end if
- 
-        end if !ExactClosedSum
- 
-          
-       end subroutine setkValuesForInt
- 
-       subroutine InterpolateSources(IV)
-       implicit none
-       integer i,khi,klo, step
-       real(dl) xf,b0,ho,a0,ho2o6,a03,b03
-       type(IntegrationVars) IV
- 
- 
- !     finding position of k in table Evolve_q to do the interpolation.
- 
- !Can't use the following in closed case because regions are not set up (only points)  
- !           klo = min(Evolve_q%npoints-1,Ranges_IndexOf(Evolve_q, IV%q))
-            !This is a bit inefficient, but thread safe
-             klo=1
-             do while ((IV%q > Evolve_q%points(klo+1)).and.(klo < (Evolve_q%npoints-1))) 
-                klo=klo+1
-             end do
- 
-             khi=klo+1
- 
- 
-             ho=Evolve_q%points(khi)-Evolve_q%points(klo)
-             a0=(Evolve_q%points(khi)-IV%q)/ho
-             b0=(IV%q-Evolve_q%points(klo))/ho           
-             ho2o6 = ho**2/6
-             a03=(a0**3-a0)
-             b03=(b0**3-b0)
-             IV%SourceSteps = 0
- 
- !     Interpolating the source as a function of time for the present
- !     wavelength.
-              step=2
-                do i=2, TimeSteps%npoints
-                   xf=IV%q*(CP%tau0-TimeSteps%points(i))
-                   if (CP%WantTensors) then
-                    if (IV%q*TimeSteps%points(i) < max_etak_tensor.and. xf > 1.e-8_dl) then
-                     step=i
-                      IV%Source_q(i,1:SourceNum) =a0*Src(klo,1:SourceNum,i)+&
-                           b0*Src(khi,1:SourceNum,i)+(a03 *ddSrc(klo,1:SourceNum,i)+ &
-                           b03*ddSrc(khi,1:SourceNum,i)) *ho2o6
-                     else
-                      IV%Source_q(i,1:SourceNum) = 0
-                    end if
-                   end if
-                   if (CP%WantVectors) then
-                    if (IV%q*TimeSteps%points(i) < max_etak_vector.and. xf > 1.e-8_dl) then
-                      step=i
-                      IV%Source_q(i,1:SourceNum) =a0*Src(klo,1:SourceNum,i)+&
-                           b0*Src(khi,1:SourceNum,i)+(a03 *ddSrc(klo,1:SourceNum,i)+ &
-                           b03*ddSrc(khi,1:SourceNum,i)) *ho2o6
-                     else
-                      IV%Source_q(i,1:SourceNum) = 0
-                    end if
-                   end if
- 
-                   if (CP%WantScalars) then
-                      if ((CP%Dolensing .or. IV%q*TimeSteps%points(i) < max_etak_scalar) .and. xf > 1.e-8_dl) then
-                         step=i
-                         IV%Source_q(i,1:SourceNum)=a0*Src(klo,1:SourceNum,i)+ &
-                          b0*Src(khi,1:SourceNum,i) + (a03*ddSrc(klo,1:SourceNum,i) &
-                          +b03*ddSrc(khi,1:SourceNum,i))*ho2o6
-   
-                      else
-                        IV%Source_q(i,1:SourceNum) = 0 
-                      end if
-                   end if
-                end do
-                IV%SourceSteps = step
-   
- 
-           if (.not.CP%flat) then
-              do i=1, SourceNum
-                 call spline(TimeSteps%points,IV%Source_q(1,i),TimeSteps%npoints,&
-                      spl_large,spl_large,IV%ddSource_q(1,i))
-              end do
-           end if
-            
-            IV%SourceSteps = IV%SourceSteps*1
-            !This is a fix for a compiler bug on Seaborg 
- 
-       end subroutine
- 
-       
-       subroutine IntegrationVars_Init(IV)
-       type(IntegrationVars), intent(INOUT) :: IV
-         
-         IV%Source_q(1,1:SourceNum)=0
-         IV%Source_q(TimeSteps%npoints,1:SourceNum) = 0
-         IV%Source_q(TimeSteps%npoints-1,1:SourceNum) = 0
-  
-       end  subroutine IntegrationVars_Init
- 
- 
- !cccccccccccccccccccccccccccccccccccc
- 
- 
-       subroutine DoSourceIntegration(IV) !for particular wave number q
-       integer j,ll,llmax
-       real(dl) nu
-       type(IntegrationVars) IV
-        
-          
-          nu=IV%q*CP%r
-         
-          if (CP%closed) then
-           
-           if (nu<20 .or. CP%tau0/CP%r+6*pi/nu > pi/2) then
-            llmax=nint(nu)-1
-           else
-            llmax=nint(nu*rofChi(CP%tau0/CP%r + 6*pi/nu))
-            llmax=min(llmax,nint(nu)-1)  !nu >= l+1
-           end if       
- 
-          else
-           llmax=nint(nu*CP%chi0)
-           
-           if (llmax<15) then
-            llmax=15
-           else
-            llmax=nint(nu*rofChi(CP%tau0/CP%r + 6*pi/nu))
-           end if
-       
-          end if 
- 
-          if (CP%flat) then
-             call DoFlatIntegration(IV,llmax)
-          else
-            do j=1,lSamp%l0
-             ll=lSamp%l(j)
-             if (ll>llmax) exit  
-          
-             call IntegrateSourcesBessels(IV,j,ll,nu)      
-            end do !j loop
-          end if
- 
-        
- 
-       end subroutine DoSourceIntegration     
- 
-       function UseLimber(l,k)
-        !Calculate lensing potential power using Limber rather than j_l integration
-        !even when sources calculated as part of temperature calculation
-        !(Limber better on small scales unless step sizes made much smaller)
-        !This affects speed, esp. of non-flat case
-         logical :: UseLimber
-         integer l
-         real(dl) :: k
-  
-         if (CP%AccurateBB .or. CP%flat) then
-          UseLimber = l > 700*AccuracyBoost .and. k > 0.05    
-         else
-          !This is accurate at percent level only (good enough here)
-          UseLimber = l > 300*AccuracyBoost .or. k>0.05
-         end if
- 
-       end function UseLimber
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !flat source integration
-         subroutine DoFlatIntegration(IV, llmax)
-         implicit none
-         type(IntegrationVars) IV
-         integer llmax
-         integer j
-         logical DoInt
-         real(dl) xlim,xlmax1 
-         real(dl) tmin, tmax
-         real(dl) a2, J_l, aa(IV%SourceSteps), fac(IV%SourceSteps)
-         real(dl) xf, sums(SourceNum)
-         integer bes_ix,n, bes_index(IV%SourceSteps)
-      
- !     Find the position in the xx table for the x correponding to each
- !     timestep
- 
-          do j=1,IV%SourceSteps !Precompute arrays for this k
-             xf=abs(IV%q*(CP%tau0-TimeSteps%points(j)))
-             bes_index(j)=Ranges_indexOf(BessRanges,xf)
-           !Precomputed values for the interpolation
-             bes_ix= bes_index(j)
-             fac(j)=BessRanges%points(bes_ix+1)-BessRanges%points(bes_ix)
-             aa(j)=(BessRanges%points(bes_ix+1)-xf)/fac(j)
-             fac(j)=fac(j)**2*aa(j)/6
-          end do
- 
- 
-          do j=1,lSamp%l0 
-              if (lSamp%l(j) > llmax) return
-              xlim=xlimfrac*lSamp%l(j)
-              xlim=max(xlim,xlimmin)
-              xlim=lSamp%l(j)-xlim
-              xlmax1=80*lSamp%l(j)*AccuracyBoost
-              tmin=CP%tau0-xlmax1/IV%q
-              tmax=CP%tau0-xlim/IV%q
-              tmax=min(CP%tau0,tmax)
-              tmin=max(TimeSteps%points(2),tmin)
-                
-              if (tmax < TimeSteps%points(2)) exit
-              sums(1:SourceNum) = 0
-  
-             !As long as we sample the source well enough, it is sufficient to
-             !interpolate the Bessel functions only
- 
-              if (SourceNum==2) then
-               !This is the innermost loop, so we separate the no lensing scalar case to optimize it
-                  do n= Ranges_IndexOf(TimeSteps,tmin),min(IV%SourceSteps,Ranges_IndexOf(TimeSteps,tmax))
- 
-                  a2=aa(n)
-                  bes_ix=bes_index(n) 
- 
-                  J_l=a2*ajl(bes_ix,j)+(1-a2)*(ajl(bes_ix+1,j) - ((a2+1) &
-                         *ajlpr(bes_ix,j)+(2-a2)*ajlpr(bes_ix+1,j))* fac(n)) !cubic spline
-                  J_l = J_l*TimeSteps%dpoints(n)
-                  sums(1) = sums(1) + IV%Source_q(n,1)*J_l
-                  sums(2) = sums(2) + IV%Source_q(n,2)*J_l
- 
-                 end do
-               else 
-                  DoInt = .not. CP%WantScalars .or. IV%q < max(850,lSamp%l(j))*3*AccuracyBoost/CP%tau0  
-                  if (DoInt) then
-                   do n= Ranges_IndexOf(TimeSteps,tmin),min(IV%SourceSteps,Ranges_IndexOf(TimeSteps,tmax))
-                   !Full Bessel integration
-                      a2=aa(n)
-                      bes_ix=bes_index(n) 
- 
-                      J_l=a2*ajl(bes_ix,j)+(1-a2)*(ajl(bes_ix+1,j) - ((a2+1) &
-                             *ajlpr(bes_ix,j)+(2-a2)*ajlpr(bes_ix+1,j))* fac(n)) !cubic spline
-                      J_l = J_l*TimeSteps%dpoints(n)
-               
-                     !The unwrapped form is faster
-      
-                      sums(1) = sums(1) + IV%Source_q(n,1)*J_l
-                      sums(2) = sums(2) + IV%Source_q(n,2)*J_l
-                      sums(3) = sums(3) + IV%Source_q(n,3)*J_l
-     
-                   end do
-                  end if
-                  if (.not. DoInt .or. UseLimber(lsamp%l(j),IV%q) .and. CP%WantScalars) then
-                   !Limber approximation for small scale lensing (better than poor version of above integral)
-                   xf = CP%tau0-lSamp%l(j)/IV%q
-                   if (xf < TimeSteps%Highest .and. xf > TimeSteps%Lowest) then
-                    n=Ranges_IndexOf(TimeSteps,xf)
-                    xf= (xf-TimeSteps%points(n))/(TimeSteps%points(n+1)-TimeSteps%points(n))                  
-                    sums(3) = (IV%Source_q(n,3)*(1-xf) + xf*IV%Source_q(n+1,3))*sqrt(pi/2/lSamp%l(j))/IV%q 
-                   else
-                    sums(3)=0
-                   end if
-                  end if
- 
-               end if
-   
-               ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) = ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) + sums(1:SourceNum)
-  !             IV%Delta_l_q(1:SourceNum,j) = IV%Delta_l_q(1:SourceNum,j) + sums(1:SourceNum)
-          
-           end do
- 
-       
-         end subroutine DoFlatIntegration
-    
- 
-     
- !non-flat source integration
- 
-       subroutine IntegrateSourcesBessels(IV,j,l,nu)  
-       use SpherBessels
-       type(IntegrationVars) IV
-       logical DoInt   
-       integer l,j, nstart,nDissipative,ntop,nbot,nrange,nnow
-       real(dl) nu,ChiDissipative,ChiStart,tDissipative,y1,y2,y1dis,y2dis     
-       real(dl) xf,x,chi, miny1
-       real(dl) sums(SourceNum),out_arr(SourceNum)     
-     
-       !Calculate chi where for smaller chi it is dissipative
-       x=sqrt(real(l*(l+1),dl))/nu
-     
-       ChiDissipative=invsinfunc(x) 
-     
-       ChiStart=ChiDissipative
-       !Move down a bit to get smaller value (better accuracy integrating up from small values)
-       if (nu<300) ChiStart = max(ChiDissipative-1._dl/nu,1d-6)   !max(ChiDissipative-1._dl/nu,1d-6)
-  
-         !Then get nearest source point with lower Chi...
-       tDissipative=CP%tau0 - CP%r*ChiStart
-       if (tDissipative<TimeSteps%points(1)) then
-          nDissipative=2
-        else 
-          nDissipative = Ranges_IndexOf(TimeSteps,tDissipative)+1
-       endif 
-       nDissipative=min(nDissipative,TimeSteps%npoints-1)
- 
-       tDissipative = TimeSteps%points(nDissipative)
- 
-       ChiStart =  max(1d-8,(CP%tau0-tDissipative)/CP%r)
-        
-       !Get values at ChiStart
-    
-       call USpherBesselWithDeriv(CP%closed,ChiStart,l,nu,y1dis,y2dis)  
- 
-      nstart=nDissipative         
-      chi=ChiStart
- 
-      if ((CP%WantScalars)) then !Do Scalars
- 
-       !Integrate chi down in dissipative region
-       ! cuts off when ujl gets small
-          miny1= 0.5d-4/l/AccuracyBoost
-          sums=0
- 
-          DoInt =  SourceNum/=3 .or. IV%q < max(850,l)*3*AccuracyBoost/(CP%chi0*CP%r) 
-          if (DoInt) then
-          if ((nstart < min(TimeSteps%npoints-1,IV%SourceSteps)).and.(y1dis > miny1)) then
-      
-             y1=y1dis
-             y2=y2dis
-             nnow=nstart
-             do nrange = 1,TimeSteps%Count
-                if (nrange == TimeSteps%count) then
-                 ntop = TimeSteps%npoints -1
-                else
-                 ntop = TimeSteps%R(nrange+1)%start_index
-                end if
-                if (nnow < ntop) then
-                   call DoRangeInt(IV,chi,ChiDissipative,nnow,ntop,TimeSteps%R(nrange)%delta, &
-                               nu,l,y1,y2,out_arr)        
-                  sums  = sums + out_arr
-                  nnow = ntop
-                  if (chi==0) exit !small enough to cut off
-                end if
-              end do
-            
-            end if !integrate down chi
-              
-          !Integrate chi up in oscillatory region
-           if (nstart > 2) then
-            y1=y1dis
-            y2=y2dis
-            chi=ChiStart
-             nnow=nstart
-             do nrange = TimeSteps%Count,1,-1 
-                nbot = TimeSteps%R(nrange)%start_index          
-                if (nnow >  nbot) then
-                   call DoRangeInt(IV,chi,ChiDissipative,nnow,nbot,TimeSteps%R(nrange)%delta, &
-                               nu,l,y1,y2,out_arr)
-                  sums=sums+out_arr
-          
-                  if (chi==0) exit !small for remaining region
-                  nnow = nbot
-                end if
-                
-             end do
- 
-            end if
- 
-            end if !DoInt
-          if (SourceNum==3 .and. (.not. DoInt .or. UseLimber(l,IV%q))) then
-             !Limber approximation for small scale lensing (better than poor version of above integral)
-              xf = CP%tau0-invsinfunc(l/nu)*CP%r
- !Feb09 fix screw up introduced Feb 2008 version
-              if (xf < TimeSteps%Highest .and. xf > TimeSteps%Lowest) then
-              nbot=Ranges_IndexOf(TimeSteps,xf)
-              xf= (xf-TimeSteps%points(nbot))/(TimeSteps%points(nbot+1)-TimeSteps%points(nbot))                  
-              sums(3) = (IV%Source_q(nbot,3)*(1-xf) + xf*IV%Source_q(nbot+1,3))*&
-                            sqrt(pi/2/l/sqrt(1-CP%Ksign*real(l**2)/nu**2))/IV%q
-              else
-               sums(3) = 0
-              end if                
-          end if
- 
-          ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix)=ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix)+sums
-            
-       end if !Do Scalars
-            
-      if ((CP%WantTensors)) then !Do Tensors
-          chi=ChiStart
-         
-       !Integrate chi down in dissipative region
-       !DoRangeInt cuts off when ujl gets small
-          miny1= 1.d-6/l/AccuracyBoost
-          if ((nstart < TimeSteps%npoints-1).and.(y1dis>miny1)) then
-             y1=y1dis
-             y2=y2dis
-             nnow=nstart
-             do nrange = 1,TimeSteps%Count
-                if (nrange == TimeSteps%count) then
-                 ntop = TimeSteps%npoints -1
-                else
-                 ntop = TimeSteps%R(nrange+1)%start_index
-                end if
-                if (nnow < ntop) then
-                  call DoRangeIntTensor(IV,chi,ChiDissipative,nnow,ntop,TimeSteps%R(nrange)%delta, &
-                               nu,l,y1,y2,out_arr)
- 
-                  ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) = ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) + out_arr
-                
-                  nnow = ntop
-                  if (chi==0) exit
-                end if
-             end do
-                    
-          end if 
-         
-                  
- !Integrate chi up in oscillatory region
-           if (nstart > 2) then
-            y1=y1dis
-            y2=y2dis
-            chi=ChiStart
-          
-            nnow=nstart
-             do nrange = TimeSteps%Count,1,-1 
-                nbot = TimeSteps%R(nrange)%start_index          
-                if (nnow >  nbot) then
-                  call DoRangeIntTensor(IV,chi,ChiDissipative,nnow,nbot,TimeSteps%R(nrange)%delta, &
-                               nu,l,y1,y2,out_arr)
-                  ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) = ThisCT%Delta_p_l_k(1:SourceNum,j,IV%q_ix) + out_arr
-                 
-                  nnow = nbot
-                  if (chi==0) exit !small for remaining region
-                end if               
-             end do
- 
-           end if
-        
-         end if !Do Tensors
-      
-       end subroutine IntegrateSourcesBessels
- 
-    
- 
-  subroutine DoRangeInt(IV,chi,chiDisp,nstart,nend,dtau,nu,l,y1,y2,out)
-  !Non-flat version
- 
- !returns chi at end of integral (where integral stops, not neccessarily end)
- ! This subroutine integrates the source*ujl for steps nstart to nend
- ! It calculates ujl by integrating a second order
- ! differential equation from initial values.
- ! dtau is the spacing of the timesteps (they must be equally spaced)
- 
-       use precision
-       use ModelParams
-       type(IntegrationVars) IV
-       integer l,nIntSteps,nstart,nend,nlowest,isgn,i,is,Startn
-       real(dl) nu,dtau,num1,num2,Deltachi,aux1,aux2
-       real(dl) a,b,tmpa,tmpb,hh,h6,xh,delchi,taui
-       real(dl) nu2,chi,chiDisp,dydchi1,dydchi2,yt1,yt2,dyt1,dyt2,dym1,dym2
-   
-       real(dl) tmp,dtau2o6,y1,y2,ap1,sh,ujl,chiDispTop
-       real(dl) dchimax,dchisource,sgn,sgndelchi,minujl
-       real(dl), parameter:: MINUJl1 = 0.5d-4  !cut-off point for small ujl l=1
-       logical Interpolate
-       real(dl) scalel
-       real(dl) IntAccuracyBoost
-       real(dl) sources(SourceNum), out(SourceNum)
-    
-       IntAccuracyBoost=AccuracyBoost
- ! atau0 is the array with the time where the sources are stored.
-       if (nend==nstart) then  
-             out = 0
-             return
-          end if
-       
-       dchisource=dtau/CP%r
-      
-       num1=1._dl/nu     
- 
-       scalel=l/scale
-       if (scalel>=2400) then
-          num2=num1*2.5
-       else if (scalel>=1100) then
-          num2=num1*1.5
-       else if (scalel< 50) then
-          num2=num1*0.8_dl
-       else if (scalel < 170) then 
-         num2=num1*1.5_dl
-       else if (scalel < 1100) then 
-          num2=num1*1.2_dl
-       else
-          num2=num1
-       end if    
-       !Dec 2003, since decrease dtaurec, can make this smaller
-       if (dtau==dtaurec_q) then
-        num2=num2/4
-       end if
-       if (num2*IntAccuracyBoost < dchisource .and. (.not. CP%DoLensing .or. UseLimber(l,IV%q)) & 
- !       if ((num2*IntAccuracyBoost < dchisource ) & !Oscillating fast 
-         .or. (nstart>IV%SourceSteps.and.nend>IV%SourceSteps)) then  
-          out = 0
-          y1=0._dl !So we know to calculate starting y1,y2 if there is next range
-          y2=0._dl
-          chi=(CP%tau0-TimeSteps%points(nend))/CP%r
-          return
-         end if
-      
-       Startn=nstart
-       if (nstart>IV%SourceSteps .and. nend < IV%SourceSteps) then
-          chi=(CP%tau0-TimeSteps%points(IV%SourceSteps))/CP%r
-          Startn=IV%SourceSteps
-          call USpherBesselWithDeriv(CP%closed,chi,l,nu,y1,y2)
-       else if ((y2==0._dl).and.(y1==0._dl)) then 
-          call USpherBesselWithDeriv(CP%closed,chi,l,nu,y1,y2)
-       end if
-     
-       if (CP%closed) then
-         !Need to cut off when ujl gets exponentially small as it approaches Pi
-          chiDispTop = pi - chiDisp
-       else
-          chiDispTop = 1d20
-       end if
- 
-       minujl=MINUJl1/l/IntAccuracyBoost
-       isgn=sign(1,Startn-nend)!direction of chi integration 
-         !higher n, later time, smaller chi
-     
-       sgn= isgn
- 
-       nlowest=min(Startn,nend)
-       aux1=1._dl*CP%r/dtau  !used to calculate nearest timestep quickly
-       aux2=(CP%tau0-TimeSteps%points(nlowest))/dtau + nlowest
-           
-       nu2=nu*nu
-       ap1=l*(l+1)
-       sh=rofChi(chi)
-            
-       if (scalel < 120) then
-          dchimax=0.4_dl*num1
-       else if (scalel < 1400) then
-          dchimax=0.25_dl*num1
-       else
-          dchimax=0.35_dl*num1 
-       end if
- 
-       dchimax=dchimax/IntAccuracyBoost
-     
-       ujl=y1/sh
-       sources = IV%Source_q(Startn,1:SourceNum)
- 
-       out = 0.5_dl*ujl*sources
- 
-       Interpolate = dchisource > dchimax
-       if (Interpolate) then !split up smaller than source step size
-          delchi=dchimax
-          Deltachi=sgn*(TimeSteps%points(Startn)-TimeSteps%points(nend))/CP%r
-          nIntSteps=int(Deltachi/delchi+0.99_dl)        
-          delchi=Deltachi/nIntSteps 
-          dtau2o6=(CP%r*delchi)**2/6._dl
-        else !step size is that of source
-          delchi=dchisource
-          nIntSteps=isgn*(Startn-nend)      
-        end if
-         
-          sgndelchi=delchi*sgn
-          tmp=(ap1/sh**2 - nu2) 
-          hh=0.5_dl*sgndelchi  
-          h6=sgndelchi/6._dl
- 
-       
-           do i=1,nIntSteps          
- ! One step in the ujl integration
- ! fourth-order Runge-Kutta method to integrate equation for ujl
- 
-             dydchi1=y2         !deriv y1
-             dydchi2=tmp*y1     !deriv y2     
-             xh=chi+hh          !midpoint of step
-             yt1=y1+hh*dydchi1  !y1 at midpoint
-             yt2=y2+hh*dydchi2  !y2 at midpoint
-             dyt1=yt2           !deriv y1 at mid
-             tmp=(ap1/rofChi(xh)**2 - nu2) 
-             
-             
-             dyt2=tmp*yt1       !deriv y2 at mid
-        
-             yt1=y1+hh*dyt1     !y1 at mid
-             yt2=y2+hh*dyt2     !y2 at mid
-            
-             dym1=yt2           !deriv y1 at mid
-             dym2=tmp*yt1       !deriv y2 at mid
-             yt1=y1+sgndelchi*dym1 !y1 at end
-             dym1=dyt1+dym1     
-             yt2=y2+sgndelchi*dym2 !y2 at end
-             dym2=dyt2+dym2
-             
-             chi=chi+sgndelchi     !end point
-             sh=rofChi(chi)    
-             dyt1=yt2           !deriv y1 at end
-             tmp=(ap1/sh**2 - nu2)
-             dyt2=tmp*yt1       !deriv y2 at end
-             y1=y1+h6*(dydchi1+dyt1+2*dym1) !add up
-             y2=y2+h6*(dydchi2+dyt2+2*dym2)       
- 
-             ujl=y1/sh
-             if ((isgn<0).and.(y1*y2<0._dl).or.((chi>chiDispTop).and.((chi>3.14).or.(y1*y2>0)))) then
-                 chi=0._dl 
-                 exit   !If this happens we are small, so stop integration
-             end if
- 
-      
-             if (Interpolate) then
- ! Interpolate the source
-             taui=aux2-aux1*chi
-             is=int(taui)
-              b=taui-is
-     
-             if (b > 0.998) then 
-                !may save time, and prevents numerical error leading to access violation of IV%Source_q(0)
-              sources = IV%Source_q(is+1,1:SourceNum)
-              else
- 
-              a=1._dl-b          
-              tmpa=(a**3-a)
-              tmpb=(b**3-b)
-              sources=a*IV%Source_q(is,1:SourceNum)+b*IV%Source_q(is+1,1:SourceNum)+ &
-                   (tmpa*IV%ddSource_q(is,1:SourceNum)+ &
-                    tmpb*IV%ddSource_q(is+1,1:SourceNum))*dtau2o6
-              end if
- 
-             else
-              sources = IV%Source_q(Startn - i*isgn,1:SourceNum)
-       
-             end if
- 
-             out = out + ujl*sources
-                 
-             if (((isgn<0).or.(chi>chiDispTop)).and.(abs(ujl) < minujl)) then
-            
-              chi=0
-             exit !break when getting  exponentially small in dissipative region
- 
-             end if
-             
-          end do
- 
-          out = (out - sources*ujl/2)*delchi*CP%r
-          
-          end subroutine DoRangeInt
- 
-  
- 
- 
-       subroutine DoRangeIntTensor(IV,chi,chiDisp,nstart,nend,dtau,nu,l,y1,y2,out)
- ! It calculates ujl by integrating a second order
- ! differential equation from initial values for calculating ujl.
- ! nstart and nend are the starting and finishing values of the
- ! integration.
- ! dtau is the spacing of the timesteps (they must be equally spaced)
- 
-       use precision
-       use ModelParams
-       type(IntegrationVars), target :: IV
-       integer l,nIntSteps,nstart,nend,nlowest,isgn,i,is
-       real(dl) nu,dtau,num1,num2,Deltachi,aux1,aux2
-       real(dl) a,b,tmpa,tmpb,hh,h6,xh,delchi,taui,scalel
-       real(dl) nu2,chi,chiDisp,chiDispTop
-       real(dl) dydchi1,dydchi2,yt1,yt2,dyt1,dyt2,dym1,dym2
-   
-       real(dl) tmp,dtau2o6,y1,y2,ap1,sh,ujl
-       real(dl) dchimax,dchisource,sgn,sgndelchi,minujl
-       real(dl), parameter:: MINUJl1 = 1.D-6  !cut-off point for smal ujl l=1
-       logical Interpolate
-       real(dl) out(SourceNum), source(SourceNum)
-       real(dl), dimension(:,:), pointer :: sourcep, ddsourcep
- 
-       sourcep => IV%Source_q(:,1:)
-       ddsourcep => IV%ddSource_q(:,1:)
-       
-      
-       if (nend==nstart) then  
-             out=0
-             return
-          end if    
-       minujl=MINUJL1*AccuracyBoost/l
-       isgn=sign(1,nstart-nend)!direction of chi integration 
-         !higher n, later time, smaller chi
- 
-       if (CP%closed) then
-         !Need to cut off when ujl gets exponentially small as it approaches Pi
-          chiDispTop = pi - chiDisp
-       else
-          chiDispTop = 1d20
-       end if
-       
-      
-       num1=1._dl/nu
-       dchisource=dtau/CP%r
- 
-       scalel=l/scale
-       if (scalel>=2000) then
-          num2=num1*4
-       else if (scalel>=1000) then
-          num2=num1*2.5 
-       else if (scalel< 75) then
-          num2=num1*0.1_dl
-       else if (scalel<180) then
-          num2=num1*0.3_dl
-       else if (scalel < 600) then
-          num2=num1*0.8_dl
-       else
-          num2=num1
-       end if
-   
-       if ((isgn==1).and.(num2*AccuracyBoost < dchisource)) then  !Oscillating fast
-          out = 0
-          y1=0._dl !!So we know to calculate starting y1,y2 if there is next range
-          y2=0._dl
-          chi=(CP%tau0-TimeSteps%points(nend))/CP%r
-          return
-         end if
-       if ((y2==0._dl).and.(y1==0._dl)) call USpherBesselWithDeriv(CP%closed,chi,l,nu,y1,y2)
-    
-       sgn=isgn
- 
-       nlowest=min(nstart,nend)
-       aux1=1._dl*CP%r/dtau  !used to calculate nearest timestep quickly
-       aux2=(CP%tau0-TimeSteps%points(nlowest))/dtau + nlowest
-           
-      
-       nu2=nu*nu
-       ap1=l*(l+1)
- 
-       sh=rofChi(chi)
-       
-       if (scalel < 120) then
-          dchimax=0.6_dl*num1
-       else if (scalel < 1400) then
-          dchimax=0.25_dl*num1
-       else
-          dchimax=0.35_dl*num1 
-       end if
- 
-       dchimax=dchimax/AccuracyBoost
-      
-       ujl=y1/sh
-       out = ujl * sourcep(nstart,1:SourceNum)/2
-    
-       Interpolate = dchisource > dchimax
-       if (Interpolate) then !split up smaller than source step size
-          delchi=dchimax
-          Deltachi=sgn*(TimeSteps%points(nstart)-TimeSteps%points(nend))/CP%r
-          nIntSteps=int(Deltachi/delchi+0.99_dl)
-          delchi=Deltachi/nIntSteps 
-          dtau2o6=(CP%r*delchi)**2/6._dl
-        else !step size is that of source
-          delchi=dchisource
-          nIntSteps=isgn*(nstart-nend)      
-        end if
-     
-        
-          sgndelchi=delchi*sgn
-          tmp=(ap1/sh**2 - nu2) 
-          hh=0.5_dl*sgndelchi  
-          h6=sgndelchi/6._dl
-     
-                 
-          do i=1,nIntSteps
-             
- 
- ! One step in the ujl integration
- ! fourth-order Runge-Kutta method to integrate equation for ujl
- 
-             dydchi1=y2         !deriv y1
-             dydchi2=tmp*y1     !deriv y2     
-             xh=chi+hh          !midpoint of step
-             yt1=y1+hh*dydchi1  !y1 at midpoint
-             yt2=y2+hh*dydchi2  !y2 at midpoint
-             dyt1=yt2           !deriv y1 at mid
-             tmp=(ap1/rofChi(xh)**2 - nu2) 
-           
-             
-             dyt2=tmp*yt1       !deriv y2 at mid        
-             yt1=y1+hh*dyt1     !y1 at mid
-             yt2=y2+hh*dyt2     !y2 at mid
-            
-             dym1=yt2           !deriv y1 at mid
-             dym2=tmp*yt1       !deriv y2 at mid
-             yt1=y1+sgndelchi*dym1 !y1 at end
-             dym1=dyt1+dym1     
-             yt2=y2+sgndelchi*dym2 !y2 at end
-             dym2=dyt2+dym2
-          
-             chi=chi+sgndelchi     !end point
-             sh=rofChi(chi)    
-             dyt1=yt2           !deriv y1 at end
-             tmp=(ap1/sh**2 - nu2)
-             dyt2=tmp*yt1       !deriv y2 at end
-             y1=y1+h6*(dydchi1+dyt1+2._dl*dym1) !add up
-             y2=y2+h6*(dydchi2+dyt2+2._dl*dym2)
- 
-             ujl=y1/sh 
-             if ((isgn<0).and.(y1*y2<0._dl).or.((chi>chiDispTop).and.((chi>3.14).or.(y1*y2>0)))) then
-                 chi=0._dl
-                 exit   !exit because ujl now small
-                 end if
-             
-             if (Interpolate) then
- ! Interpolate the source
-             taui=aux2-aux1*chi
-             is=int(taui)
-             b=taui-is
-             if (b > 0.995) then 
-                !may save time, and prevents numerical error leading to access violation of zero index
-              is=is+1
-              source = sourcep(is,1:SourceNum)
-             
-              else
-              a=1._dl-b            
-              tmpa=(a**3-a)
-              tmpb=(b**3-b)
-              source = a*sourcep(is,1:SourceNum)+b*sourcep(is+1,1:SourceNum)+ &
-                    (tmpa*ddsourcep(is,1:SourceNum) +  tmpb*ddsourcep(is+1,1:SourceNum))*dtau2o6
- 
-              end if           
- 
-             else
-              source = sourcep(nstart - i*isgn,1:SourceNum)
-           
-             end if
-             out = out + source * ujl
-                   
-             if (((isgn<0).or.(chi>chiDispTop)).and.(abs(ujl) < minujl)) then
-             chi=0
-             exit  !break when getting  exponentially small in dissipative region
-             end if
-          end do
- 
-          out = (out - source * ujl /2)*delchi*CP%r
-        
-          end subroutine DoRangeIntTensor
- 
-         subroutine GetInitPowerArrayVec(pows,ks, numks,pix)
-          integer, intent(in) :: numks, pix
-          real(dl) pows(numks), ks(numks)
-          integer i
-       
-          do i = 1, numks
-          !!change to vec...
-             pows(i) =  ScalarPower(ks(i) ,pix)
-          end do
- 
-         end subroutine GetInitPowerArrayVec
- 
- 
-         subroutine GetInitPowerArrayTens(pows,ks, numks,pix)
-          integer, intent(in) :: numks, pix
-          real(dl) pows(numks), ks(numks)
-          integer i
-       
-          do i = 1, numks
-             pows(i) =  TensorPower(ks(i) ,pix)
-          end do
- 
-         end subroutine GetInitPowerArrayTens
- 
- 
-         subroutine CalcScalCls(CTrans)
-         implicit none
-         Type(ClTransferData) :: CTrans
-         integer pix,j
-         real(dl) apowers, pows(CTrans%q%npoints)
-         integer q_ix
-         real(dl)  ks(CTrans%q%npoints),dlnks(CTrans%q%npoints),dlnk
-         real(dl) ctnorm,dbletmp
- 
-          do pix=1,CP%InitPower%nn
- 
-           do q_ix = 1, CTrans%q%npoints 
- 
-              if (CP%flat) then
-                      ks(q_ix) = CTrans%q%points(q_ix)
-                      dlnks(q_ix) = CTrans%q%dpoints(q_ix)/CTrans%q%points(q_ix)
-              else
-                      ks(q_ix) = sqrt(CTrans%q%points(q_ix)**2 - CP%curv)
-                      dlnks(q_ix) = CTrans%q%dpoints(q_ix)*CTrans%q%points(q_ix)/ks(q_ix)**2
-              end if
- 
-              pows(q_ix) =  ScalarPower(ks(q_ix) ,pix)
- 
-       
-           end do
- 
- 
-         !$OMP PARAllEl DO DEFAUlT(SHARED),SCHEDUlE(STATIC,4) &
-         !$OMP & PRIVATE(j,q_ix,dlnk,apowers,ctnorm,dbletmp)
- 
-          do j=1,CTrans%ls%l0
- 
-         !Integrate dk/k Delta_l_q**2 * Power(k)
- 
-           do q_ix = 1, CTrans%q%npoints 
- 
-              if (.not.(CP%closed.and.nint(CTrans%q%points(q_ix)*CP%r)<=CTrans%ls%l(j))) then 
-                !cut off at nu = l + 1
-              dlnk = dlnks(q_ix)
-              apowers = pows(q_ix)
- 
-              iCl_scalar(j,C_Temp:C_E,pix) = iCl_scalar(j,C_Temp:C_E,pix) +  &
-                           apowers*CTrans%Delta_p_l_k(1:2,j,q_ix)**2*dlnk
-              iCl_scalar(j,C_Cross,pix) = iCl_scalar(j,C_Cross,pix) + &
-                           apowers*CTrans%Delta_p_l_k(1,j,q_ix)*CTrans%Delta_p_l_k(2,j,q_ix)*dlnk
-              if (CTrans%NumSources>2) then
-                         iCl_scalar(j,C_Phi,pix) = iCl_scalar(j,C_Phi,pix) +  &
-                                                        apowers*CTrans%Delta_p_l_k(3,j,q_ix)**2*dlnk
-                         iCl_scalar(j,C_PhiTemp,pix) = iCl_scalar(j,C_PhiTemp,pix) +  &
-                                           apowers*CTrans%Delta_p_l_k(3,j,q_ix)*CTrans%Delta_p_l_k(1,j,q_ix)*dlnk
-              end if
- 
-              end if
- 
-            end do
- 
- !Output l(l+1)C_l/OutputDenominator
- 
-            !ctnorm = (CTrans%ls%l+2)!/(CTrans%ls%l-2)! - beware of int overflow
-             ctnorm=(CTrans%ls%l(j)*CTrans%ls%l(j)-1)*real((CTrans%ls%l(j)+2)*CTrans%ls%l(j),dl)
-             dbletmp=(CTrans%ls%l(j)*(CTrans%ls%l(j)+1))/OutputDenominator*fourpi  
-                  
-             iCl_scalar(j,C_Temp,pix)  =  iCl_scalar(j,C_Temp,pix)*dbletmp
-             iCl_scalar(j,C_E,pix)     =  iCl_scalar(j,C_E,pix)*dbletmp*ctnorm
-             iCl_scalar(j,C_Cross,pix) =  iCl_scalar(j,C_Cross,pix)*dbletmp*sqrt(ctnorm)
-             if (CTrans%NumSources>2) then
-                      iCl_scalar(j,C_Phi,pix)   =  &
-                             iCl_scalar(j,C_Phi,pix)*fourpi*real(CTrans%ls%l(j)**2,dl)**2    
-                      !The lensing power spectrum computed is l^4 C_l^{\phi\phi}
-                      !We put pix extra factors of %l here to improve interpolation in CTrans%ls%l
-                      iCl_scalar(j,C_PhiTemp,pix)   =  &
-                             iCl_scalar(j,C_PhiTemp,pix)*fourpi*real(CTrans%ls%l(j)**2,dl)*CTrans%ls%l(j)
-                       !Cross-correlation is CTrans%ls%l^3 C_l^{\phi T}
-              end if
- 
-            end do
-          !$OMP END PARAllEl DO
- 
-           end do
- 
-         end subroutine CalcScalCls
- 
-      
-         subroutine CalcTensCls(CTrans, GetInitPowers)
-         implicit none
-         Type(ClTransferData) :: CTrans
-         external GetInitPowers       
-         integer in,j, q_ix
-         real(dl) nu
-         real(dl) apowert,  measure
-         real(dl) ctnorm,dbletmp
-         real(dl) pows(CTrans%q%npoints)
-         real(dl)  ks(CTrans%q%npoints),measures(CTrans%q%npoints)
- 
-         !For tensors we want Integral dnu/nu (nu^2-3)/(nu^2-1) Delta_l_k^2 P(k) for CP%closed
- 
-         do in=1,CP%InitPower%nn
-         
-          do q_ix = 1, CTrans%q%npoints 
- 
-              if (CP%flat) then
-                      ks(q_ix) = CTrans%q%points(q_ix)
-                      measures(q_ix) = CTrans%q%dpoints(q_ix)/CTrans%q%points(q_ix)
-              else
-                      nu = CTrans%q%points(q_ix)*CP%r
-                      ks(q_ix) = sqrt(CTrans%q%points(q_ix)**2 - 3*CP%curv)
-                      measures(q_ix) = CTrans%q%dpoints(q_ix)/CTrans%q%points(q_ix)*(nu**2-3*CP%Ksign)/(nu**2-CP%Ksign)
-              end if
- 
-           end do
- 
-          call GetInitPowers(pows,ks,CTrans%q%npoints,in)
- 
-         !$OMP PARAllEl DO DEFAUlT(SHARED),SCHEDUlE(STATIC,4) &
-         !$OMP & PRIVATE(j,q_ix,measure,apowert,ctnorm,dbletmp)
-          do j=1,CTrans%ls%l0
- 
-           do q_ix = 1, CTrans%q%npoints 
- 
-                  if (.not.(CP%closed.and. nint(CTrans%q%points(q_ix)*CP%r)<=CTrans%ls%l(j))) then
-                      !cut off at nu = l+1
- 
-                  apowert = pows(q_ix)
-                  measure = measures(q_ix)
-                
-                  iCl_tensor(j,CT_Temp:CT_B,in) = iCl_tensor(j,CT_Temp:CT_B,in) + &
-                       apowert*CTrans%Delta_p_l_k(CT_Temp:CT_B,j,q_ix)**2*measure
-                  
-                  iCl_tensor(j,CT_cross, in ) = iCl_tensor(j,CT_cross, in ) &
-                       +apowert*CTrans%Delta_p_l_k(CT_Temp,j,q_ix)*CTrans%Delta_p_l_k(CT_E,j,q_ix)*measure
-                  end if 
-            end do
- 
-             ctnorm=(CTrans%ls%l(j)*CTrans%ls%l(j)-1)*real((CTrans%ls%l(j)+2)*CTrans%ls%l(j),dl)
-             dbletmp=(CTrans%ls%l(j)*(CTrans%ls%l(j)+1))/OutputDenominator*pi/4
-             iCl_tensor(j, CT_Temp, in)   = iCl_tensor(j, CT_Temp, in)*dbletmp*ctnorm
-             if (CTrans%ls%l(j)==1) dbletmp=0
-             iCl_tensor(j, CT_E:CT_B, in) = iCl_tensor(j, CT_E:CT_B, in)*dbletmp
-             iCl_tensor(j, CT_Cross, in)  = iCl_tensor(j, CT_Cross, in)*dbletmp*sqrt(ctnorm)
- 
-          end do
- 
-          end do
-     
-         end subroutine CalcTensCls
- 
- 
-         subroutine CalcVecCls(CTrans, GetInitPowers)
-         implicit none
-         Type(ClTransferData) :: CTrans
-         external GetInitPowers       
-         integer in,j, q_ix
-         real(dl) power,  measure
-         real(dl) ctnorm,lfac,dbletmp
-         real(dl) pows(CTrans%q%npoints)
-         real(dl)  ks(CTrans%q%npoints),measures(CTrans%q%npoints)
- 
-         do in=1,CP%InitPower%nn
-         
-          do q_ix = 1, CTrans%q%npoints 
- 
-                ks(q_ix) = CTrans%q%points(q_ix)
-                measures(q_ix) = CTrans%q%dpoints(q_ix)/CTrans%q%points(q_ix)
- 
-           end do
- 
-          call GetInitPowers(pows,ks,CTrans%q%npoints,in)
- 
-         !$OMP PARAllEl DO DEFAUlT(SHARED),SCHEDUlE(STATIC,4) &
-         !$OMP & PRIVATE(j,q_ix,measure,power,ctnorm,dbletmp)
-          do j=1,CTrans%ls%l0
- 
-           do q_ix = 1, CTrans%q%npoints 
- 
-              if (.not.(CP%closed.and. nint(CTrans%q%points(q_ix)*CP%r)<=CTrans%ls%l(j))) then
-                      !cut off at nu = l+1
- 
-                  power = pows(q_ix)
-                  measure = measures(q_ix)
-                
-                  iCl_vector(j,CT_Temp:CT_B,in) = iCl_vector(j,CT_Temp:CT_B,in) + &
-                       power*CTrans%Delta_p_l_k(CT_Temp:CT_B,j,q_ix)**2*measure
-                  
-                  iCl_vector(j,CT_cross, in ) = iCl_vector(j,CT_cross, in ) &
-                       +power*CTrans%Delta_p_l_k(CT_Temp,j,q_ix)*CTrans%Delta_p_l_k(CT_E,j,q_ix)*measure
-              end if 
-           end do
- 
-             ctnorm=CTrans%ls%l(j)*(CTrans%ls%l(j)+1)
-             dbletmp=(CTrans%ls%l(j)*(CTrans%ls%l(j)+1))/OutputDenominator*pi/8
-             iCl_vector(j, CT_Temp, in)   = iCl_vector(j, CT_Temp, in)*dbletmp*ctnorm
-             lfac = (CTrans%ls%l(j) + 2)*(CTrans%ls%l(j) - 1)
-             iCl_vector(j, CT_E:CT_B, in) = iCl_vector(j, CT_E:CT_B, in)*dbletmp*lfac
-             iCl_vector(j, CT_Cross, in)  = iCl_vector(j, CT_Cross, in)*dbletmp*sqrt(lfac*ctnorm)
- 
-          end do
- 
-          end do
-     
-         end subroutine CalcVecCls
- 
- 
-     subroutine InterpolateCls(CTransS,CTransT,CTransV)
-       implicit none
-        Type(ClTransferData) :: CTransS, CTransT, CTransV
-       integer in,i
-   
- !Note using log interpolation is worse]
- 
-       !$OMP PARALLEL DO DEFAULT(SHARED), PRIVATE(i,in), SHARED(CTransS,CTransT),IF(CP%InitPower%nn > 1)
-       do in=1,CP%InitPower%nn
-          if (CP%WantScalars) then
-            do i = C_Temp, C_last
-              call InterpolateClArr(CTransS%ls,iCl_scalar(1,i,in),Cl_scalar(lmin, in, i), &
-                  CTransS%ls%l0)
-   
-            end do
-          end if
-       
-          if (CP%WantVectors) then
-            do i = C_Temp, CT_cross
-             call InterpolateClArr(CTransV%ls,iCl_vector(1,i,in),Cl_vector(lmin, in, i),CTransV%ls%l0)
-            end do
-          end if
-          
-          if (CP%WantTensors) then
-            do i = CT_Temp, CT_Cross
-              call InterpolateClArr(CTransT%ls,iCl_tensor(1,i,in),Cl_tensor(lmin, in, i), &
-                CTransT%ls%l0)
-  
-            end do
-          end if
-       end do
-       !$OMP END PARALLEL DO
-       end subroutine InterpolateCls
- 
- 
- end module CAMBmain
- 
-     
-      
- 
-     
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/constants.f90 cosmomc_sampler/camb/constants.f90
*** cosmomc/camb/constants.f90	2008-11-12 15:30:32.000000000 +0100
--- cosmomc_sampler/camb/constants.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,62 ****
- 
- 
-    module Precision
-       implicit none
- 
-       integer, parameter :: dl = KIND(1.d0)
-       integer, parameter :: sp = KIND(1.0)
-  
-    end module Precision
- 
- 
- 
-    module constants
-        use precision
-        implicit none
- 
-       
-        real(dl), parameter :: const_pi = 3.1415926535897932384626433832795_dl
-        real(dl), parameter :: const_twopi=2._dl*const_pi, const_fourpi=4._dl*const_pi
-        real(dl), parameter :: const_sqrt6=2.4494897427831780981972840747059_dl
- 
-        real(dl), parameter :: c = 2.99792458e8_dl
-        real(dl), parameter :: h_P = 6.62606896e-34_dl
-         
-        real(dl), parameter :: G=6.67428e-11_dl
-        real(dl), parameter :: sigma_thomson = 6.6524616e-29_dl
-        real(dl), parameter :: sigma_boltz = 5.6704e-8_dl  
-        real(dl), parameter :: k_B = 1.3806504e-23_dl 
- 
- 
-        real(dl), parameter :: m_p = 1.672621637e-27_dl  ! 1.672623e-27_dl
-        real(dl), parameter :: m_H = 1.673575e-27_dl !av. H atom
-        real(dl), parameter :: m_e = 9.10938215e-31_dl
-        real(dl), parameter :: mass_ratio_He_H = 3.9715_dl
-  
- 
-        real(dl), parameter :: Gyr=3.1556926e16_dl
-        real(dl), parameter :: Mpc = 3.085678e22_dl !seem to be different definitions of this?
-        real(dl), parameter :: MPC_in_sec = Mpc/c ! Mpc/c = 1.029272d14 in SI units      
- 
-        real(dl), parameter :: barssc0= k_B / m_p / c**2
-        real(dl), parameter :: kappa=8._dl*const_pi*G
-        real(dl), parameter :: a_rad = 8._dl*const_pi**5*k_B**4/15/c**3/h_p**3  
-                 !7.565914e-16_dl !radiation constant for u=aT^4
- 
- 
-        real(dl), parameter :: Compton_CT = MPC_in_sec*(8.d0/3.d0)*(sigma_thomson/(m_e*c))*a_rad
-         !Compton_CT is CT in Mpc units, (8./3.)*(sigma_T/(m_e*C))*a_R in Mpc
-         !Used to get evolution of matter temperature 
-         
-        !For 21cm
-        real(dl), parameter :: f_21cm = 1420.40575e6_dl, l_21cm= c/f_21cm, T_21cm = h_P*f_21cm/k_B
-        real(dl), parameter :: A10 = 2.869e-15, B10 = l_21cm**3/2/h_P/c*A10
- 
-        real(dl), parameter :: line21_const = 3*l_21cm**2*C*h_P/32/const_pi/k_B*A10 * Mpc_in_sec * 1000
-         !1000 to get in MiliKelvin
- 
- 
-    end module constants
- 
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/equations.f90 cosmomc_sampler/camb/equations.f90
*** cosmomc/camb/equations.f90	2008-09-11 11:26:08.000000000 +0200
--- cosmomc_sampler/camb/equations.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,2629 ****
- ! Equations module for dark energy with constant equation of state parameter w
- ! allowing for perturbations based on a quintessence model
- ! by Antony Lewis (http://cosmologist.info/)
- ! This version November 2006.
- 
- ! Dec 2003, fixed (fatal) bug in tensor neutrino setup
- ! Changes to tight coupling approximation
- ! June 2004, fixed problem with large scale polarized tensors; support for vector modes
- ! Generate vector modes on their own. The power spectrum is taken from the scalar parameters.
- ! August 2004, fixed reionization term in lensing potential
- ! Nov 2004, change massive neutrino l_max to be consistent with massless if light
- ! Apr 2005, added DoLateRadTruncation option
- ! June 2006, added support for arbitary neutrino mass splittings
- ! Nov 2006, tweak to high_precision transfer function accuracy at lowish k
- 
-        module LambdaGeneral
-          use precision
-          implicit none
-           
-          real(dl)  :: w_lam = -1 !p/rho for the dark energy (assumed constant) 
-          real(dl) :: cs2_lam = 1_dl 
-           !comoving sound speed. Always exactly 1 for quintessence 
-           !(otherwise assumed constant, though this is almost certainly unrealistic)
- 
-          logical :: w_perturb = .true.
- 
-        end module LambdaGeneral
- 
- 
-     
- !Return OmegaK - modify this if you add extra fluid components
-         function GetOmegak()
-         use precision
-         use ModelParams
-         real(dl)  GetOmegak
-          GetOmegak = 1 - (CP%omegab+CP%omegac+CP%omegav+CP%omegan) 
-           
-         end function GetOmegak
-   
-   
-        subroutine init_background
-          !This is only called once per model, and is a good point to do any extra initialization.
-          !It is called before first call to dtauda, but after
-          !massive neutrinos are initialized and after GetOmegak
-        end  subroutine init_background
- 
- 
- !Background evolution
-         function dtauda(a)
-          !get d tau / d a
-         use precision
-         use ModelParams
-         use MassiveNu
-         use LambdaGeneral
-         implicit none
-         real(dl) dtauda
-         real(dl), intent(IN) :: a
-         real(dl) rhonu,grhoa2, a2
-         integer nu_i
- 
-         a2=a**2
- 
- !  8*pi*G*rho*a**4.
-         grhoa2=grhok*a2+(grhoc+grhob)*a+grhog+grhornomass
-          if (w_lam == -1._dl) then
-            grhoa2=grhoa2+grhov*a2**2
-          else
-            grhoa2=grhoa2+grhov*a**(1-3*w_lam)
-          end if
-         if (CP%Num_Nu_massive /= 0) then
- !Get massive neutrino density relative to massless
-            do nu_i = 1, CP%nu_mass_eigenstates
-             call Nu_rho(a*nu_masses(nu_i),rhonu)
-             grhoa2=grhoa2+rhonu*grhormass(nu_i)
-            end do
-         end if
- 
-         dtauda=sqrt(3/grhoa2)
-      
-         end function dtauda
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
- !Gauge-dependent perturbation equations
- 
-         module GaugeInterface
-         use precision
-         use ModelParams
-         use MassiveNu
-         use LambdaGeneral
-         implicit none
-         public
- 
-         !Description of this file. Change if you make modifications.
-         character(LEN=*), parameter :: Eqns_name = 'gauge_inv'
- 
-         logical :: DoTensorNeutrinos = .false.
-         
-         logical :: DoLateRadTruncation = .true.
-             !if true, use approx to radition perturbations after matter domination on
-             !small scales, saving evolution of irrelevant osciallatory multipole equations
- 
-         real(dl) :: Magnetic = 0._dl
-             !Vector mode anisotropic stress in units of rho_gamma
-         real(dl) :: vec_sig0 = 1._dl
-             !Vector mode shear      
-         integer, parameter :: max_l_evolve = 1024 !Maximum l we are ever likely to propagate
- 
-         !Supported scalar initial condition flags
-          integer, parameter :: initial_adiabatic=1, initial_iso_CDM=2, &
-          initial_iso_baryon=3,  initial_iso_neutrino=4, initial_iso_neutrino_vel=5, initial_vector = 0
-          integer, parameter :: initial_nummodes =  initial_iso_neutrino_vel
- 
-         type EvolutionVars
-             real(dl) q, q2
-             real(dl) k_buf,k2_buf ! set in initial
- 
-             integer w_ix !Index of two quintessence equations
- 
-             integer q_ix !index into q_evolve array that gives the value q
-             logical TransferOnly
- 
-     !       nvar  - number of scalar (tensor) equations for this k       
-             integer nvar,nvart, nvarv
- 
-            !Max_l for the various hierarchies
-             integer lmaxg,lmaxnr,lmaxnu,lmaxgpol,MaxlNeeded
-             integer lmaxnrt, lmaxnut, lmaxt, lmaxpolt
-             integer lmaxnrv, lmaxv, lmaxpolv
- 
-             integer polind  !index into scalar array of polarization hierarchy
- 
-     !array indices for massive neutrino equations
-             integer iq0,iq1,iq2
- 
-     !array index for tensor massive neutrino equations
-             integer iqt
-  
-     !Initial values for massive neutrino v*3 variables calculated when switching 
-     !to non-relativistic approx
-             real(dl) G11(max_nu),G30(max_nu)
-             real(dl) w_nu !equation of state parameter for massive neutrinos
-     !True when using non-relativistic approximation
-             logical MassiveNuApprox
- 
-     !Massive neutrino scheme being used at the moment        
-             integer NuMethod
- 
-     !Tru when using tight-coupling approximation (required for stability at early times)
- 
-             logical TightCoupling
-   
-     !Numer of scalar equations we are propagating
-             integer ScalEqsToPropagate
-     !beta > l for closed models 
-             integer FirstZerolForBeta
-     !Tensor vars
-             real(dl) tenspigdot, aux_buf
- 
-             real(dl) pig !For tight coupling
- 
-             real(dl) poltruncfac
-         
-             logical no_rad_multpoles 
- 
-     !Buffers for non-flat vars
-             real(dl) Kf(max_l_evolve),Kft(max_l_evolve)      
- 
-         end type EvolutionVars
- 
- !precalculated arrays
-         real(dl) polfac(max_l_evolve),tensfac(max_l_evolve),tensfacpol(max_l_evolve), &
-                denl(max_l_evolve),vecfac(max_l_evolve),vecfacpol(max_l_evolve) 
-         
-        real(dl), parameter :: ep0=1.0d-2 
- 
-        real(dl) epsw
-     
-        integer debug
- 
-        contains
- 
- 
-         subroutine GaugeInterface_ScalEv(EV,y,tau,tauend,tol1,ind,c,w)
-          type(EvolutionVars) EV
-          real(dl) c(24),w(EV%nvar,9), y(EV%nvar), tol1, tau, tauend
-          integer ind
- 
-           if (CP%flat) then
-             call dverk(EV,EV%ScalEqsToPropagate,fderivs,tau,y,tauend,tol1,ind,c,EV%nvar,w)
-           else
-             call dverk(EV,EV%ScalEqsToPropagate,derivs,tau,y,tauend,tol1,ind,c,EV%nvar,w)
-           end if
-         end subroutine GaugeInterface_ScalEv
- 
-          subroutine GaugeInterface_EvolveScal(EV,tau,y,tauend,tol1,ind,c,w)
-          use ThermoData
-          type(EvolutionVars) EV
-          real(dl) c(24),w(EV%nvar,9), y(EV%nvar), tol1, tau, tauend
-          integer ind
-          real(dl) ep, tau_switch, tau_check
-          real(dl) cs2, opacity
- 
-          !Evolve equations from tau to tauend, performing switch-off of
-          !tight coupling if necessary.
-          !In principle the tight coupling evolution routine could be different
-          !which could probably be used to improve the speed a bit
-          
-          !It's possible due to instabilities that changing later is actually more
-          !accurate, so cannot expect accuracy to vary monotonically with the switch
- 
-          if (EV%TightCoupling) then
-     
-              tau_switch = tight_tau !when 1/(opacity*tau) = 0.01ish
-     
-             !The numbers here are a bit of guesswork
-             !The high k increase saves time for very small loss of accuracy
-             !The lower k ones are more delicate. Nead to avoid instabilities at same time
-             !as ensuring tight coupling is accurate enough
-              if (EV%k_buf > epsw) then
-                if (EV%k_buf > epsw*5) then
-                 ep=ep0*5/AccuracyBoost
-                else
-                 ep=ep0
-                end if
-              else
-                ep=ep0 
-              end if
- 
-             !Check the k/opacity criterion
-              tau_check = min(tauend, tau_switch)   
-              call thermo(tau_check,cs2,opacity)
-              if (EV%k_buf/opacity > ep) then
-                 !so need to switch in this time interval
-                  tau_switch = Thermo_OpacityToTime(EV%k_buf/ep) 
-              end if
- 
-              if (tauend > tau_switch) then 
-            
-                  if (tau_switch > tau) then
-                   call GaugeInterface_ScalEv(EV, y, tau,tau_switch,tol1,ind,c,w)
-                  end if
-             
-                !Set up variables with their tight coupling values
-                  y(8) = EV%pig
-                  y(9) = 3./7*y(8)*EV%k_buf/opacity
-                  y(EV%polind+2) = EV%pig/4   
-                  y(EV%polind+3) =y(9)/4      
- 
-                  EV%TightCoupling = .false.
- 
-             end if
-          end if
- 
-          !Turn off radiation hierarchies at late time where slow and 
-          !not needed. Must be matter domainted and well inside the horizon
-          !Not tested for non-adiabatic         
-          tau_switch=max(15/EV%k_buf,matter_verydom_tau)
-          if (.not. EV%no_rad_multpoles .and. tauend > tau_switch .and. DoLateRadTruncation &
-            .and. (.not.CP%WantCls .or. EV%k_buf>0.02*AccuracyBoost) &
-             .and. (CP%Scalar_initial_condition==initial_adiabatic .or. &
-                CP%Scalar_initial_condition==initial_vector .and. &
-                  all(CP%InitialConditionVector(2:initial_nummodes) ==0))) then
- 
-                  if (tau_switch > tau) then
-                   call GaugeInterface_ScalEv(EV, y, tau,tau_switch,tol1,ind,c,w)
-                  end if
-                  EV%no_rad_multpoles = .true.
-                  y(6:EV%polind+EV%lmaxgpol)=0
-                 if (CP%Num_Nu_massive == 0) then
-                  EV%ScalEqsToPropagate=5
-                  if (w_lam /= -1 .and. w_Perturb) then
-                   !actually DE perturbations probably irrelvant and could set to zero too
-                     y(6)=y(EV%w_ix)
-                     y(7)=y(EV%w_ix+1)
-                     EV%w_ix = 6
-                     EV%ScalEqsToPropagate=7                    
-                  end if
-                 end if
-                   
-          end if       
-          
-          call GaugeInterface_ScalEv(EV,y,tau,tauend,tol1,ind,c,w)
-         
-         end subroutine GaugeInterface_EvolveScal
- 
-  
-         subroutine GaugeInterface_Init
-           !Precompute various arrays and other things independent of wavenumber
-           integer j
- 
-           epsw = 100/CP%tau0
-          
-           if (CP%WantScalars) then
-             do j=2,max_l_evolve
-               polfac(j)=real((j+3)*(j-1),dl)/(j+1)
-             end do               
-           end if
-       
-           if (CP%WantVectors) then
-             do j=2,max_l_evolve
-              vecfac(j)=real((j+2),dl)/(j+1)
-              vecfacpol(j)=real((j+3)*j,dl)*(j-1)*vecfac(j)/(j+1)**2
-            end do
-    
-           end if
- 
-           if (CP%WantTensors) then
-            do j=2,max_l_evolve
-            tensfac(j)=real((j+3)*(j-1),dl)/(j+1)
-            tensfacpol(j)=tensfac(j)**2/(j+1)
-           end do
-           end if
- 
-          do j=1,max_l_evolve
-            denl(j)=1._dl/(2*j+1)
-          end do     
-        
-         end subroutine GaugeInterface_Init
- 
- 
-         subroutine GetNumEqns(EV)
-           use MassiveNu
-           !Set the numer of equations in each hierarchy, and get total number of equations for this k
-           type(EvolutionVars) EV
-           real(dl) scal
-         
-          if (CP%Num_Nu_massive == 0) then
-             EV%lmaxnu=0
-          else 
-              EV%NuMethod = CP%MassiveNuMethod
-              if (EV%NuMethod == Nu_Best) then
-               if (all(nu_masses(1:CP%Nu_mass_eigenstates) < 1800._dl/AccuracyBoost) .and. &
-                   .not. CP%WantTransfer .and. .not. CP%DoLensing) then
-                 !If light then approx is very good for CMB
-                 EV%NuMethod = Nu_approx
-                else
-                 EV%NuMethod = Nu_Trunc
-                end if
-              end if
-             !l_max for massive neutrinos
-             !if relativistic at recombination set to massless lmaxnr below
-              EV%lmaxnu=max(3,nint(6*lAccuracyBoost))   
-             if (CP%Transfer%high_precision) EV%lmaxnu=nint(25*lAccuracyBoost)
-          end if
- 
-         if (CP%WantScalars) then
-          EV%lmaxg  = max(nint(8*lAccuracyBoost),3)  
-          EV%lmaxnr = max(nint(14*lAccuracyBoost),3)  
-             !need quite high to avoid ~ 0.5% systematics at l>1000
-          EV%lmaxgpol = EV%lmaxg  
-          if (.not.CP%AccuratePolarization) EV%lmaxgpol=max(nint(4*lAccuracyBoost),3)
-      
-          if (EV%q < 0.05) then
-             !Large scales need fewer equations
-             scal  = 1
-             if (CP%AccuratePolarization) scal = 4  !But need more to get polarization right
-             EV%lmaxgpol=max(3,nint(min(8,nint(scal* 150* EV%q))*lAccuracyBoost))
-             EV%lmaxnr=max(3,nint(min(7,nint(sqrt(scal)* 150 * EV%q))*lAccuracyBoost))
-             EV%lmaxg=max(3,nint(min(8,nint(sqrt(scal) *300 * EV%q))*lAccuracyBoost)) 
-             if (CP%AccurateReionization) then
-              EV%lmaxg=EV%lmaxg*4
-              EV%lmaxgpol=EV%lmaxgpol*2
-             end if
-          end if                  
-          if (CP%Transfer%high_precision) then
-            EV%lmaxnr=max(nint(25*lAccuracyBoost),3) 
-            EV%lmaxg=max(EV%lmaxg,nint(min(8,nint(600 * EV%q))*lAccuracyBoost)) 
-          end if
-          EV%nvar=5+ (EV%lmaxg+1) + EV%lmaxgpol-1 +(EV%lmaxnr+1) 
-          if (w_lam /= -1 .and. w_Perturb) then
-             EV%w_ix = EV%nvar+1
-             EV%nvar=EV%nvar+2 
-          else
-             EV%w_ix=0
-          end if
- 
-          if (CP%Num_Nu_massive /= 0) then
-            if (any(nu_masses(1:CP%Nu_mass_eigenstates) < 7000)) then              
-                EV%lmaxnu=EV%lmaxnr 
-            end if
-  
-            if (EV%NuMethod == Nu_approx) then
-               EV%iq0=EV%nvar + 1 
-               EV%nvar= EV%nvar+(EV%lmaxnu+1)*CP%Nu_mass_eigenstates
-            else
-             EV%iq0=EV%nvar + 1 
-             EV%iq1=EV%iq0+nqmax
-             EV%iq2=EV%iq1+nqmax
-             EV%nvar=EV%nvar+ nqmax*(EV%lmaxnu+1)*CP%Nu_mass_eigenstates
-            endif
-          end if
-         
-          EV%MaxlNeeded=max(EV%lmaxg,EV%lmaxnr,EV%lmaxgpol,EV%lmaxnu)
-          if (EV%MaxlNeeded > max_l_evolve) stop 'Need to increase max_l_evolve'
-         
-          EV%poltruncfac=real(EV%lmaxgpol,dl)/(EV%lmaxgpol-2)
-          EV%polind = 6+EV%lmaxnr+EV%lmaxg
-          EV%lmaxt=0
-          
-         else
-           EV%nvar=0
-         end if
-     
-        if (CP%WantTensors) then
-           EV%lmaxt=max(3,nint(8*lAccuracyBoost))
-           EV%lmaxpolt = max(3,nint(5*lAccuracyBoost)) 
-           if (EV%q < 0.05) then
-             if (.not. CP%AccuratePolarization) then
-              scal  = 1
-              EV%lmaxt=max(3,nint(min(8,nint(scal *150 * EV%q))*lAccuracyBoost))
-              EV%lmaxpolt=max(3,nint(min(5,nint( scal*150 * EV%q))*lAccuracyBoost))
-             end if
-           end if      
-           EV%nvart=(EV%lmaxt-1)+(EV%lmaxpolt-1)*2+3
-           if (DoTensorNeutrinos) then
-            
-             EV%lmaxnrt=nint(6*lAccuracyBoost)
-             EV%lmaxnut=EV%lmaxnrt
-             EV%nvart=EV%nvart+EV%lmaxnrt-1
-              if (CP%Num_Nu_massive /= 0 ) then
-                  EV%iqt=EV%nvart + 1                  
-                  EV%nvart=EV%nvart+ nqmax*(EV%lmaxnut-1)*CP%Nu_mass_eigenstates         
-               end if 
-           end if
-         else
-           EV%nvart=0
-         end if       
- 
- 
-        if (CP%WantVectors) then
-           EV%lmaxv=max(10,nint(8*lAccuracyBoost))
-           EV%lmaxpolv = max(5,nint(5*lAccuracyBoost)) 
-           
-            EV%nvarv=(EV%lmaxv)+(EV%lmaxpolv-1)*2+3
-           
-            EV%lmaxnrv=nint(30*lAccuracyBoost)
-   
-            EV%nvarv=EV%nvarv+EV%lmaxnrv
-            if (CP%Num_Nu_massive /= 0 ) then
-                   stop 'massive neutrinos not supported for vector modes'
-            end if 
-         else
-           EV%nvarv=0
-         end if       
- 
-         end subroutine GetNumEqns
- 
- !cccccccccccccccccccccccccccccccccc
-         subroutine SwitchToMassiveNuApprox(EV,y)
- !When the neutrinos are no longer highly relativistic we use a truncated
- !energy-integrated hierarchy going up to third order in velocity dispersion
-            type(EvolutionVars) EV
- 
-         real(dl) a,a2,pnu,clxnu,dpnu,pinu,rhonu
-         real(dl) shearnu, qnu
-         real(dl) y(EV%nvar)
-         integer nu_i, off_ix, qoff_ix
-    
-         a=y(1)
-         a2=a*a
- 
-         do nu_i = 1, CP%Nu_mass_eigenstates
-           
- 
-            off_ix = (nu_i-1)*4
-            qoff_ix = (nu_i-1)*nqmax*(EV%lmaxnu+1)
- 
-            !Get density and pressure as ratio to massles by interpolation from table
-            call Nu_background(a*nu_masses(nu_i),rhonu,pnu)
-            !Integrate over q
- 
-            call Nu_Integrate(a*nu_masses(nu_i),clxnu,qnu,dpnu,shearnu, &
-                  y(EV%iq0+qoff_ix),y(EV%iq1+qoff_ix),y(EV%iq2+qoff_ix))
-             !clxnu_here  = rhonu*clxnu, qnu_here = qnu*rhonu
-             !Could save time by only calculating shearnu in output
-            dpnu=dpnu/rhonu
-            qnu=qnu/rhonu
-            clxnu = clxnu/rhonu
-            pinu=1.5_dl*shearnu/rhonu                     
-     
-  
-            EV%MassiveNuApprox=.true.
-         
-            y(EV%iq0+off_ix)=clxnu
-            y(EV%iq0+off_ix+1)=dpnu
-            y(EV%iq0+off_ix+2)=qnu
-            y(EV%iq0+off_ix+3)=pinu
- 
-            call Nu_Intvsq(a*nu_masses(nu_i),EV%G11(nu_i),EV%G30(nu_i),y(EV%iq1+qoff_ix),y(EV%iq0+qoff_ix+3*nqmax))
- !Analytic solution for higher moments, proportional to a^{-3}
-            EV%G11(nu_i)=EV%G11(nu_i)*a2*a/rhonu  
-            EV%G30(nu_i)=EV%G30(nu_i)*a2*a/rhonu  
- 
-          end do
-         
-           EV%ScalEqsToPropagate=(EV%iq0-1)+4*CP%Nu_mass_eigenstates
- 
-         end  subroutine SwitchToMassiveNuApprox
- 
-        subroutine MassiveNuVarsOut(EV,y,yprime,a,grho,gpres,dgrho,dgq,dgpi, gdpi_diff,pidot_sum)
-         implicit none
-         type(EvolutionVars) EV
-         real(dl) :: y(EV%nvar), yprime(EV%nvar),a, grho,gpres,dgrho,dgq,dgpi, gdpi_diff,pidot_sum
-           !grho = a^2 kappa rho
-           !gpres = a^2 kappa p
-           !dgrho = a^2 kappa \delta\rho
-           !dgp =  a^2 kappa \delta p
-           !dgq = a^2 kappa q (heat flux)
-           !dgpi = a^2 kappa pi (anisotropic stress) 
-           !dgpi_diff = a^2 kappa (3*p -rho)*pi
- 
-         integer nu_i, off_ix
-         real(dl) pinudot,grhormass_t, rhonu, pnu, shearnu, rhonudot
-         real(dl) shearnudot, adotoa, grhonu_t,gpnu_t
-         real(dl) clxnu, qnu, pinu, dpnu
-         real(dl) dtauda
- 
-          EV%w_nu = 0
-          do nu_i = 1, CP%Nu_mass_eigenstates
- 
-            grhormass_t=grhormass(nu_i)/a**2
- 
-            !Get density and pressure as ratio to massless by interpolation from table
-            call Nu_background(a*nu_masses(nu_i),rhonu,pnu)
-            
-            if (EV%NuMethod == Nu_approx) then
- 
-              off_ix = EV%iq0+(nu_i-1)*(EV%lmaxnu+1)
-              clxnu=y(off_ix)
-              qnu=y(off_ix+1)
-              pinu=y(off_ix+2)
-              pinudot=yprime(off_ix+2)
-     
-            else
-            
- 
-            if (EV%MassiveNuApprox) then    
-               off_ix = (nu_i-1)*4
-               clxnu=y(EV%iq0+off_ix)
-               !dpnu = y(EV%iq0+1+off_ix)
-               qnu=y(EV%iq0+off_ix+2)
-               pinu=y(EV%iq0+off_ix+3)
-               pinudot=yprime(EV%iq0+off_ix+3)
-         
-            else
-             off_ix = (nu_i-1)*nqmax*(EV%lmaxnu+1) 
-             !Integrate over q
- 
-             call Nu_Integrate(a*nu_masses(nu_i),clxnu,qnu,dpnu,shearnu, &
-                   y(EV%iq0+off_ix),y(EV%iq1+off_ix),y(EV%iq2+off_ix))
-             !clxnu_here  = rhonu*clxnu, qnu_here = qnu*rhonu
-             !dpnu=dpnu/rhonu
-             qnu=qnu/rhonu
-             clxnu = clxnu/rhonu
-             pinu=1.5_dl*shearnu/rhonu       
-             adotoa = 1/(a*dtauda(a))
-             call Nu_derivs(a*nu_masses(nu_i),adotoa,rhonu,rhonudot,shearnudot, &
-                                 y(EV%iq2+off_ix),yprime(EV%iq2+off_ix))
-             pinudot=1.5_dl*shearnudot/rhonu - rhonudot/rhonu*pinu    
-            endif
-           end if
- 
-           grhonu_t=grhormass_t*rhonu
-           gpnu_t=grhormass_t*pnu
-           
-           grho = grho  + grhonu_t
-           gpres= gpres + gpnu_t
- 
-           EV%w_nu = max(EV%w_nu,pnu/rhonu)
- 
-           dgrho= dgrho + grhonu_t*clxnu
-           dgq  = dgq   + grhonu_t*qnu
-           dgpi = dgpi  + grhonu_t*pinu
-           gdpi_diff = gdpi_diff + pinu*(3*gpnu_t-grhonu_t)
-           pidot_sum = pidot_sum + grhonu_t*pinudot
- 
-         end do
- 
-      end subroutine MassiveNuVarsOut
- 
-            
-      subroutine MassiveNuVars(EV,y,a,grho,gpres,dgrho,dgq, wnu_arr)
-         implicit none
-         type(EvolutionVars) EV
-         real(dl) :: y(EV%nvar), a, grho,gpres,dgrho,dgq
-         real(dl), intent(out), optional :: wnu_arr(max_nu)
-           !grho = a^2 kappa rho
-           !gpres = a^2 kappa p
-           !dgrho = a^2 kappa \delta\rho
-           !dgp =  a^2 kappa \delta p
-           !dgq = a^2 kappa q (heat flux)
-         integer nu_i, off_ix
-         real(dl) grhormass_t, rhonu, qnu, clxnu, grhonu_t, gpnu_t, pnu
- 
-          do nu_i = 1, CP%Nu_mass_eigenstates
- 
-           grhormass_t=grhormass(nu_i)/a**2
- 
-           !Get density and pressure as ratio to massless by interpolation from table
-           call Nu_background(a*nu_masses(nu_i),rhonu,pnu)
-  
-           if (EV%NuMethod == Nu_approx) then
-              off_ix = EV%iq0+(nu_i-1)*(EV%lmaxnu+1)
-              clxnu=y(off_ix)
-              qnu=y(off_ix+1)
-           else
- 
-            if (EV%MassiveNuApprox) then    
-               off_ix = (nu_i-1)*4
-               clxnu=y(EV%iq0+off_ix)
-               qnu=y(EV%iq0+off_ix+2)
-            else
-             off_ix = (nu_i-1)*nqmax*(EV%lmaxnu+1) 
-             !Integrate over q
-             call Nu_Integrate01(a*nu_masses(nu_i),clxnu,qnu,y(EV%iq0+off_ix),y(EV%iq1+off_ix))
-             !clxnu_here  = rhonu*clxnu, qnu_here = qnu*rhonu
-             qnu=qnu/rhonu
-             clxnu = clxnu/rhonu
-            endif
- 
-           end if
- 
-           grhonu_t=grhormass_t*rhonu
-           gpnu_t=grhormass_t*pnu
-           
-           grho = grho  + grhonu_t
-           gpres= gpres + gpnu_t
-           dgrho= dgrho + grhonu_t*clxnu
-           dgq  = dgq   + grhonu_t*qnu
- 
-           if (present(wnu_arr)) then
-            wnu_arr(nu_i) =pnu/rhonu
-           end if
- 
-         end do
- 
-      end subroutine MassiveNuVars
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine output(EV,y, n,j,tau,sources)
-         use ThermoData
-         use lvalues
-         use ModelData 
-         implicit none
-         integer n,j
-         type(EvolutionVars) EV
-         real(dl), target :: y(EV%nvar),yprime(EV%nvar)
-         real(dl), dimension(:),pointer :: ypol,ypolprime
-         
-         real(dl) dgq,grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,sigma,polter
-         real(dl) qgdot,pigdot,pirdot,vbdot,dgrho
-         real(dl) a,a2,z,clxc,clxb,vb,clxg,qg,pig,clxr,qr,pir
- 
-         real(dl) tau,x,divfac
-         real(dl) dgpi_diff, pidot_sum
-           !dgpi_diff = sum (3*p_nu -rho_nu)*pi_nu
- 
-         real(dl) k,k2  ,adotoa, grho, gpres,etak,phi,dgpi
-         real(dl) clxq, vq, diff_rhopi
-         real(dl) sources(CTransScal%NumSources)
-         real(dl) ISW
-         
-         yprime = 0
-         if (CP%flat) then
-             call fderivs(EV,EV%ScalEqsToPropagate,tau,y,yprime)
-         else
-             call derivs(EV,EV%ScalEqsToPropagate,tau,y,yprime)        
-         end if
-         
-         ypolprime => yprime(EV%polind+1:)
-         ypol => y(EV%polind+1:)
- 
-         k=EV%k_buf
-         k2=EV%k2_buf
-      
-         a   =y(1)
-         a2  =a*a
-         etak=y(2)
-         clxc=y(3)
-         clxb=y(4)
-         vb  =y(5)
-         vbdot =yprime(5)
- 
- !  Compute expansion rate from: grho 8*pi*rho*a**2
- 
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         grhov_t=grhov*a**(-1-3*w_lam)
-     
-         if (EV%no_rad_multpoles) then
-             clxg=2*(grhoc_t*clxc+grhob_t*clxb)/3/k**2
-             clxr=clxg
-             qg= clxg*k/sqrt((grhoc_t+grhob_t)/3)*(2/3._dl)
-             qr=qg
-             pig=0
-             pir=0
-             pigdot=0
-             pirdot=0
-             qgdot=k/3*clxg
-         else
-             if (EV%TightCoupling) then
-              y(8) = EV%pig
-              ypol(2) = EV%pig/4
-             end if 
-             clxg=y(6)
-             qg  =y(7)
-             pig =y(8)
-             clxr=y(7+EV%lmaxg)
-             qr  =y(8+EV%lmaxg)
-             pir =y(9+EV%lmaxg)
-             pigdot=yprime(8)
-             pirdot=yprime(EV%lmaxg+9)
-             qgdot =yprime(7)
-  
-         end if
- 
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
-         gpres=(grhog_t+grhor_t)/3+grhov_t*w_lam
- 
- !  8*pi*a*a*SUM[rho_i*clx_i]
-         dgrho=grhob_t*clxb+grhoc_t*clxc + grhog_t*clxg+grhor_t*clxr
- 
- !  8*pi*a*a*SUM[(rho_i+p_i)*v_i]
-         dgq=grhob_t*vb+grhog_t*qg+grhor_t*qr
- 
-         dgpi = grhor_t*pir + grhog_t*pig
- 
-         dgpi_diff = 0
-         pidot_sum = 0
- 
-         if (CP%Num_Nu_Massive /= 0) then
-          call MassiveNuVarsOut(EV,y,yprime,a,grho,gpres,dgrho,dgq,dgpi, dgpi_diff,pidot_sum)
-         end if
- 
-         adotoa=sqrt((grho+grhok)/3)
- 
-         if (w_lam /= -1 .and. w_Perturb) then
-           
-            clxq=y(EV%w_ix)
-            vq=y(EV%w_ix+1) 
-            dgrho=dgrho + clxq*grhov_t
-            dgq = dgq + vq*grhov_t*(1+w_lam)
-          
-         end if
- 
- !  Get sigma (shear) and z from the constraints
- !  have to get z from eta for numerical stability       
-         z=(0.5_dl*dgrho/k + etak)/adotoa 
-         sigma=(z+1.5_dl*dgq/k2)/EV%Kf(1)
-          
- 
-         polter = 0.1_dl*pig+9._dl/15._dl*ypol(2)
- 
-         if (CP%flat) then
-         x=k*(CP%tau0-tau)
-         divfac=x*x    
-         else   
-         x=(CP%tau0-tau)/CP%r
-         divfac=(CP%r*rofChi(x))**2*k2 
-         end if
- 
- 
-         if (EV%TightCoupling) then
-           pigdot = -dopac(j)/opac(j)*pig + 32._dl/45*k/opac(j)*(-2*adotoa*sigma  &
-                  +etak/EV%Kf(1)-  dgpi/k +vbdot )
-           ypolprime(2)= pigdot/4
-         end if
- 
-         pidot_sum =  pidot_sum + grhog_t*pigdot + grhor_t*pirdot
-         diff_rhopi = pidot_sum - (4*dgpi+ dgpi_diff )*adotoa
- 
- !Maple's fortran output - see scal_eqs.map
- !2phi' term (\phi' + \psi' in Newtonian gauge)
-         ISW = (4.D0/3.D0*k*EV%Kf(1)*sigma+(-2.D0/3.D0*sigma-2.D0/3.D0*etak/adotoa)*k &
-               -diff_rhopi/k**2-1.D0/adotoa*dgrho/3.D0+(3.D0*gpres+5.D0*grho)*sigma/k/3.D0 &
-               -2.D0/k*adotoa/EV%Kf(1)*etak)*expmmu(j)
- 
- !The rest
-         sources(1)= ISW +  ((-9.D0/160.D0*pig-27.D0/80.D0*ypol(2))/k**2*opac(j)+(11.D0/10.D0*sigma- &
-     3.D0/8.D0*EV%Kf(2)*ypol(3)+vb-9.D0/80.D0*EV%Kf(2)*y(9)+3.D0/40.D0*qg)/k-(- &
-     180.D0*ypolprime(2)-30.D0*pigdot)/k**2/160.D0)*dvis(j)+(-(9.D0*pigdot+ &
-     54.D0*ypolprime(2))/k**2*opac(j)/160.D0+pig/16.D0+clxg/4.D0+3.D0/8.D0*ypol(2)+(- &
-     21.D0/5.D0*adotoa*sigma-3.D0/8.D0*EV%Kf(2)*ypolprime(3)+vbdot+3.D0/40.D0*qgdot- &
-     9.D0/80.D0*EV%Kf(2)*yprime(9))/k+(-9.D0/160.D0*dopac(j)*pig-21.D0/10.D0*dgpi-27.D0/ &
-     80.D0*dopac(j)*ypol(2))/k**2)*vis(j)+(3.D0/16.D0*ddvis(j)*pig+9.D0/ &
-     8.D0*ddvis(j)*ypol(2))/k**2+21.D0/10.D0/k/EV%Kf(1)*vis(j)*etak   
- 
- 
- !Equivalent result
- !    t4 = 1.D0/adotoa
- !    t92 = k**2
- !   sources(1) = (4.D0/3.D0*EV%Kf(1)*expmmu(j)*sigma+2.D0/3.D0*(-sigma-t4*etak)*expmmu(j))*k+ &
- !       (3.D0/8.D0*ypol(2)+pig/16.D0+clxg/4.D0)*vis(j)
- !    sources(1) = sources(1)-t4*expmmu(j)*dgrho/3.D0+((11.D0/10.D0*sigma- &
- !         3.D0/8.D0*EV%Kf(2)*ypol(3)+vb+ 3.D0/40.D0*qg-9.D0/80.D0*EV%Kf(2)*y(9))*dvis(j)+(5.D0/3.D0*grho+ &
- !        gpres)*sigma*expmmu(j)+(-2.D0*adotoa*etak*expmmu(j)+21.D0/10.D0*etak*vis(j))/ &
- !        EV%Kf(1)+(vbdot-3.D0/8.D0*EV%Kf(2)*ypolprime(3)+3.D0/40.D0*qgdot-21.D0/ &
- !        5.D0*sigma*adotoa-9.D0/80.D0*EV%Kf(2)*yprime(9))*vis(j))/k+(((-9.D0/160.D0*pigdot- &
- !        27.D0/80.D0*ypolprime(2))*opac(j)-21.D0/10.D0*dgpi -27.D0/80.D0*dopac(j)*ypol(2) &
- !        -9.D0/160.D0*dopac(j)*pig)*vis(j) - diff_rhopi*expmmu(j)+((-27.D0/80.D0*ypol(2)-9.D0/ &
- !        160.D0*pig)*opac(j)+3.D0/16.D0*pigdot+9.D0/8.D0*ypolprime(2))*dvis(j)+9.D0/ &
- !        8.D0*ddvis(j)*ypol(2)+3.D0/16.D0*ddvis(j)*pig)/t92
- 
- 
-       if (x > 0._dl) then
-          !E polarization source
-            sources(2)=vis(j)*polter*(15._dl/8._dl)/divfac 
-                !factor of four because no 1/16 later
-         else
-            sources(2)=0
-         end if
-  
-       if (CTransScal%NumSources > 2) then
-          !Get lensing sources
-          !Can modify this here if you want to get power spectra for other tracer
-        if (tau>taurend .and. CP%tau0-tau > 0.1_dl) then
-          
-          !phi_lens = Phi - 1/2 kappa (a/k)^2 sum_i rho_i pi_i
-          !Neglect pi contributions because not accurate at late time anyway
-          phi = -(dgrho +3*dgq*adotoa/k)/(k2*EV%Kf(1)*2) 
-             ! - (grhor_t*pir + grhog_t*pig+ pinu*gpnu_t)/k2
-          
-          sources(3) = -2*phi*f_K(tau-tau_maxvis)/(f_K(CP%tau0-tau_maxvis)*f_K(CP%tau0-tau))
-        !  sources(3) = -2*phi/f_K(CP%tau0-tau)
- 
- 
- !         sources(3) = -2*phi*(tau-tau_maxvis)/((CP%tau0-tau_maxvis)*(CP%tau0-tau))
-           !We include the lensing factor of two here
-        else
-          sources(3) = 0
-        end if
-       end if
-      end subroutine output
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine outputt(EV,yt,n,j,tau,dt,dte,dtb)
- !calculate the tensor sources for open and closed case
-         use ThermoData
- 
-         implicit none
-         integer j,n
-         type(EvolutionVars) :: EV
-         real(dl), target :: yt(n), ytprime(n)
-         real(dl) tau,dt,dte,dtb,x,polterdot,polterddot,prefac
-         real(dl) pig, pigdot, aux, polter, shear
-         real(dl) sinhxr,cothxor
-         real(dl) k,k2
-         real(dl), dimension(:),pointer :: E,Bprime,Eprime
- 
-         if (CP%flat) then
-            call fderivst(EV,EV%nvart,tau,yt,ytprime)
-         else
-            call  derivst(EV,EV%nvart,tau,yt,ytprime)
-         end if
-       
-         k2=EV%k2_buf
-         k=EV%k_buf 
-         pigdot=EV%tenspigdot
-         pig=yt(4)
-         aux=EV%aux_buf  
-         shear = yt(3)
- 
-         x=(CP%tau0-tau)/CP%r
-        
-         sinhxr=rofChi(x)*CP%r
-     
-         if (EV%q*sinhxr > 1.e-8_dl) then  
- 
-         prefac=sqrt(EV%q2*CP%r*CP%r-CP%Ksign)
-         cothxor=cosfunc(x)/sinhxr
-         E => yt(EV%lmaxt+3-1:)   
-         Eprime=> ytprime(EV%lmaxt+3-1:) 
-       
-         Bprime => Eprime(EV%lmaxpolt:)
- 
-         polter = 0.1_dl*pig + 9._dl/15._dl*E(2)
-         polterdot=9._dl/15._dl*Eprime(2) + 0.1_dl*pigdot
-         polterddot = 9._dl/15._dl*(-dopac(j)*(E(2)-polter)-opac(j)*(  &
-                    Eprime(2)-polterdot) + k*(2._dl/3._dl*Bprime(2)*aux - &
-                    5._dl/27._dl*Eprime(3)*EV%Kft(2))) &
-                    +0.1_dl*(k*(-ytprime(5)*EV%Kft(2)/3._dl + 8._dl/15._dl*ytprime(3)) - &
-                    dopac(j)*(pig - polter) - opac(j)*(pigdot-polterdot))
- 
-         dt=(shear*expmmu(j) + (15._dl/8._dl)*polter*vis(j)/k)*CP%r/sinhxr**2/prefac 
-    
-         dte=CP%r*15._dl/8._dl/k/prefac* &
-             ((ddvis(j)*polter + 2._dl*dvis(j)*polterdot + vis(j)*polterddot)  &
-               + 4._dl*cothxor*(dvis(j)*polter + vis(j)*polterdot) - &
-                    vis(j)*polter*(k2 -6*cothxor**2))
-       
-         dtb=15._dl/4._dl*EV%q*CP%r/k/prefac*(vis(j)*(2._dl*cothxor*polter + polterdot) + dvis(j)*polter)
-    
-         else
-         dt=0._dl
-         dte=0._dl
-         dtb=0._dl
-         end if
- 
-         end subroutine outputt
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine outputv(EV,yv,n,j,tau,dt,dte,dtb)
- !calculate the vector sources 
-         use ThermoData
- 
-         implicit none
-         integer j,n
-         type(EvolutionVars) :: EV
-         real(dl), target :: yv(n), yvprime(n)
-         real(dl) tau,dt,dte,dtb,x,polterdot
-         real(dl) vb,qg, pig, polter, sigma
-         real(dl) k,k2
-         real(dl), dimension(:),pointer :: E,Eprime
- 
-         call fderivsv(EV,EV%nvarv,tau,yv,yvprime)
-       
-         k2=EV%k2_buf
-         k=EV%k_buf 
-         sigma = yv(2)
-         vb  = yv(3)
-         qg  = yv(4)
-         pig = yv(5)
- 
-   
-         x=(CP%tau0-tau)*k
-               
-         if (x > 1.e-8_dl) then  
- 
-         E => yv(EV%lmaxv+3:)
-         Eprime=> yvprime(EV%lmaxv+3:) 
-       
-         polter = 0.1_dl*pig + 9._dl/15._dl*E(2)
-         polterdot=9._dl/15._dl*Eprime(2) + 0.1_dl*yvprime(5)
-  
-         if (yv(1) < 1e-3) then
-          dt = 1
-         else
-          dt =0
-         end if   
-         dt= (4*(vb+sigma)*vis(j) + 15._dl/2/k*( vis(j)*polterdot + dvis(j)*polter) &
-                + 4*(expmmu(j)*yvprime(2)) )/x 
-    
-         dte= 15._dl/2*2*polter/x**2*vis(j) + 15._dl/2/k*(dvis(j)*polter + vis(j)*polterdot)/x 
-       
-         dtb= -15._dl/2*polter/x*vis(j)
- 
-         else
-          dt=0
-          dte=0
-          dtb=0
-         end if
- 
-         end subroutine outputv
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine initial(EV,y, tau)
- !  Initial conditions.
-         implicit none
-         type(EvolutionVars) EV
-         real(dl) y(EV%nvar)
-         real(dl) Rp15,tau,x,x2,x3,om,omtau, &
-              Rc,Rb,Rv,Rg,grhonu,chi
-         real(dl) k,k2 
-         real(dl) a,a2, iqg, rhomass
-         integer l,i, nu_i, off_ix
-         integer, parameter :: i_clxg=1,i_clxr=2,i_clxc=3, i_clxb=4, &
-                 i_qg=5,i_qr=6,i_vb=7,i_pir=8, i_eta=9, i_aj3r=10,i_clxq=11,i_vq=12
-         integer, parameter :: i_max = i_vq
-         real(dl) initv(6,1:i_max), initvec(1:i_max)
- 
-            
-         EV%ScalEqsToPropagate=EV%nvar
-         if (CP%flat) then
-          EV%k_buf=EV%q
-          EV%k2_buf=EV%q2     
-          EV%Kf(1:EV%MaxlNeeded)=1._dl !initialize for CP%flat case 
-         else
-          EV%k2_buf=EV%q2-CP%curv
-          EV%k_buf=sqrt(EV%k2_buf)
-                     
-          do l=1,EV%MaxlNeeded
-            EV%Kf(l)=1._dl-CP%curv*(l*(l+2))/EV%k2_buf           
-          end do
-         end if
- 
-         k=EV%k_buf
-         k2=EV%k2_buf
-    
-         if (CP%closed) then
-            EV%FirstZerolForBeta = nint(EV%q*CP%r) 
-         else 
-            EV%FirstZerolForBeta=l0max !a large number
-         end if
- 
-    
- !  k*tau, (k*tau)**2, (k*tau)**3
-         x=k*tau
-         x2=x*x
-         x3=x2*x
-         rhomass =  sum(grhormass(1:CP%Nu_mass_eigenstates)) 
-         grhonu=rhomass+grhornomass
-                                                         
-         om = (grhob+grhoc)/sqrt(3*(grhog+grhonu))       
-         omtau=om*tau
-         Rv=grhonu/(grhonu+grhog)
-         Rg = 1-Rv
-         Rc=CP%omegac/(CP%omegac+CP%omegab)
-         Rb=1-Rc
-         Rp15=4*Rv+15
- 
-         if (CP%Scalar_initial_condition > initial_nummodes) &
-           stop 'Invalid initial condition for scalar modes'
- 
-         a=tau*adotrad*(1+omtau/4)
-         a2=a*a
-         
-         initv=0
- 
- !  Set adiabatic initial conditions
- 
-         chi=1  !Get transfer function for chi
-         initv(1,i_clxg)=-chi*EV%Kf(1)/3*x2*(1-omtau/5)
-         initv(1,i_clxr)= initv(1,i_clxg)
-         initv(1,i_clxb)=0.75_dl*initv(1,i_clxg)
-         initv(1,i_clxc)=initv(1,i_clxb)
-         initv(1,i_qg)=initv(1,i_clxg)*x/9._dl
-         initv(1,i_qr)=-chi*EV%Kf(1)*(4*Rv+23)/Rp15*x3/27
-         initv(1,i_vb)=0.75_dl*initv(1,i_qg)
-         initv(1,i_pir)=chi*4._dl/3*x2/Rp15*(1+omtau/4*(4*Rv-5)/(2*Rv+15))
-         initv(1,i_aj3r)=chi*4/21._dl/Rp15*x3
-         initv(1,i_eta)=-chi*2*EV%Kf(1)*(1 - x2/12*(-10._dl/Rp15 + EV%Kf(1)))
-       
-         if (CP%Scalar_initial_condition/= initial_adiabatic) then
- !CDM isocurvature   
-        
-          initv(2,i_clxg)= Rc*omtau*(-2._dl/3 + omtau/4)
-          initv(2,i_clxr)=initv(2,i_clxg)
-          initv(2,i_clxb)=initv(2,i_clxg)*0.75_dl
-          initv(2,i_clxc)=1+initv(2,i_clxb)
-          initv(2,i_qg)=-Rc/9*omtau*x
-          initv(2,i_qr)=initv(2,i_qg)
-          initv(2,i_vb)=0.75_dl*initv(2,i_qg)
-          initv(2,i_pir)=-Rc*omtau*x2/3/(2*Rv+15._dl)
-          initv(2,i_eta)= Rc*omtau*(1._dl/3 - omtau/8)*EV%Kf(1)
-          initv(2,i_aj3r)=0
- !Baryon isocurvature
-          if (Rc==0) stop 'Isocurvature initial conditions assume non-zero dark matter'
- 
-          initv(3,:) = initv(2,:)*(Rb/Rc)
-          initv(3,i_clxc) = initv(3,i_clxb)
-          initv(3,i_clxb)= initv(3,i_clxb)+1
-       
- !neutrino isocurvature density mode
-        
-          initv(4,i_clxg)=Rv/Rg*(-1 + x2/6)
-          initv(4,i_clxr)=1-x2/6
-          initv(4,i_clxc)=-omtau*x2/80*Rv*Rb/Rg
-          initv(4,i_clxb)= Rv/Rg/8*x2
-          iqg = - Rv/Rg*(x/3 - Rb/4/Rg*omtau*x)
-          initv(4,i_qg) =iqg
-          initv(4,i_qr) = x/3
-          initv(4,i_vb)=0.75_dl*iqg
-          initv(4,i_pir)=x2/Rp15
-          initv(4,i_eta)=EV%Kf(1)*Rv/Rp15/3*x2
-      
- !neutrino isocurvature velocity mode
- 
-          initv(5,i_clxg)=Rv/Rg*x - 2*x*omtau/16*Rb*(2+Rg)/Rg**2
-          initv(5,i_clxr)=-x -3*x*omtau*Rb/16/Rg
-          initv(5,i_clxc)=-9*omtau*x/64*Rv*Rb/Rg
-          initv(5,i_clxb)= 3*Rv/4/Rg*x - 9*omtau*x/64*Rb*(2+Rg)/Rg**2
-          iqg = Rv/Rg*(-1 + 3*Rb/4/Rg*omtau+x2/6 +3*omtau**2/16*Rb/Rg**2*(Rg-3*Rb))
-          initv(5,i_qg) =iqg
-          initv(5,i_qr) = 1 - x2/6*(1+4*EV%Kf(1)/(4*Rv+5))
-          initv(5,i_vb)=0.75_dl*iqg
-          initv(5,i_pir)=2*x/(4*Rv+5)+omtau*x*6/Rp15/(4*Rv+5)
-          initv(5,i_eta)=2*EV%Kf(1)*x*Rv/(4*Rv+5) + omtau*x*3*EV%Kf(1)*Rv/32*(Rb/Rg - 80/Rp15/(4*Rv+5))
-          initv(5,i_aj3r) = 3._dl/7*x2/(4*Rv+5)
- 
- !quintessence isocurvature mode
- 
- 
-          end if
- 
-        if (CP%Scalar_initial_condition==initial_vector) then
-           InitVec = 0
-           do i=1,initial_nummodes
-           InitVec = InitVec+ initv(i,:)*CP%InitialConditionVector(i)
-           end do
-        else
-           InitVec = initv(CP%Scalar_initial_condition,:)
-           if (CP%Scalar_initial_condition==initial_adiabatic) InitVec = -InitVec
-             !So we start with chi=-1 as before
-        end if
- 
-         y(1)=a
-         y(2)= -InitVec(i_eta)*k/2
-         !get eta_s*k, where eta_s is synchronous gauge variable
- 
- !  CDM
-         y(3)=InitVec(i_clxc)
-   
- !  Baryons
-         y(4)=InitVec(i_clxb)
-         y(5)=InitVec(i_vb)
- 
- !  Photons
-         y(6)=InitVec(i_clxg)
-         y(7)=InitVec(i_qg) 
-               
-         y(8:EV%nvar)=0._dl
-  
-         if (w_lam /= -1 .and. w_Perturb) then
-          y(EV%w_ix) = InitVec(i_clxq)
-          y(EV%w_ix+1) = InitVec(i_vq)
-         end if
- 
- !  Neutrinos
-         y(7+EV%lmaxg)=InitVec(i_clxr)
-         y(8+EV%lmaxg)=InitVec(i_qr)
-         y(9+EV%lmaxg)=InitVec(i_pir)
- 
-         if (EV%FirstZerolForBeta==3) then
-          y(10+EV%lmaxg)=0._dl
-         else
-          y(10+EV%lmaxg)=InitVec(i_aj3r)
-         endif
- 
- 
-         EV%TightCoupling=.true.
-         EV%no_rad_multpoles =.false.
-         EV%MassiveNuApprox=.false.
-         if (CP%Num_Nu_massive == 0) return 
- 
-         do nu_i = 1, CP%Nu_mass_eigenstates       
-        
-         if (EV%NuMethod == Nu_approx) then
-         
-          !Values are just same as massless neutrino ones since highly relativistic
-          off_ix = EV%iq0+(nu_i-1)*(EV%lmaxnu+1)
-          y(off_ix)=InitVec(i_clxr)
-          y(off_ix+1)=InitVec(i_qr)
-          y(off_ix+2)=InitVec(i_pir)
-          if (EV%FirstZerolForBeta/=3) then
-            y(off_ix+3)=InitVec(i_aj3r)
-          endif
-         
-         else
-         
-           off_ix =  (nu_i-1)*nqmax*(EV%lmaxnu+1) 
-           do  i=1,nqmax
-            y(EV%iq0+off_ix+i-1)=-0.25_dl*dlfdlq(i)*InitVec(i_clxr)
-            y(EV%iq1+off_ix+i-1)=-0.25_dl*dlfdlq(i)*InitVec(i_qr)
-            y(EV%iq2+off_ix+i-1)=-0.25_dl*dlfdlq(i)*InitVec(i_pir)
-           end do
- 
-         end if
-         end do       
- 
-         end subroutine initial
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine initialt(EV,yt,tau)
- !  Initial conditions for tensors
- 
-         implicit none
-         real(dl) bigR,tau,x,aj3r,elec, pir, rhomass
-         integer l
-          type(EvolutionVars) EV
-         real(dl) k,k2 ,a, omtau
-         real(dl) yt(EV%nvart)
-         real(dl) tens0
-         
-         if (CP%flat) then
-          EV%aux_buf=1._dl
-          EV%k2_buf=EV%q2
-          EV%k_buf=EV%q       
-          EV%Kft(1:EV%lmaxt)=1._dl !initialize for flat case
-         else
-       
-         EV%k2_buf=EV%q2-3*CP%curv
-         EV%k_buf=sqrt(EV%k2_buf) 
-         EV%aux_buf=sqrt(1._dl+3*CP%curv/EV%k2_buf)  
-         do l=1,EV%lmaxt
-            EV%Kft(l)=1._dl-CP%curv*((l+1)**2-3)/EV%k2_buf
-         end do
-         endif
-         
-         k=EV%k_buf
-         k2=EV%k2_buf
- 
- 
-         if (CP%closed) then
-            EV%FirstZerolForBeta = nint(EV%q*CP%r) 
-         else 
-            EV%FirstZerolForBeta=l0max !a large number
-         end if
-          
-         a=tau*adotrad
-         rhomass =  sum(grhormass(1:CP%Nu_mass_eigenstates)) 
-         omtau = tau*(grhob+grhoc)/sqrt(3*(grhog+rhomass+grhornomass))       
-             
-         if (DoTensorNeutrinos) then
-          bigR = (rhomass+grhornomass)/(rhomass+grhornomass+grhog)
-         else
-          bigR = 0._dl
-         end if
- 
-         x=k*tau
-  
-         yt(1)=a
-         tens0 = 1
- 
-         yt(2)= tens0 
- !commented things are for the compensated mode with magnetic fields; can be neglected
-           ! -15/28._dl*x**2*(bigR-1)/(15+4*bigR)*Magnetic*(1-5./2*omtau/(2*bigR+15))
-     
-         elec=-tens0*(1+2*CP%curv/k2)*(2*bigR+10)/(4*bigR+15) !elec, with H=1
-        
-         !shear
-         yt(3)=-5._dl/2/(bigR+5)*x*elec 
-           !+ 15._dl/14*x*(bigR-1)/(4*bigR+15)*Magnetic*(1 - 15./2*omtau/(2*bigR+15))
-         
-         yt(4:EV%nvart)=0._dl
-      
- !  Neutrinos 
-         if (DoTensorNeutrinos) then
-          pir=-2._dl/3._dl/(bigR+5)*x**2*elec 
-            !+ (bigR-1)/bigR*Magnetic*(1-15./14*x**2/(15+4*bigR))
-          aj3r=  -2._dl/21._dl/(bigR+5)*x**3*elec 
-            !+ 3._dl/7*x*(bigR-1)/bigR*Magnetic
-          yt((EV%lmaxt-1)+(EV%lmaxpolt-1)*2+3+1)=pir
-          yt((EV%lmaxt-1)+(EV%lmaxpolt-1)*2+3+2)=aj3r
-         end if
-     
-         end subroutine initialt
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine initialv(EV,yv,tau)
- !  Initial conditions for vectors
- 
-         implicit none
-         real(dl) bigR,Rc,tau,x,pir
-         type(EvolutionVars) EV
-         real(dl) k,k2 ,a, omtau
-         real(dl) yv(EV%nvarv)
-         
-         if (CP%flat) then
-          EV%k2_buf=EV%q2
-          EV%k_buf=EV%q       
-         else
-          stop 'Vectors not supported in non-flat models'
-         endif
-         
-         k=EV%k_buf
-         k2=EV%k2_buf
- 
-         omtau = tau*(grhob+grhoc)/sqrt(3*(grhog+grhornomass))       
- 
-         a=tau*adotrad*(1+omtau/4)
-         
-         x=k*tau
-        
-         bigR = (grhornomass)/(grhornomass+grhog)
-         Rc=CP%omegac/(CP%omegac+CP%omegab)
- 
-         yv(1)=a
- 
-         
-         yv(2)= vec_sig0*(1- 15._dl/2*omtau/(4*bigR+15)) + 45._dl/14*x*Magnetic*(BigR-1)/(4*BigR+15)
-         !qg
-         yv(4)= vec_sig0/3* (4*bigR + 5)/(1-BigR)*(1  -0.75_dl*omtau*(Rc-1)/(bigR-1)* &
-                (1 - 0.25_dl*omtau*(3*Rc-2-bigR)/(BigR-1))) &
-                  -x/2*Magnetic
-         yv(3)= 3._dl/4*yv(4)
-         
-         yv(5:EV%nvarv) = 0
- 
- !        if (.false.) then
- !         yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+1) = vec_sig0/6/bigR*x**2*(1+2*bigR*omtau/(4*bigR+15))
- !         yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+2) = -2/3._dl*vec_sig0/bigR*x*(1 +3*omtau*bigR/(4*bigR+15))
- !         yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+3) = 1/4._dl*vec_sig0/bigR*(5+4*BigR) 
- !         yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+4) =1/9.*x*vec_sig0*(5+4*bigR)/bigR
- !         yv(4) = 0
- !         yv(3)= 3._dl/4*yv(4)
- !          return 
- !        end if
- 
- !  Neutrinos
- !q_r
-          yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+1) = -1._dl/3*vec_sig0*(4*BigR+5)/bigR &
-              + x**2*vec_sig0/6/BigR +0.5_dl*x*(1/bigR-1)*Magnetic 
- !pi_r
-          pir=-2._dl/3._dl*x*vec_sig0/BigR - (1/bigR-1)*Magnetic
-          yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+1 +1)=pir
-          yv((EV%lmaxv-1+1)+(EV%lmaxpolv-1)*2+3+1 +2)=3._dl/7*x*Magnetic*(1-1/BigR)
-   
-         end subroutine initialv
- 
- 
-       subroutine outtransf(EV, y, Arr)
-  !write out clxc, clxb, clxg, clxn
-         use Transfer
-         implicit none
-         type(EvolutionVars) EV
-    
-         real(dl) clxc, clxb, clxg, clxr, k,k2
-         real(dl) grho,gpres,dgrho,dgq,a
-         real Arr(Transfer_max)
-         real(dl) y(EV%nvar)
- 
-         a    = y(1)
-         clxc = y(3)
-         clxb = y(4)
-         clxg = y(6)
-         clxr = y(7+EV%lmaxg)
-         k    = EV%k_buf
-         k2   = EV%k2_buf
-  
-         Arr(Transfer_kh) = k/(CP%h0/100._dl)
-         Arr(Transfer_cdm) = clxc/k2
-         Arr(Transfer_b) = clxb/k2
-         Arr(Transfer_g) = clxg/k2
-         Arr(Transfer_r) = clxr/k2
-   
-         dgrho = 0 
-         grho =  0
- 
-         if (CP%Num_Nu_Massive > 0) then
-           call MassiveNuVars(EV,y,a,grho,gpres,dgrho,dgq)
-            Arr(Transfer_nu) = dgrho/grho/k2
-         else
-            Arr(Transfer_nu) = 0
-         end if
- 
- !!!If we want DE perturbations to get \delta\rho/\rho_m    
-      !  dgrho=dgrho+y(EV%w_ix)*grhov*a**(-1-3*w_lam)
-      !   Arr(Transfer_r) = y(EV%w_ix)/k2
- 
- !        dgrho = dgrho+(clxc*grhoc + clxb*grhob)/a 
- !        grho =  grho+(grhoc+grhob)/a + grhov*a**(-1-3*w_lam)
- 
-   
-         dgrho = dgrho+(clxc*grhoc + clxb*grhob)/a 
-         grho =  grho+(grhoc+grhob)/a
-         
-         Arr(Transfer_tot) = dgrho/grho/k2 
-              
-     
-      end subroutine outtransf
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine fderivs(EV,n,tau,ay,ayprime)
- !  Evaluate the time derivatives of the perturbations, flat case
- !  ayprime is not necessarily GaugeInterface.yprime, so keep them distinct
-         use ThermoData
-         use MassiveNu
-         implicit none      
-         type(EvolutionVars) EV
- 
-         integer n,nu_i,ix_off
-         real(dl) ay(n),ayprime(n)
-         real(dl) tau,w
-         real(dl) k,k2 
- 
- !  Internal variables.
- 
-         real(dl) opacity
-         real(dl) photbar,cs2,pb43,grho,slip,clxgdot, &
-                       clxcdot,clxbdot,adotdota,gpres,clxrdot,etak
-         real(dl) q,aq,v,akv(nqmax0)
-         real(dl) G11_t,G30_t, wnu_arr(max_nu)
- 
-         real(dl) dgq,grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,sigma,polter
-         real(dl) qgdot,qrdot,pigdot,pirdot,vbdot,dgrho,adotoa
-         real(dl) a,a2,z,clxc,clxb,vb,clxg,qg,pig,clxr,qr,pir
-         real(dl) f
-         real(dl) clxq, vq,  E2, dopacity
-         integer l,i,ind, off_ix
-                     
- 
-         k=EV%k_buf
-         k2=EV%k2_buf     
-   
-         a=ay(1)
-         a2=a*a
- 
-         etak=ay(2)
- 
- !  CDM variables
-         clxc=ay(3)
- 
- !  Baryon variables
-         clxb=ay(4)
-         vb=ay(5)
- 
- !  Compute expansion rate from: grho 8*pi*rho*a**2
- 
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         if (w_lam==-1._dl) then
-          grhov_t=grhov*a2
-          else
-          grhov_t=grhov*a**(-1-3*w_lam)
-         end if
- 
- 
-        if (EV%no_rad_multpoles) then
-         clxg=2*(grhoc_t*clxc+grhob_t*clxb)/3/k**2
-         clxr=clxg
-         qg= clxg*k/sqrt((grhoc_t+grhob_t)/3)*(2/3._dl)
-         qr=qg
-         pig=0
-         E2=0
-         pir=0
-        else
- !  Photons
-         clxg=ay(6)
-         qg=ay(7)
-         pig=ay(8)
-         E2=ay(EV%polind+2)
- 
- !  Massless neutrinos
-         clxr=ay(7+EV%lmaxg)
-         qr  =ay(8+EV%lmaxg)
-         pir =ay(9+EV%lmaxg)
-        end if
- 
- !  Get sound speed and ionisation fraction.
-         if (EV%TightCoupling) then
-           call thermo(tau,cs2,opacity,dopacity)
-          else
-           call thermo(tau,cs2,opacity)        
-         end if
- 
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
- 
- !  Photon mass density over baryon mass density
-         photbar=grhog_t/grhob_t
-         pb43=4._dl/3*photbar
- 
- !  8*pi*a*a*SUM[rho_i*clx_i]
-         dgrho=grhob_t*clxb+grhoc_t*clxc + grhog_t*clxg+grhor_t*clxr 
-        
- !  8*pi*a*a*SUM[(rho_i+p_i)*v_i]
-         dgq=grhob_t*vb+grhog_t*qg+grhor_t*qr
- 
-         gpres=0
- 
-         if (CP%Num_Nu_Massive > 0) then
-            call MassiveNuVars(EV,ay,a,grho,gpres,dgrho,dgq, wnu_arr)
-         end if
- 
-         
-         adotoa=sqrt(grho/3)
-         ayprime(1)=adotoa*a
-        
-         if (w_lam /= -1 .and. w_Perturb) then
-            clxq=ay(EV%w_ix) 
-            vq=ay(EV%w_ix+1) 
-            dgrho=dgrho + clxq*grhov_t
-            dgq = dgq + vq*grhov_t*(1+w_lam)
-        end if
- 
- !  Get sigma (shear) and z from the constraints
- ! have to get z from eta for numerical stability
-         z=(0.5_dl*dgrho/k + etak)/adotoa 
-         sigma=z+1.5_dl*dgq/k2
-       
-         
-         if (w_lam /= -1 .and. w_Perturb) then
- 
-            ayprime(EV%w_ix)= -3*adotoa*(cs2_lam-w_lam)*(clxq+3*adotoa*(1+w_lam)*vq/k) &
-                -(1+w_lam)*k*vq -(1+w_lam)*k*z
- 
-            ayprime(EV%w_ix+1) = -adotoa*(1-3*cs2_lam)*vq + k*cs2_lam*clxq/(1+w_lam)
- 
-         end if
- 
-       
-  !eta*k equation
-         ayprime(2)=dgq/2
- 
- !  CDM equation of motion
-         clxcdot=-k*z
-         ayprime(3)=clxcdot
- 
- !  Baryon equation of motion.
-         clxbdot=-k*(z+vb)
-         ayprime(4)=clxbdot
- !  Photon equation of motion
-         clxgdot=-k*(4._dl/3._dl*z+qg)
- 
- ! Small k: potential problem with stability, using full equations earlier is NOT more accurate in general
- ! Easy to see instability in k \sim 1e-3 by tracking evolution of vb
- 
- !  Use explicit equation for vb if appropriate
- 
-          if (EV%TightCoupling) then
-    
-             pig = 32._dl/45/opacity*k*(sigma+vb)
-             E2 = pig/4
-             EV%pig = pig
-    
-     !  Use tight-coupling approximation for vb
-     !  zeroth order approximation to vbdot + the pig term
-             vbdot=(-adotoa*vb+cs2*k*clxb  &
-                  +k/4*pb43*(clxg-2*pig))/(1+pb43)
- 
-            !  ddota/a
-              gpres=gpres+ (grhog_t+grhor_t)/3 +grhov_t*w_lam
-              adotdota=(adotoa*adotoa-gpres)/2
- !            delta = -1/(4*opacity*(1+pb43))*(k*clxg -4*k*cs2*clxb+4*adotoa*vb)
- !            delta = (vb-3._dl/4*qg)
- 
-     !  First-order approximation to baryon-photon splip
- 
-              slip = - (2*adotoa/(1+pb43) + dopacity/opacity)* (vb-3._dl/4*qg) &
-              +(-adotdota*vb-k/2*adotoa*clxg +k*(cs2*clxbdot-clxgdot/4))/(opacity*(1+pb43))
- 
- ! This approx using n_e \propto 1/S^3 is not good enough in some cases
- !            slip=2*pb43/(1+pb43)*adotoa*(vb-3._dl/4*qg) &
- !               +1._dl/opacity*(-adotdota*vb-k/2*adotoa*clxg  &
- !               +k*(cs2*clxbdot-clxgdot/4))/(1+pb43)
- 
-          vbdot=vbdot+pb43/(1+pb43)*slip
- 
-         else
-             vbdot=-adotoa*vb+cs2*k*clxb-photbar*opacity*(4._dl/3*vb-qg)
-         end if
- 
-         ayprime(5)=vbdot
-     
-      if (EV%no_rad_multpoles) then
- 
-         if (CP%Num_Nu_massive/=0) then
-           ayprime(6:EV%polind+EV%lmaxgpol)=0._dl
-         end if
- 
-      else
- 
-  !  Photon equations of motion
-         ayprime(6)=clxgdot
-         qgdot=4._dl/3*(-vbdot-adotoa*vb+cs2*k*clxb)/pb43 &
-             +k*(clxg-2*pig)/3
-         ayprime(7)=qgdot
-         
- !  Use explicit equations for photon moments if appropriate       
-         if (EV%tightcoupling) then
- 
-          !  Use tight-coupling approximation where moments are zero for l>1
-           ayprime(8:EV%lmaxg+6)=0._dl
-           ayprime(EV%polind+2:EV%polind+EV%lmaxgpol)=0._dl
- 
-         else
- 
-             polter = pig/10+9._dl/15*E2 !2/15*(3/4 pig + 9/2 E2)
- 
-             pigdot=0.4_dl*k*qg-0.6_dl*k*ay(9)-opacity*(pig - polter) &
-                    +8._dl/15._dl*k*sigma
-             ayprime(8)=pigdot
-             do  l=3,EV%lmaxg-1
-                ayprime(l+6)=k*denl(l)*(l*ay(l+5)-(l+1)*ay(l+7))-opacity*ay(l+6)
-             end do
-           !  Truncate the photon moment expansion
-             ayprime(EV%lmaxg+6)=k*ay(EV%lmaxg+5)-(EV%lmaxg+1)/tau*ay(EV%lmaxg+6)  &
-                            -opacity*ay(EV%lmaxg+6)
- 
- !  Polarization
-             !l=2 
-             ayprime(EV%polind+2) = -opacity*(ay(EV%polind+2) - polter) - k/3._dl*ay(EV%polind+3)
-             !and the rest
-             do l=3,EV%lmaxgpol-1
-                ayprime(EV%polind+l)=-opacity*ay(EV%polind+l) + k*denl(l)*(l*ay(EV%polind+l-1) -&
-                               polfac(l)*ay(EV%polind+l+1))
-             end do  
-     
-             !truncate
-             ayprime(EV%polind+EV%lmaxgpol)=-opacity*ay(EV%polind+EV%lmaxgpol) + &
-                k*EV%poltruncfac*ay(EV%polind+EV%lmaxgpol-1)-(EV%lmaxgpol+3)*ay(EV%polind+EV%lmaxgpol)/tau
-       
-         end if
-     
- !  Massless neutrino equations of motion.
-         clxrdot=-k*(4._dl/3._dl*z+qr)
-         ayprime(EV%lmaxg+7)=clxrdot
-         qrdot=k*(clxr-2._dl*pir)/3._dl
-         ayprime(EV%lmaxg+8)=qrdot
-         pirdot=k*(0.4_dl*qr-0.6_dl*ay(EV%lmaxg+10)+8._dl/15._dl*sigma)
-         ayprime(EV%lmaxg+9)=pirdot
-         do l=3,EV%lmaxnr-1
-            ayprime(l+EV%lmaxg+7)=k*denl(l)*(l*ay(l+EV%lmaxg+6) -(l+1)*ay(l+EV%lmaxg+8))
-         end do   
- !  Truncate the neutrino expansion
-         ayprime(EV%lmaxnr+EV%lmaxg+7)=k*ay(EV%lmaxnr+EV%lmaxg+6)- &
-                                 (EV%lmaxnr+1)/tau*ay(EV%lmaxnr+EV%lmaxg+7)
-      
-         end if ! no_rad_multpoles
- 
- !  Massive neutrino equations of motion.
-          if (CP%Num_Nu_massive == 0) return
-           
-           do nu_i = 1, CP%Nu_mass_eigenstates
- 
-          if (EV%NuMethod == Nu_approx) then
- 
-             !crude approximation scheme
-             off_ix = EV%iq0+(nu_i-1)*(EV%lmaxnu+1)
- 
-             w=wnu_arr(nu_i)
-             f = (5._dl/3)**(a*nu_masses(nu_i)/(a*nu_masses(nu_i)+200)) &
-                 *(3*w)**((2+a*nu_masses(nu_i))/(4+a*nu_masses(nu_i))) 
- 
-             !clxnudot
-             ayprime(off_ix)=-(f-3*w)*adotoa*ay(off_ix)-k*((1+w)*z+ay(off_ix+1))
-             !qnudot
-             ayprime(off_ix+1)=-adotoa*(1-3*w)*ay(off_ix+1)+k/3._dl*(f*ay(off_ix)-2._dl*ay(off_ix+2))
-             !pinudot
- 
-             ayprime(off_ix+2)=-adotoa*(-f +2-3*w)*ay(off_ix+2) +  &
-                  k*(2._dl/5*f*ay(off_ix+1)-0.6_dl*ay(off_ix+3)+ 2._dl/5*w*(5-3*w)*sigma)
-  
-             do l=3,EV%lmaxnu-1
-                ayprime(off_ix+l)=-adotoa*((1-l)*f+l-3*w)*ay(off_ix+l) + &
-                     k*denl(l)*(f*l*ay(off_ix+l-1) -(l+1)*ay(off_ix+l+1))
-             end do
-             !  Truncate the neutrino expansion
-             ayprime(off_ix+EV%lmaxnu)=k*ay(off_ix+EV%lmaxnu-1)- &
-                  (EV%lmaxnu+1)/tau*ay(off_ix+EV%lmaxnu)
-                         
-                      
-          else !Not approx scheme
- 
- 
-           if (EV%MassiveNuApprox) then
-              !Now EV%iq0 = clx, EV%iq0+1 = clxp, EV%iq0+2 = G_1, EV%iq0+3=G_2=pinu
-              !see astro-ph/0203507
-              G11_t=EV%G11(nu_i)/a/a2 
-              G30_t=EV%G30(nu_i)/a/a2
-              off_ix = (nu_i-1)*4 + EV%iq0
-              w=wnu_arr(nu_i)
-              ayprime(off_ix)=-k*z*(w+1) + 3*adotoa*(w*ay(off_ix) - ay(off_ix+1))-k*ay(off_ix+2)
-              ayprime(off_ix+1)=(3*w-2)*adotoa*ay(off_ix+1) - 5._dl/3*k*z*w - k/3*G11_t
-              ayprime(off_ix+2)=(3*w-1)*adotoa*ay(off_ix+2) - k*(2._dl/3*ay(off_ix+3)-ay(off_ix+1))
-              ayprime(off_ix+3)=(3*w-2)*adotoa*ay(off_ix+3) + 2*w*k*sigma - k/5*(3*G30_t-2*G11_t)
-      
-           else
-           
-               do i=1,nqmax
-                 q=(i-0.5_dl)*dq
-                 aq=a*nu_masses(nu_i)/q
-                 v=1._dl/sqrt(1._dl+aq*aq)
-                 akv(i)=k*v        
-               end do
-         
-               ix_off=nqmax*(EV%lmaxnu+1)*(nu_i-1)
-     !  l = 0, 1, 2,EV%lmaxnu.
-               do i=1,nqmax
-                ind=EV%iq0+i-1 + ix_off
-                ayprime(ind)=-akv(i)*ay(ind+nqmax)+z*k*dlfdlq(i)/3
-                ind=EV%iq1+i-1 + ix_off
-                ayprime(ind)=akv(i)*(ay(ind-nqmax)-2*ay(ind+nqmax))/3
-                ind=EV%iq2+i-1 + ix_off
-                ayprime(ind)=akv(i)*(2*ay(ind-nqmax)-3*ay(ind+nqmax))/5 &
-                      -k*2._dl/15._dl*sigma*dlfdlq(i)
-                ind=EV%iq0+i-1+EV%lmaxnu*nqmax + ix_off
-     !  Truncate moment expansion.
-                ayprime(ind)=akv(i)*ay(ind-nqmax)-(EV%lmaxnu+1)/tau*ay(ind)
-               end do
-               do l=3,EV%lmaxnu-1
-                 ind=EV%iq0-1+l*nqmax + ix_off
-                 do i=1,nqmax
-                  ind=ind+1
-                  ayprime(ind)=akv(i)*denl(l)*(l*ay(ind-nqmax)-(l+1)*ay(ind+nqmax))
-                 end do
-               end do
- 
-           end if
-           end if
- 
-           end do
- 
-         end subroutine fderivs
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine fderivst(EV,n,tau,ayt,aytprime)
- !  Evaluate the time derivatives of the tensor perturbations, CP%flat case
-         use ThermoData
-         use MassiveNu
-         implicit none      
-         type(EvolutionVars) EV
-         integer n,l,i,ind, nu_i, off_ix
-         real(dl), target ::  ayt(n),aytprime(n)
-         real(dl) ep,tau,grho,rhopi,cs2,opacity,pirdt
-         logical finished_tightcoupling
-         real(dl), dimension(:),pointer :: neut,neutprime,E,B,Eprime,Bprime
-         real(dl) q,aq,v,akv(nqmax0)
-         real(dl)  grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,polter
-         real(dl) Hchi,shear, pig
-         real(dl) k,k2,a,a2
-         real(dl) pir,adotoa, rhonu, shearnu
- 
-          k2=EV%k2_buf
-          k=EV%k_buf       
- 
-         !E and B start at l=2. Set up pointers accordingly to fill in y arrays
-         E => ayt(EV%lmaxt+3-1:)
-         Eprime=> aytprime(EV%lmaxt+3-1:) 
-         B => E(EV%lmaxpolt:)
-         Bprime => Eprime(EV%lmaxpolt:)
-      
-         a=ayt(1)        
- 
- !Hchi = metric perturbation variable, conserved on large scales
-         Hchi=ayt(2)
- 
- 
- !shear (Hchi' = - k*shear)
-         shear=ayt(3)
- 
- !  Photon anisotropic stress
-         pig=ayt(4)
- 
-         a2=a*a
- 
- !  Get sound speed and opacity, and see if should use tight-coupling
-              
-         call thermo(tau,cs2,opacity)
-         if (k > 0.06_dl*epsw) then
-            ep=ep0
-         else
-            ep=0.2_dl*ep0
-         end if
-    
-         finished_tightcoupling = ((k/opacity > ep).or.(1._dl/(opacity*tau) > ep .and. k/opacity > 1d-4)) 
- 
- 
- ! Compute expansion rate from: grho=8*pi*rho*a**2
- ! Also calculate gpres: 8*pi*p*a**2
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         grhov_t=grhov*a**(-1-3*w_lam)
- 
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
-      
- !Do massive neutrinos
-         if (CP%Num_Nu_Massive >0) then
-          do nu_i=1,CP%Nu_mass_eigenstates
-            call Nu_rho(a*nu_masses(nu_i),rhonu)
-            grho=grho+grhormass(nu_i)*rhonu/a2
-          end do
-         end if
- 
- 
-         adotoa=sqrt(grho/3._dl)
-        
-         aytprime(1)=adotoa*a
-         polter = 0.1_dl*pig + 9._dl/15._dl*E(2)
- 
-         if (finished_tightcoupling) then
- !  Use explicit equations:
- !  Equation for the photon anisotropic stress
-         aytprime(4)=k*(-1._dl/3._dl*ayt(5)+8._dl/15._dl*shear)  &
-                   -opacity*(pig - polter)
- ! And for the moments            
-         do  l=3,EV%lmaxt-1
-            aytprime(l+2)=k*denl(l)*(l*ayt(l+1)-   &
-                   tensfac(l)*ayt(l+3))-opacity*ayt(l+2)
-         end do
- !  Truncate the hierarchy
-         
-         aytprime(EV%lmaxt+2)=k*EV%lmaxt/(EV%lmaxt-2._dl)*ayt(EV%lmaxt+1)- &
-                        (EV%lmaxt+3._dl)*ayt(EV%lmaxt+2)/tau-opacity*ayt(EV%lmaxt+2)
-      
- !E equations
- 
-         Eprime(2) = - opacity*(E(2) - polter) + k*(4._dl/6._dl*B(2) - &
-                         5._dl/27._dl*E(3))
-         do l=3,EV%lmaxpolt-1
-         Eprime(l) =-opacity*E(l) + k*(denl(l)*(l*E(l-1) - &
-                         tensfacpol(l)*E(l+1)) + 4._dl/(l*(l+1))*B(l))
-         end do
- !truncate
-         Eprime(EV%lmaxpolt)=0._dl
-         
-         
- !B-bar equations
-         
-         do l=2,EV%lmaxpolt-1
-         Bprime(l) =-opacity*B(l) + k*(denl(l)*(l*B(l-1) - &
-                         tensfacpol(l)*B(l+1)) - 4._dl/(l*(l+1))*E(l))
-         end do
- !truncate
-         Bprime(EV%lmaxpolt)=0._dl
- 
-        else
-         pig = 32._dl/45._dl*k/opacity*shear 
-         ayt(4) = pig   
-         E(2)=pig/4
- !  Set the derivatives to zero
-         aytprime(4:n)=0._dl
-         
-         endif
-      
- 
-         rhopi=grhog_t*pig 
- 
- !  Neutrino equations: 
- !  Anisotropic stress  
-         if (DoTensorNeutrinos) then
-         
-         neutprime => Bprime(EV%lmaxpolt:)
-         neut => B(EV%lmaxpolt:)
-                
- !  Massless neutrino anisotropic stress
-         pir=neut(2)
-         
-         rhopi=rhopi+grhor_t*pir
- 
-         pirdt=-1._dl/3._dl*k*neut(3)+ 8._dl/15._dl*k*shear
-         neutprime(2)=pirdt
- !  And for the moments
-         do  l=3,EV%lmaxnrt-1
-            neutprime(l)=k*denl(l)*(l*neut(l-1)- tensfac(l)*neut(l+1))
-         end do
-         !end if
- !  Truncate the hierarchy
-         neutprime(EV%lmaxnrt)=k*EV%lmaxnrt/(EV%lmaxnrt-2._dl)*neut(EV%lmaxnrt-1)-  &
-                        (EV%lmaxnrt+3._dl)*neut(EV%lmaxnrt)/tau
-     
- 
-         !  Massive neutrino equations of motion.
-          if (CP%Num_Nu_massive > 0) then
-           
-           do nu_i=1,CP%Nu_mass_eigenstates
- 
-               off_ix = (nu_i-1)*nqmax*(EV%lmaxnut-1)
-               do i=1,nqmax
-                 q=(i-0.5_dl)*dq
-                 aq=a*nu_masses(nu_i)/q
-                 v=1._dl/sqrt(1._dl+aq*aq)
-                 akv(i)=k*v
-               end do
-               do i=1,nqmax
-                ind=EV%iqt+i-1+off_ix                          
-                aytprime(ind)=-1._dl/3._dl*akv(i)*ayt(ind+nqmax)- 2._dl/15._dl*k*shear*dlfdlq(i)
-                ind=EV%iqt+i-1+(EV%lmaxnut-2)*nqmax +off_ix
-     !  Truncate moment expansion.
-                aytprime(ind)=akv(i)*EV%lmaxnut/(EV%lmaxnut-2._dl)*ayt(ind-nqmax)-(EV%lmaxnut+3)/tau*ayt(ind)
-               end do
-               do l=3,EV%lmaxnut-1
-                ind=EV%iqt-1+(l-2)*nqmax +off_ix
-                do i=1,nqmax
-                 ind=ind+1
-                 aytprime(ind)=akv(i)*denl(l)*(l*ayt(ind-nqmax)-tensfac(l)*ayt(ind+nqmax))     
-                end do
-               end do
- 
-               call Nu_Shear(a*nu_masses(nu_i),shearnu,ayt(EV%iqt+off_ix))                 
-               rhopi=rhopi+ grhormass(nu_i)/a2*1.5_dl*shearnu  
-  
-           end do
-                       
-          end if
-        end if
-       
- !  Get the propagation equation for the shear
-                          
-         aytprime(3)=-2*adotoa*shear+k*Hchi-rhopi/k   
- 
-         if (finished_tightcoupling) then
- !  Use the full expression for pigdt
-            EV%tenspigdot=aytprime(4)
-         else
- !  Use the tight-coupling approximation
-            EV%tenspigdot= 32._dl/45._dl*k/opacity*(2._dl*adotoa*shear+aytprime(3))
-          endif
- 
-         aytprime(2)=-k*shear
- 
- 
- end subroutine fderivst
-       
- 
-         subroutine fderivsv(EV,n,tau,yv,yvprime)
- !  Evaluate the time derivatives of the vector perturbations, flat case
-         use ThermoData
-         use MassiveNu
-         implicit none      
-         type(EvolutionVars) EV
-         integer n,l
-         real(dl), target ::  yv(n),yvprime(n)
-         real(dl) ep,tau,grho,rhopi,cs2,opacity,gpres
-         logical finished_tightcoupling
-         real(dl), dimension(:),pointer :: neut,neutprime,E,B,Eprime,Bprime
-         real(dl)  grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,polter
-         real(dl) sigma, qg,pig, qr, vb, rhoq, vbdot, photbar, pb43
-         real(dl) k,k2,a,a2, adotdota
-         real(dl) pir,adotoa  
-    
-          k2=EV%k2_buf
-          k=EV%k_buf       
- 
-         !E and B start at l=2. Set up pointers accordingly to fill in y arrays
-         E => yv(EV%lmaxv+3:)
-         Eprime=> yvprime(EV%lmaxv+3:) 
-         B => E(EV%lmaxpolv:)
-         Bprime => Eprime(EV%lmaxpolv:)
-         neutprime => Bprime(EV%lmaxpolv+1:)
-         neut => B(EV%lmaxpolv+1:)
-             
-         a=yv(1)        
- 
-         sigma=yv(2)
- 
-         a2=a*a
- 
- !  Get sound speed and opacity, and see if should use tight-coupling
-              
-         call thermo(tau,cs2,opacity)
-         if (k > 0.06_dl*epsw) then
-            ep=ep0
-         else
-            ep=0.2_dl*ep0
-         end if
-    
-         finished_tightcoupling = &
-          ((k/opacity > ep).or.(1._dl/(opacity*tau) > ep .and. k/opacity > 1d-4)) 
- 
- 
- ! Compute expansion rate from: grho=8*pi*rho*a**2
- ! Also calculate gpres: 8*pi*p*a**2
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         grhov_t=grhov*a**(-1-3*w_lam)
- 
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
-         gpres=(grhog_t+grhor_t)/3._dl+grhov_t*w_lam 
- 
-         adotoa=sqrt(grho/3._dl)
-         adotdota=(adotoa*adotoa-gpres)/2
- 
-         photbar=grhog_t/grhob_t
-         pb43=4._dl/3*photbar
-        
-         yvprime(1)=adotoa*a
-      
-         vb = yv(3)
-         qg = yv(4)         
-         qr = neut(1)
- 
- !  8*pi*a*a*SUM[(rho_i+p_i)*v_i]
-         rhoq=grhob_t*vb+grhog_t*qg+grhor_t*qr
-      !  sigma = 2*rhoq/k**2
-         !for non-large k this expression for sigma is unstable at early times
-         !so propagate sigma equation separately (near total cancellation in rhoq)
-         ! print *,yv(2),2*rhoq/k**2
- 
-         if (finished_tightcoupling) then
- !  Use explicit equations:
- 
-         pig = yv(5) 
- 
-         polter = 0.1_dl*pig + 9._dl/15._dl*E(2)
- 
-         vbdot = -adotoa*vb-photbar*opacity*(4._dl/3*vb-qg) - 0.5_dl*k*photbar*Magnetic
- 
- !  Equation for the photon heat flux stress
-   
-          yvprime(4)=-0.5_dl*k*pig + opacity*(4._dl/3*vb-qg) 
-       
- !  Equation for the photon anisotropic stress
-         yvprime(5)=k*(2._dl/5*qg -8/15._dl*yv(6))+8._dl/15._dl*k*sigma  &
-                   -opacity*(pig - polter)
- ! And for the moments            
-         do  l=3,EV%lmaxv-1
-            yvprime(l+3)=k*denl(l)*l*(yv(l+2)-   &
-                   vecfac(l)*yv(l+4))-opacity*yv(l+3)
-         end do
- !  Truncate the hierarchy
-         yvprime(EV%lmaxv+3)=k*EV%lmaxv/(EV%lmaxv-1._dl)*yv(EV%lmaxv+2)- &
-                        (EV%lmaxv+2._dl)*yv(EV%lmaxv+3)/tau-opacity*yv(EV%lmaxv+3)
-      
- !E equations
-    
-         Eprime(2) = - opacity*(E(2) - polter) + k*(1/3._dl*B(2) - &
-                         8._dl/27._dl*E(3))
-         do l=3,EV%lmaxpolv-1
-         Eprime(l) =-opacity*E(l) + k*(denl(l)*(l*E(l-1) - &
-                         vecfacpol(l)*E(l+1)) + 2._dl/(l*(l+1))*B(l))
-         end do
- !truncate
-         Eprime(EV%lmaxpolv)=0._dl
-                 
- !B-bar equations
-         
-         do l=2,EV%lmaxpolv-1
-         Bprime(l) =-opacity*B(l) + k*(denl(l)*(l*B(l-1) - &
-                         vecfacpol(l)*B(l+1)) - 2._dl/(l*(l+1))*E(l))
-         end do
- !truncate
-         Bprime(EV%lmaxpolv)=0._dl
- 
-        else
- 
- !Tight coupling expansion results
- 
-         pig = 32._dl/45._dl*k/opacity*(vb + sigma)
- 
-         EV%pig = pig
- 
-         vbdot=(-adotoa*vb  -3._dl/8*pb43*k*Magnetic  -3._dl/8*k*pb43*pig &
-                 - pb43/(1+pb43)/opacity*(0.75_dl*k*adotoa*pb43**2/(pb43+1)*Magnetic + vb*&
-               ( 2*pb43*adotoa**2/(1+pb43) + adotdota)) &
-                   )/(1+pb43) 
- 
- !  Equation for the photon heat flux
- ! Get drag from vbdot expression 
-         yvprime(4)=-0.5_dl*k*pig - &
-            (vbdot+adotoa*vb)/photbar - 0.5_dl*k*Magnetic
- 
- !  Set the derivatives to zero
-         yvprime(5:n)=0._dl
-         yv(5)=pig
-         E(2)=  pig/4 
-         
-         endif
-  
-         yvprime(3) = vbdot
- 
- !  Neutrino equations: 
-                
- !  Massless neutrino anisotropic stress
-         pir=neut(2)
-         neutprime(1)= -0.5_dl*k*pir
-         neutprime(2)=2._dl/5*k*qr -8._dl/15._dl*k*neut(3)+ 8._dl/15._dl*k*sigma
- !  And for the moments
-         do  l=3,EV%lmaxnrv-1
-            neutprime(l)=k*denl(l)*l*(neut(l-1)- vecfac(l)*neut(l+1))
-         end do
-         
- !  Truncate the hierarchy
-         neutprime(EV%lmaxnrv)=k*EV%lmaxnrv/(EV%lmaxnrv-1._dl)*neut(EV%lmaxnrv-1)-  &
-                        (EV%lmaxnrv+2._dl)*neut(EV%lmaxnrv)/tau
- 
-     
- !  Get the propagation equation for the shear
-             
-         rhopi=grhog_t*pig+grhor_t*pir+ grhog_t*Magnetic
-                       
-         yvprime(2)=-2*adotoa*sigma -rhopi/k
- 
-        end subroutine fderivsv
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine derivs(EV,n,tau,ay,ayprime)
- !  Evaluate the time derivatives of the perturbations.
- !ayprime is not necessarily GaugeInterface.yprime, so keep them distinct
-         use ThermoData
-         use MassiveNu
-         implicit none      
-         type(EvolutionVars) EV
- 
-         integer n, nu_i, ix_off
-         real(dl) ay(n),ayprime(n)
-         real(dl) tau,w
-         real(dl) k,k2 
- 
- !  Internal variables.
- 
-         real(dl) opacity
-         real(dl) photbar,cs2,pb43,grho,slip,clxgdot, &
-                       clxcdot,clxbdot,adotdota,gpres,clxrdot,etak
-         real(dl) q,aq,v,akv(nqmax0)
-         real(dl) G11_t,G30_t, wnu_arr(max_nu)
- 
-         real(dl) dgq,grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,sigma,polter
-         real(dl) qgdot,qrdot,pigdot,pirdot,vbdot,dgrho,adotoa
-         real(dl) a,a2,z,clxc,clxb,vb,clxg,qg,pig,clxr,qr,pir
-         real(dl) f
-         real(dl) clxq, vq,  E2, dopacity
-         integer l,i,ind, off_ix
-   
-         real(dl) cothxor
- 
-    
-         k2=EV%k2_buf
-         k=EV%k_buf
- 
-         cothxor=1._dl/tanfunc(tau/CP%r)/CP%r      
-       
-         a=ay(1)
-         a2=a*a
- 
-         etak=ay(2)
- 
- !  CDM variables
-         clxc=ay(3)
- 
- !  Baryon variables
-         clxb=ay(4)
-         vb=ay(5)
- 
- !  Compute expansion rate from: grho 8*pi*rho*a**2
- 
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         grhov_t=grhov*a**(-1-3*w_lam)
-    
-         if (EV%no_rad_multpoles) then
-          clxg=2*(grhoc_t*clxc+grhob_t*clxb)/3/k**2
-          clxr=clxg
-          qg= clxg*k/sqrt((grhoc_t+grhob_t)/3)*(2/3._dl)
-          qr=qg
-          pig=0
-          E2=0
-          pir=0
-        else
- !  Photons
-         clxg=ay(6)
-         qg=ay(7)
-         pig=ay(8)
-         E2=ay(EV%polind+2)
- !  Massless neutrinos
-         clxr=ay(7+EV%lmaxg)
-         qr=ay(8+EV%lmaxg)
-         pir=ay(9+EV%lmaxg)
-         end if
- 
- !  Get sound speed and ionisation fraction.
-         if (EV%TightCoupling) then
-           call thermo(tau,cs2,opacity,dopacity)
-          else
-           call thermo(tau,cs2,opacity)        
-         end if
-         
-         
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
- 
- !  Photon mass density over baryon mass density
-         photbar=grhog_t/grhob_t
-         pb43=4._dl/3._dl*photbar        
-      
- !  8*pi*a*a*SUM[rho_i*clx_i]
-         dgrho=grhob_t*clxb+grhoc_t*clxc + grhog_t*clxg+grhor_t*clxr
- 
- !  8*pi*a*a*SUM[(rho_i+p_i)*v_i]
-         dgq=grhob_t*vb+grhog_t*qg+grhor_t*qr
- 
-         gpres=0
-         
-         if (CP%Num_Nu_Massive > 0) then
-            call MassiveNuVars(EV,ay,a,grho,gpres,dgrho,dgq, wnu_arr)
-         end if
- 
-        
-         adotoa=sqrt((grho+grhok)/3._dl)
-         ayprime(1)=adotoa*a
- 
- 
-         if (EV%FirstZerolForBeta <= EV%MaxlNeeded) ayprime(8:EV%ScalEqsToPropagate)=0 !bit lazy this
- 
-         if (w_lam /= -1 .and. w_Perturb) then
-            clxq=ay(EV%w_ix)
-            vq=ay(EV%w_ix+1) 
-            dgrho=dgrho + clxq*grhov_t
-            dgq = dgq + vq*grhov_t*(1+w_lam)
-         end if
- 
- !  Get sigma (shear) and z from the constraints
- !  have to get z from eta for numerical stability       
-         z=(0.5_dl*dgrho/k + etak)/adotoa 
-         sigma=(z+1.5_dl*dgq/k2)/EV%Kf(1)
-         
-         if (w_lam /= -1.and. w_Perturb ) then
-            ayprime(EV%w_ix)= -3*adotoa*(cs2_lam-w_lam)*(clxq+3*adotoa*(1+w_lam)*vq/k) &
-                -(1+w_lam)*k*vq -(1+w_lam)*k*z
-            ayprime(EV%w_ix+1) = -adotoa*(1-3*cs2_lam)*vq + k*cs2_lam*clxq/(1+w_lam)
-         end if
-  
- !  eta*k equation
-         ayprime(2)=0.5_dl*dgq + CP%curv*z
- 
- !  CDM equation of motion
-         clxcdot=-k*z
-         ayprime(3)=clxcdot
- !  Baryon equation of motion.
-         clxbdot=-k*(z+vb)
-         ayprime(4)=clxbdot
- !  Photon equation of motion
-         clxgdot=-k*(4._dl/3._dl*z+qg)
- 
- !  Use explicit equation for vb if appropriate
-         
-         if (EV%TightCoupling) then
-   
-             pig = 32._dl/45/opacity*k*(sigma+vb)
-             E2 = pig/4
-             EV%pig = pig
- 
-     !  Use tight-coupling approximation for vb
-     !  zeroth order (in t_c) approximation to vbdot
-             vbdot=(-adotoa*vb+cs2*k*clxb  &
-                  +k/4*pb43*(clxg-2*EV%Kf(1)*pig))/(1._dl+pb43) 
- 
-     !  ddota/a
-             gpres=gpres+ (grhog_t+grhor_t)/3 +grhov_t*w_lam
-             adotdota=0.5_dl*(adotoa*adotoa-gpres)
- 
-             slip = - (2*adotoa/(1+pb43) + dopacity/opacity)*(vb-3._dl/4*qg) &
-                  +(-adotdota*vb-k/2*adotoa*clxg +k*(cs2*clxbdot-clxgdot/4))/(opacity*(1+pb43))
- 
-     !  First-order approximation to vbdot
-             vbdot=vbdot+pb43/(1._dl+pb43)*slip
- 
-         else
- 
-          vbdot=-adotoa*vb+cs2*k*clxb-photbar*opacity*(4._dl/3._dl*vb-qg)
-           
-         end if
-         ayprime(5)=vbdot
- 
-        if (EV%no_rad_multpoles) then
- 
-          if (CP%Num_Nu_massive/=0) then
-            ayprime(6:EV%polind+EV%lmaxgpol)=0._dl
-          end if
- 
-        else
- 
- !  Photon equations of motion
-         ayprime(6)=clxgdot
-         qgdot=4._dl/3._dl*(-vbdot-adotoa*vb+cs2*k*clxb)/pb43 &
-             +k*(clxg-2._dl*pig*EV%Kf(1))/3._dl
-         ayprime(7)=qgdot
- 
- !  Use explicit equations for photon moments if appropriate
-         
-         if (EV%tightcoupling) then
- 
-     !  Use tight-coupling approximation where moments are zero for l>1
-             pigdot=0        
-             ayprime(8:EV%lmaxg+6)=0
-        
-         else
- 
-             polter = 0.1_dl*pig+9._dl/15._dl*E2 !2/15*(3/4 pig + 9/2 E2)
- 
-             pigdot=0.4_dl*k*qg-0.6_dl*k*EV%Kf(2)*ay(9)-opacity*(pig - polter) &
-                    +8._dl/15._dl*k*sigma
-             ayprime(8)=pigdot
-             do  l=3,min(EV%FirstZerolForBeta,EV%lmaxg)-1
-                ayprime(l+6)=k*denl(l)*(l*ay(l+5)-(l+1)*EV%Kf(l)*ay(l+7))-opacity*ay(l+6)
-             end do
-     !  Truncate the photon moment expansion
-             if (EV%lmaxg/=EV%FirstZerolForBeta) then
-           
-               ayprime(EV%lmaxg+6)=k*ay(EV%lmaxg+5)-(EV%lmaxg+1)*cothxor*ay(EV%lmaxg+6)  &
-                            -opacity*ay(EV%lmaxg+6)
-             end if
-         
-         end if
- 
- !  Massless neutrino equations of motion.
-         clxrdot=-k*(4._dl/3._dl*z+qr)
-         ayprime(EV%lmaxg+7)=clxrdot
-         qrdot=k*(clxr-2._dl*pir*EV%Kf(1))/3._dl
-         ayprime(EV%lmaxg+8)=qrdot
-         pirdot=k*(0.4_dl*qr-0.6_dl*EV%Kf(2)*ay(EV%lmaxg+10)+8._dl/15._dl*sigma)
-         ayprime(EV%lmaxg+9)=pirdot
-         do l=3,min(EV%FirstZerolForBeta,EV%lmaxnr)-1
-            ayprime(l+EV%lmaxg+7)=k*denl(l)*(l*ay(l+EV%lmaxg+6) -(l+1)*EV%Kf(l)*ay(l+EV%lmaxg+8))
-         end do   
- !  Truncate the neutrino expansion  
-         if (EV%lmaxnr/=EV%FirstZerolForBeta) then
-         
-          ayprime(EV%lmaxnr+EV%lmaxg+7)=k*ay(EV%lmaxnr+EV%lmaxg+6)- &
-                                 (EV%lmaxnr+1)*cothxor*ay(EV%lmaxnr+EV%lmaxg+7)
-         end if
- 
- !  Polarization
-         if (EV%TightCoupling) then     
- 
-              ayprime(EV%polind+2:EV%polind+EV%lmaxgpol)=0
- 
-         else
-             !l=2 (defined to be zero for l<2)
-              ayprime(EV%polind+2) = -opacity*(ay(EV%polind+2) - polter) - k/3._dl*EV%Kf(2)*ay(EV%polind+3)
-             !and the rest
-             do l=3,min(EV%FirstZerolForBeta,EV%lmaxgpol)-1
-                ayprime(EV%polind+l)=-opacity*ay(EV%polind+l) + k*denl(l)*(l*ay(EV%polind+l-1) -&
-                               polfac(l)*EV%Kf(l)*ay(EV%polind+l+1))
-             end do  
-         
-             !truncate
-             if (EV%lmaxgpol/=EV%FirstZerolForBeta) then   
-          
-              ayprime(EV%polind+EV%lmaxgpol)=-opacity*ay(EV%polind+EV%lmaxgpol) +  &
-               k*EV%poltruncfac*ay(EV%polind+EV%lmaxgpol-1)-(EV%lmaxgpol+3)*cothxor*ay(EV%polind+EV%lmaxgpol)
-             end if
-         
-         end if
- 
-         end if !no_rad_multpoles
- 
- !  Massive neutrino equations of motion.
-         if (CP%Num_Nu_massive == 0) return
- 
-          do nu_i = 1, CP%Nu_mass_eigenstates
- 
-          if (EV%NuMethod == Nu_approx) then
- 
-             !crude approximation scheme
-             off_ix = EV%iq0+(nu_i-1)*(EV%lmaxnu+1)
- 
-             w=wnu_arr(nu_i)
-             f = (5._dl/3)**(a*nu_masses(nu_i)/(a*nu_masses(nu_i)+200)) &
-                 *(3*w)**((2+a*nu_masses(nu_i))/(4+a*nu_masses(nu_i))) 
- 
-             !clxnudot
-             ayprime(off_ix)=-(f-3*w)*adotoa*ay(off_ix)-k*((1+w)*z+ay(off_ix+1))
-             !qnudot
-             ayprime(off_ix+1)=-adotoa*(1-3*w)*ay(off_ix+1)+k/3._dl*(f*ay(off_ix)-2._dl*EV%Kf(1)*ay(off_ix+2))
-             !pinudot
- 
-             ayprime(off_ix+2)=-adotoa*(-f +2-3*w)*ay(off_ix+2) +  &
-                  k*(2._dl/5*f*ay(off_ix+1)-0.6_dl*EV%Kf(2)*ay(off_ix+3)+ 2._dl/5*w*(5-3*w)*sigma)
-  
-             do l=3,EV%lmaxnu-1
-                ayprime(off_ix+l)=-adotoa*((1-l)*f+l-3*w)*ay(off_ix+l) + &
-                     k*denl(l)*(f*l*ay(off_ix+l-1) -EV%Kf(l)*(l+1)*ay(off_ix+l+1))
-             end do
-             !  Truncate the neutrino expansion
-             ayprime(off_ix+EV%lmaxnu)=k*ay(off_ix+EV%lmaxnu-1)- &
-                  (EV%lmaxnu+1)*cothxor*ay(off_ix+EV%lmaxnu)
-          
-          else !Not approx scheme
- 
- 
-           if (EV%MassiveNuApprox) then
-              !Now EV%iq0 = clx, EV%iq0+1 = clxp, EV%iq0+2 = G_1, EV%iq0+3=G_2=pinu
-              G11_t=EV%G11(nu_i)/a2/a
-              G30_t=EV%G30(nu_i)/a2/a
-              off_ix = (nu_i-1)*4 + EV%iq0
-              w=wnu_arr(nu_i)
-              ayprime(off_ix)=-k*z*(w+1) + 3*adotoa*(w*ay(off_ix) - ay(off_ix+1))-k*ay(off_ix+2)
-              ayprime(off_ix+1)=(3*w-2)*adotoa*ay(off_ix+1) - 5._dl/3*k*z*w - k/3*G11_t
-              ayprime(off_ix+2)=(3*w-1)*adotoa*ay(off_ix+2) - k*(2._dl/3*EV%Kf(1)*ay(off_ix+3)-ay(off_ix+1))
-              ayprime(off_ix+3)=(3*w-2)*adotoa*ay(off_ix+3) + 2*w*k*sigma - k/5*(3*EV%Kf(2)*G30_t-2*G11_t)
-      
-           else
-           
-           
-           do i=1,nqmax
-             q=(i-0.5_dl)*dq
-             aq=a*nu_masses(nu_i)/q
-             v=1._dl/sqrt(1._dl+aq*aq)
-             akv(i)=k*v
-           end do
- 
-           ix_off=nqmax*(EV%lmaxnu+1)*(nu_i-1)
- 
- !  l = 0, 1, 2,EV%lmaxnu.
-           do i=1,nqmax             
-            ind=EV%iq0+i-1+ ix_off
-            ayprime(ind)=-akv(i)*ay(ind+nqmax)+z*k*dlfdlq(i)/3
-            ind=EV%iq1+i-1+ ix_off
-            ayprime(ind)=akv(i)*(ay(ind-nqmax)-2*EV%Kf(1)*ay(ind+nqmax))/3
-            ind=EV%iq2+i-1+ ix_off
-            ayprime(ind)=akv(i)*(2*ay(ind-nqmax)-3*EV%Kf(2)*ay(ind+nqmax))/5 &
-                  -k*2._dl/15._dl*sigma*dlfdlq(i)
-            ind=EV%iq0+i-1+EV%lmaxnu*nqmax+ ix_off
- !  Truncate moment expansion.
-            if (EV%lmaxnu<EV%FirstZerolForBeta) then
-              ayprime(ind)=akv(i)*ay(ind-nqmax)-(EV%lmaxnu+1)*cothxor*ay(ind)
-         
-            end if         
- 
-           end do
-           do l=3,min(EV%FirstZerolForBeta,EV%lmaxnu)-1
-            ind=EV%iq0-1+l*nqmax + ix_off
-             do i=1,nqmax
-              ind=ind+1
-              ayprime(ind)=akv(i)*denl(l)*(l*ay(ind-nqmax)-(l+1)*EV%Kf(l)*ay(ind+nqmax))
-             end do
-           end do  
- 
-           end if
-           end if
-           end do
- 
-         end subroutine derivs
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 
-         subroutine derivst(EV,n,tau,ayt,aytprime)
- !  Evaluate the time derivatives of the tensor perturbations.
-         use ThermoData
-         use MassiveNu
-         implicit none      
-         type(EvolutionVars) EV
-         integer n,l,i,ind, nu_i, off_ix
-         real(dl), target ::  ayt(n),aytprime(n)
-         real(dl) ep,tau,grho,rhopi,cs2,opacity,pirdt
-         logical finished_tightcoupling
-         real(dl), dimension(:),pointer :: neut,neutprime,E,B,Eprime,Bprime
-         real(dl) q,aq,v,akv(nqmax0)
-         real(dl)  grhob_t,grhor_t,grhoc_t,grhog_t,grhov_t,polter
-         real(dl) Hchi,shear, pig
-         real(dl) k,k2,a,a2
-         real(dl) pir, adotoa, rhonu, shearnu
- 
-         real(dl) aux, cothxor
- 
-       
-         k2=EV%k2_buf
-         k= EV%k_buf   
-         aux=EV%aux_buf 
- 
- 
-         !E and B start at l=2. Set up pointers accordingly to fill in ayt arrays
-         E => ayt(EV%lmaxt+3-1:)
-         Eprime=> aytprime(EV%lmaxt+3-1:) 
-         B => E(EV%lmaxpolt:)
-         Bprime => Eprime(EV%lmaxpolt:)
-       
-         cothxor=1._dl/tanfunc(tau/CP%r)/CP%r  
-        
-         a=ayt(1)        
- 
- !  Electric part of Weyl tensor and shear tensor
- !        elec=ayt(2)
- 
-         Hchi=ayt(2)  
- 
-         shear=ayt(3)
- !  Photon anisotropic stress
-         pig=ayt(4)
- 
-         a2=a*a
- 
- !  Get sound speed and opacity, and see if should use tight-coupling
-              
-         call thermo(tau,cs2,opacity)
-         if (k > 0.06_dl*epsw) then
-            ep=ep0
-         else
-            ep=0.2_dl*ep0
-         end if
- 
-         finished_tightcoupling = ((k/opacity > ep).or.(1._dl/(opacity*tau) > ep)) 
-         
- 
- ! Compute expansion rate from: grho=8*pi*rho*a**2
- ! Also calculate gpres: 8*pi*p*a**2
-         grhob_t=grhob/a
-         grhoc_t=grhoc/a
-         grhor_t=grhornomass/a2
-         grhog_t=grhog/a2
-         grhov_t=grhov*a**(-1-3*w_lam)
- 
-         grho=grhob_t+grhoc_t+grhor_t+grhog_t+grhov_t
-      
- !Do massive neutrinos
-         if (CP%Num_Nu_Massive >0) then
-          do nu_i=1,CP%Nu_mass_eigenstates
-            call Nu_rho(a*nu_masses(nu_i),rhonu)
-            grho=grho+grhormass(nu_i)*rhonu/a2
-          end do
-         end if
- 
-         adotoa=sqrt((grho+grhok)/3._dl)
- 
-         aytprime(1)=adotoa*a
-         polter = 0.1_dl*pig + 9._dl/15._dl*E(2)
- 
-         if (finished_tightcoupling) then
- !  Don't use tight coupling approx - use explicit equations:
- !  Equation for the photon anisotropic stress
-         aytprime(4)=k*(-1._dl/3._dl*EV%Kft(2)*ayt(5)+8._dl/15._dl*shear)  &
-                   -opacity*(pig - polter)
- 
- 
-         do l=3,min(EV%FirstZerolForBeta,EV%lmaxt)-1
-          aytprime(l+2)=k*denl(l)*(l*ayt(l+1)-   &
-                   tensfac(l)*EV%Kft(l)*ayt(l+3))-opacity*ayt(l+2)
-  
-         end do
- 
-         !Truncate the hierarchy 
-         if (EV%lmaxt/=EV%FirstZerolForBeta) then
-          aytprime(EV%lmaxt+2)=k*EV%lmaxt/(EV%lmaxt-2._dl)*ayt(EV%lmaxt+1)- &
-                        (EV%lmaxt+3._dl)*cothxor*ayt(EV%lmaxt+2)-opacity*ayt(EV%lmaxt+2)
-         end if
- 
- !E and B-bar equations
-      
-         Eprime(2) = - opacity*(E(2) - polter) + k*(4._dl/6._dl*aux*B(2) - &
-                         5._dl/27._dl*EV%Kft(2)*E(3))
-         
-         do l=3,min(EV%FirstZerolForBeta,EV%lmaxpolt)-1
-            Eprime(l) =-opacity*E(l) + k*(denl(l)*(l*E(l-1) - &
-                         tensfacpol(l)*EV%Kft(l)*E(l+1)) + 4._dl/(l*(l+1))*aux*B(l))
-    
-        end do
- 
- !truncate: difficult, but zetting to zero seems to work OK
-         Eprime(EV%lmaxpolt)=0._dl
-                     
-         do l=2,min(EV%FirstZerolForBeta,EV%lmaxpolt)-1
-         Bprime(l) =-opacity*B(l) + k*(denl(l)*(l*B(l-1) - &
-                    tensfacpol(l)*EV%Kft(l)*B(l+1)) - 4._dl/(l*(l+1))*aux*E(l))
-         end do
- 
- !truncate
-         Bprime(EV%lmaxpolt)=0._dl
-        
-         else  !Tight coupling
-         ayt(4)=32._dl/45._dl*k/opacity*shear  
-         E(2)=ayt(4)/4._dl
-         aytprime(4:n)=0._dl
-         
-         endif
-       
-       rhopi=grhog_t*pig 
- 
- 
- !  Neutrino equations: 
- !  Anisotropic stress
-         if (DoTensorNeutrinos) then
-         
-         neutprime => Bprime(EV%lmaxpolt:)
-         neut => B(EV%lmaxpolt:)
-         
-        
- !  Massless neutrino anisotropic stress
-         pir=neut(2)
- 
-         rhopi=rhopi+grhor_t*pir
- 
-         pirdt=k*(-1._dl/3._dl*EV%Kft(2)*neut(3)+ 8._dl/15._dl*shear)
-         neutprime(2)=pirdt
- !  And for the moments
-         do  l=3,min(EV%FirstZerolForBeta,EV%lmaxnrt)-1
-            neutprime(l)=k*denl(l)*(l*neut(l-1)- tensfac(l)*EV%Kft(l)*neut(l+1))
-         end do
-         
- !  Truncate the hierarchy
-         if (EV%lmaxnrt/=EV%FirstZerolForBeta) then
-         neutprime(EV%lmaxnrt)=k*EV%lmaxnrt/(EV%lmaxnrt-2._dl)*neut(EV%lmaxnrt-1)-  &
-                        (EV%lmaxnrt+3._dl)*cothxor*neut(EV%lmaxnrt)
-         endif
- 
- 
-          !  Massive neutrino equations of motion.
-          if (CP%Num_Nu_massive > 0) then
-           
-           do nu_i=1,CP%Nu_mass_eigenstates
- 
-               off_ix = (nu_i-1)*nqmax*(EV%lmaxnut-1)
- 
-               do i=1,nqmax
-                 q=(i-0.5_dl)*dq
-                 aq=a*nu_masses(nu_i)/q
-                 v=1._dl/sqrt(1._dl+aq*aq)
-                 akv(i)=k*v
-               end do
-               do i=1,nqmax
-                ind=EV%iqt+i-1+off_ix                          
-                aytprime(ind)=-1._dl/3._dl*akv(i)*EV%Kft(2)*ayt(ind+nqmax)- 2._dl/15._dl*k*shear*dlfdlq(i)
-                ind=EV%iqt+i-1+(EV%lmaxnut-2)*nqmax+off_ix
-     !  Truncate moment expansion.
-                if (EV%lmaxnut/=EV%FirstZerolForBeta) then
-                aytprime(ind)=akv(i)*EV%lmaxnut/(EV%lmaxnut-2._dl)*ayt(ind-nqmax)-(EV%lmaxnut+3)*cothxor*ayt(ind)
-                end if         
-               end do
-               do l=3,min(EV%FirstZerolForBeta,EV%lmaxnut)-1
-                ind=EV%iqt-1+(l-2)*nqmax +off_ix
-                 do i=1,nqmax
-                 ind=ind+1
-                 aytprime(ind)=akv(i)*denl(l)*(l*ayt(ind-nqmax)-tensfac(l)*EV%Kft(l)*ayt(ind+nqmax))     
-                end do
-               end do
- 
-                call Nu_Shear(a*nu_masses(nu_i),shearnu,ayt(EV%iqt+off_ix))                 
-                rhopi=rhopi+ grhormass(nu_i)/a2*1.5_dl*shearnu  
-           
-           end do
-                       
-          end if
-         end if
-              
- !  Get the propagation equation for the shear
-         
-         aytprime(3)=-2*adotoa*shear+k*Hchi*(1+2*CP%curv/k2)-rhopi/k   
- 
- 
- !  And the electric part of the Weyl.
-         if (finished_tightcoupling) then
- !  Use the full expression for pigdt
-            EV%tenspigdot=aytprime(4)
-         else
- !  Use the tight-coupling approximation
-            EV%tenspigdot=32._dl/45._dl*k/opacity*(2._dl*adotoa*shear+aytprime(3))
-         endif
- 
-         aytprime(2)=-k*shear
- 
-         end subroutine derivst
- 
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         end module GaugeInterface
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/halofit.f90 cosmomc_sampler/camb/halofit.f90
*** cosmomc/camb/halofit.f90	2009-10-22 20:37:41.000000000 +0200
--- cosmomc_sampler/camb/halofit.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,250 ****
- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- ! The `halofit' code models the nonlinear evolution of cold matter 
- ! cosmological power spectra. The full details of the way in which 
- ! this is done are presented in Smith et al. (2002), MNRAS, ?, ?. 
- !
- ! The code `halofit' was written by R. E. Smith & J. A. Peacock. 
- ! See http://www.astro.upenn.edu/~res, 
- ! Last edited 8/5/2002.
- 
- ! Only tested for plain LCDM models with power law initial power spectra
- 
- ! Adapted for F90 and CAMB, AL March 2005
- !!BR09 Oct 09: generalized expressions for om(z) and ol(z) to include w
- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- 
-       module NonLinear
-       use ModelParams
-       use transfer
-       use LambdaGeneral
-       implicit none 
-       private
-        
-        real, parameter :: Min_kh_nonlinear = 0.005
-        real(dl):: om_m,om_v
- 
-       public Min_kh_nonlinear,NonLinear_GetNonLinRatios
-       
-       contains
- 
-      subroutine NonLinear_GetNonLinRatios(CAMB_Pk)
-      !Fill the CAMB_Pk%nonlin_scaling array with sqrt(non-linear power/linear power)
-      !for each redshift and wavenumber
-      !This implementation uses Halofit
-       type(MatterPowerData) :: CAMB_Pk
-       integer itf
-       real(dl) a, omm0,plin,pq,ph,pnl,rk
-       real(dl) sig,rknl,rneff,rncur,d1,d2
-       real(dl) diff,xlogr1,xlogr2,rmid
-       integer i
- 
-        !!BR09 putting neutrinos into the matter as well, not sure if this is correct, but at least one will get a consisent omk.
-        omm0 = CP%omegac+CP%omegab+CP%omegan
- 
-        CAMB_Pk%nonlin_ratio = 1
- 
-        do itf = 1, CAMB_Pk%num_z
- 
- 
- ! calculate nonlinear wavenumber (rknl), effective spectral index (rneff) and 
- ! curvature (rncur) of the power spectrum at the desired redshift, using method 
- ! described in Smith et al (2002).
-        a = 1/real(1+CAMB_Pk%Redshifts(itf),dl)
-        om_m = omega_m(a, omm0, CP%omegav, w_lam)  
-        om_v = omega_v(a, omm0, CP%omegav, w_lam)
- 
-       xlogr1=-2.0
-       xlogr2=3.5
-       do
-           rmid=(xlogr2+xlogr1)/2.0
-           rmid=10**rmid
-           call wint(CAMB_Pk,itf,rmid,sig,d1,d2)
-           diff=sig-1.0
-           if (abs(diff).le.0.001) then
-              rknl=1./rmid
-              rneff=-3-d1
-              rncur=-d2                  
-              exit
-           elseif (diff.gt.0.001) then
-              xlogr1=log10(rmid)
-           elseif (diff.lt.-0.001) then
-              xlogr2=log10(rmid)
-           endif
-           if (xlogr2 < -1.9999) then
-                !is still linear, exit
-                goto 101
-          end if
-       end do
- 
- ! now calculate power spectra for a logarithmic range of wavenumbers (rk)
- 
-       do i=1, CAMB_PK%num_k
-          rk = exp(CAMB_Pk%log_kh(i))
- 
-          if (rk > Min_kh_nonlinear) then
- 
-     ! linear power spectrum !! Remeber => plin = k^3 * P(k) * constant
-     ! constant = 4*pi*V/(2*pi)^3 
- 
-              plin= MatterPowerData_k(CAMB_PK, rk, itf)*(rk**3/(2*pi**2)) 
- 
-     ! calculate nonlinear power according to halofit: pnl = pq + ph,
-     ! where pq represents the quasi-linear (halo-halo) power and 
-     ! where ph is represents the self-correlation halo term. 
-  
-              call halofit(rk,rneff,rncur,rknl,plin,pnl,pq,ph)   ! halo fitting formula 
-              CAMB_Pk%nonlin_ratio(i,itf) = sqrt(pnl/plin)
- 
-          end if
- 
-       enddo
- 
- 101   continue
-       end do
-             
-       end subroutine NonLinear_GetNonLinRatios
-        
- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- 
- ! halo model nonlinear fitting formula as described in 
- ! Appendix C of Smith et al. (2002)
- 
-       subroutine halofit(rk,rn,rncur,rknl,plin,pnl,pq,ph)
-       implicit none
- 
-       real(dl) gam,a,b,c,xmu,xnu,alpha,beta,f1,f2,f3
-       real(dl) rk,rn,plin,pnl,pq,ph
-       real(dl) rknl,y,rncur
-       real(dl) f1a,f2a,f3a,f1b,f2b,f3b,frac
- 
-       gam=0.86485+0.2989*rn+0.1631*rncur
-       a=1.4861+1.83693*rn+1.67618*rn*rn+0.7940*rn*rn*rn+ &
-            0.1670756*rn*rn*rn*rn-0.620695*rncur
-       a=10**a      
-       b=10**(0.9463+0.9466*rn+0.3084*rn*rn-0.940*rncur)
-       c=10**(-0.2807+0.6669*rn+0.3214*rn*rn-0.0793*rncur)
-       xmu=10**(-3.54419+0.19086*rn)
-       xnu=10**(0.95897+1.2857*rn)
-       alpha=1.38848+0.3701*rn-0.1452*rn*rn
-       beta=0.8291+0.9854*rn+0.3400*rn**2
- 
-       if(abs(1-om_m).gt.0.01) then ! omega evolution 
-          f1a=om_m**(-0.0732)
-          f2a=om_m**(-0.1423)
-          f3a=om_m**(0.0725)
-          f1b=om_m**(-0.0307)
-          f2b=om_m**(-0.0585)
-          f3b=om_m**(0.0743)       
-          frac=om_v/(1.-om_m) 
-          f1=frac*f1b + (1-frac)*f1a
-          f2=frac*f2b + (1-frac)*f2a
-          f3=frac*f3b + (1-frac)*f3a
-       else         
-          f1=1.0
-          f2=1.
-          f3=1.
-       endif
- 
-       y=(rk/rknl)
- 
-       ph=a*y**(f1*3)/(1+b*y**(f2)+(f3*c*y)**(3-gam))
-       ph=ph/(1+xmu*y**(-1)+xnu*y**(-2))
-       pq=plin*(1+plin)**beta/(1+plin*alpha)*exp(-y/4.0-y**2/8.0)
- 
-       pnl=pq+ph
- 
-       end subroutine halofit       
- 
- 
- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- 
- ! The subroutine wint, finds the effective spectral quantities
- ! rknl, rneff & rncur. This it does by calculating the radius of 
- ! the Gaussian filter at which the variance is unity = rknl.
- ! rneff is defined as the first derivative of the variance, calculated 
- ! at the nonlinear wavenumber and similarly the rncur is the second
- ! derivative at the nonlinear wavenumber. 
- 
-       subroutine wint(CAMB_Pk,itf,r,sig,d1,d2)
-       implicit none
-       integer, intent(in) :: itf
-       type(MatterPowerData) :: CAMB_Pk
-       real(dl) sum1,sum2,sum3,t,y,x,w1,w2,w3
-       real(dl) x2,rk, fac,r, sig, d1,d2, anorm
-       integer i,nint
- 
-       nint=3000
-       sum1=0.d0
-       sum2=0.d0
-       sum3=0.d0
-       anorm = 1/(2*pi**2)
-       do i=1,nint
-          t=(i-0.5_dl)/nint
-          y=-1.d0+1.d0/t
-          rk=y
-          d2=MatterPowerData_k(CAMB_PK, rk, itf)*(rk**3*anorm) 
-          x=y*r
-          x2=x*x
-          w1=exp(-x2)
-          w2=2*x2*w1
-          w3=4*x2*(1-x2)*w1
-          fac=d2/y/t/t
-          sum1=sum1+w1*fac
-          sum2=sum2+w2*fac
-          sum3=sum3+w3*fac
-       enddo
-       sum1=sum1/nint
-       sum2=sum2/nint
-       sum3=sum3/nint
-       sig=sqrt(sum1)
-       d1=-sum2/sum1
-       d2=-sum2*sum2/sum1/sum1 - sum3/sum1
-       
-       end subroutine wint
-       
- !!BR09 generalize to constant w
- 
-       function omega_m(aa,om_m0,om_v0,wval)
-       implicit none
-       real(dl) omega_m,omega_t,om_m0,om_v0,aa,wval
-       omega_t=1.0+(om_m0+om_v0-1.0)/(1-om_m0-om_v0+om_v0*((aa)**(-1.0-3.0*wval))+om_m0/aa)
-       omega_m=omega_t*om_m0/(om_m0+om_v0*((aa)**(-3.0*wval)))
-       end function omega_m
- 
- !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- 
- ! evolution of omega lambda with expansion factor
- 
-       function omega_v(aa,om_m0,om_v0,wval)      
-       implicit none
-       real(dl) aa,omega_v,om_m0,om_v0,omega_t,wval
-       omega_t=1.0+(om_m0+om_v0-1.0)/(1-om_m0-om_v0+om_v0*((aa)**(-1.0-3.0*wval))+om_m0/aa)
-       omega_v=omega_t*om_v0*((aa)**(-3.0-3.0*wval))/(om_v0*((aa)**(-3.0-3.0*wval))+om_m0/aa/aa/aa)
-       end function omega_v
- 
- !!BR09 end generalize to constant w
- 
- end module NonLinear
- 
- 
- !workaround for f90 circular-module reference
-      subroutine NonLinear_GetRatios(CAMB_Pk)
-       use Transfer
-       use NonLinear
-       type(MatterPowerData) :: CAMB_Pk
- 
-       call NonLinear_GetNonLinRatios(CAMB_Pk)      
- 
-      end subroutine NonLinear_GetRatios
-      
- 
- 
-      subroutine NonLinear_GetRatios_all(CAMB_Pk)
-       use Transfer
-       use NonLinear
-       type(MatterPowerData) :: CAMB_Pk
- 
-        stop 'Halofit module doesn''t support non-linear velocities'
- 
-      end subroutine NonLinear_GetRatios_All
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/inidriver.F90 cosmomc_sampler/camb/inidriver.F90
*** cosmomc/camb/inidriver.F90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/inidriver.F90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,314 ****
- !     Code for Anisotropies in the Microwave Background
- !     by Antony Lewis (http://cosmologist.info/) and Anthony Challinor
- !     See readme.html for documentation. This is a sample driver routine that reads
- !     in one set of parameters and produdes the corresponding output. 
- 
-     program driver
-         use IniFile
-         use CAMB
-         use LambdaGeneral
-         use Lensing
-         use AMLUtils
-         use Transfer
- #ifdef NAGF95
-         use F90_UNIX
- #endif
-         implicit none
-       
-         Type(CAMBparams) P
-         
-         character(LEN=Ini_max_string_len) numstr, VectorFileName, &
-             InputFile, ScalarFileName, TensorFileName, TotalFileName, LensedFileName,&
-             LensedTotFileName
-         integer i
-         character(LEN=Ini_max_string_len) TransferFileNames(max_transfer_redshifts), &
-                MatterPowerFileNames(max_transfer_redshifts), outroot
-         real(dl) output_factor, Age
- 
- #ifdef WRITE_FITS
-        character(LEN=Ini_max_string_len) FITSfilename
- #endif
- 
-         logical bad
- 
-         InputFile = ''
-    
-         if (iargc() /= 0)  call getarg(1,InputFile)
-         if (InputFile == '') stop 'No parameter input file'
- 
-         call Ini_Open(InputFile, 1, bad, .false.)
-         if (bad) stop 'Error opening parameter file'
- 
-         Ini_fail_on_not_found = .false.
-     
-         outroot = Ini_Read_String('output_root')
-         if (outroot /= '') outroot = trim(outroot) // '_'
-         
-         call CAMB_SetDefParams(P)
- 
-         P%WantScalars = Ini_Read_Logical('get_scalar_cls')
-         P%WantVectors = Ini_Read_Logical('get_vector_cls',.false.)
-         P%WantTensors = Ini_Read_Logical('get_tensor_cls',.false.)
-         
-         P%OutputNormalization=outNone
-         if (Ini_Read_Logical('COBE_normalize',.false.))  P%OutputNormalization=outCOBE
-         output_factor = Ini_Read_Double('CMB_outputscale',1.d0)
- 
-         P%WantCls= P%WantScalars .or. P%WantTensors .or. P%WantVectors
- 
-         P%WantTransfer=Ini_Read_Logical('get_transfer')
-         
-         P%NonLinear = Ini_Read_Int('do_nonlinear',NonLinear_none)
-    
-         P%DoLensing = .false.
-         if (P%WantCls) then
-           if (P%WantScalars  .or. P%WantVectors) then
-            P%Max_l = Ini_Read_Int('l_max_scalar')
-            P%Max_eta_k = Ini_Read_Double('k_eta_max_scalar',P%Max_l*2._dl)
-            if (P%WantScalars) then
-              P%DoLensing = Ini_Read_Logical('do_lensing',.false.)
-              if (P%DoLensing) lensing_method = Ini_Read_Int('lensing_method',1)
-            end if
-            if (P%WantVectors) then
-             if (P%WantScalars .or. P%WantTensors) stop 'Must generate vector modes on their own'
-             i = Ini_Read_Int('vector_mode')
-             if (i==0) then 
-               vec_sig0 = 1
-               Magnetic = 0
-             else if (i==1) then
-               Magnetic = -1
-               vec_sig0 = 0
-             else
-               stop 'vector_mode must be 0 (regular) or 1 (magnetic)'
-             end if 
-            end if
-           end if
- 
-           if (P%WantTensors) then
-            P%Max_l_tensor = Ini_Read_Int('l_max_tensor')
-            P%Max_eta_k_tensor =  Ini_Read_Double('k_eta_max_tensor',Max(500._dl,P%Max_l_tensor*2._dl))
-           end if
-         endif
- 
-                 
- !  Read initial parameters.
-        
-        w_lam = Ini_Read_Double('w', -1.d0)   
-        cs2_lam = Ini_Read_Double('cs2_lam',1.d0)
- 
-        P%h0     = Ini_Read_Double('hubble')
-  
-        if (Ini_Read_Logical('use_physical',.false.)) then 
- 
-         P%omegab = Ini_Read_Double('ombh2')/(P%H0/100)**2
-         P%omegac = Ini_Read_Double('omch2')/(P%H0/100)**2
-         P%omegan = Ini_Read_Double('omnuh2')/(P%H0/100)**2
-         P%omegav = 1- Ini_Read_Double('omk') - P%omegab-P%omegac - P%omegan
-   
-        else
-        
-         P%omegab = Ini_Read_Double('omega_baryon')
-         P%omegac = Ini_Read_Double('omega_cdm')
-         P%omegav = Ini_Read_Double('omega_lambda')
-         P%omegan = Ini_Read_Double('omega_neutrino')
- 
-        end if
- 
-        P%tcmb   = Ini_Read_Double('temp_cmb',2.726_dl)
-        P%yhe    = Ini_Read_Double('helium_fraction',0.24_dl)
-        P%Num_Nu_massless  = Ini_Read_Double('massless_neutrinos')
-        P%Num_Nu_massive   = Ini_Read_Double('massive_neutrinos')
-    
-        P%nu_mass_splittings = .true.
-        P%Nu_mass_eigenstates = Ini_Read_Int('nu_mass_eigenstates',1)
-        if (P%Nu_mass_eigenstates > max_nu) stop 'too many mass eigenstates'
-        numstr = Ini_Read_String('nu_mass_degeneracies')
-        if (numstr=='') then
-          P%Nu_mass_degeneracies(1)= P%Num_nu_massive
-        else
-         read(numstr,*) P%Nu_mass_degeneracies(1:P%Nu_mass_eigenstates)
-        end if
-        numstr = Ini_read_String('nu_mass_fractions')
-        if (numstr=='') then
-         P%Nu_mass_fractions(1)=1  
-         if (P%Nu_mass_eigenstates >1) stop 'must give nu_mass_fractions for the eigenstates'
-        else
-         read(numstr,*) P%Nu_mass_fractions(1:P%Nu_mass_eigenstates)
-        end if
- 
-        if (P%NonLinear==NonLinear_lens .and. P%DoLensing) then
-           if (P%WantTransfer) &
-              write (*,*) 'overriding transfer settings to get non-linear lensing'
-           P%WantTransfer  = .true.
-           call Transfer_SetForNonlinearLensing(P%Transfer)
-           P%Transfer%high_precision=  Ini_Read_Logical('transfer_high_precision',.false.)
-        
-        else if (P%WantTransfer)  then
-         P%Transfer%high_precision=  Ini_Read_Logical('transfer_high_precision',.false.)
-         P%transfer%kmax          =  Ini_Read_Double('transfer_kmax')
-         P%transfer%k_per_logint  =  Ini_Read_Int('transfer_k_per_logint')
-         P%transfer%num_redshifts =  Ini_Read_Int('transfer_num_redshifts')
-         transfer_interp_matterpower = Ini_Read_Logical('transfer_interp_matterpower ', transfer_interp_matterpower)
-         transfer_power_var = Ini_read_int('transfer_power_var',transfer_power_var)
-         if (P%transfer%num_redshifts > max_transfer_redshifts) stop 'Too many redshifts'
-         do i=1, P%transfer%num_redshifts
-              P%transfer%redshifts(i)  = Ini_Read_Double_Array('transfer_redshift',i,0._dl)
-              TransferFileNames(i)     = Ini_Read_String_Array('transfer_filename',i)
-              MatterPowerFilenames(i)  = Ini_Read_String_Array('transfer_matterpower',i)
-              if (TransferFileNames(i) == '') then
-                  TransferFileNames(i) =  trim(numcat('transfer_',i))//'.dat' 
-              end if
-              if (MatterPowerFilenames(i) == '') then
-                  MatterPowerFilenames(i) =  trim(numcat('matterpower_',i))//'.dat' 
-              end if
-              if (TransferFileNames(i)/= '') &
-                    TransferFileNames(i) = trim(outroot)//TransferFileNames(i)
-              if (MatterPowerFilenames(i) /= '') &
-                  MatterPowerFilenames(i)=trim(outroot)//MatterPowerFilenames(i)
-         end do
- 
- 
-         P%transfer%kmax=P%transfer%kmax*(P%h0/100._dl)
-                 
-        else
-          P%transfer%high_precision = .false.
-        endif
-   
-         Ini_fail_on_not_found = .false. 
-   
-         call Reionization_ReadParams(P%Reion, DefIni)
-         call InitialPower_ReadParams(P%InitPower, DefIni, P%WantTensors) 
-         call Recombination_ReadParams(P%Recomb, DefIni)
-         if (Ini_HasKey('recombination')) then
-          i = Ini_Read_Int('recombination',1)
-          if (i/=1) stop 'recombination option deprecated'
-         end if
-         if (P%WantScalars .or. P%WantTransfer) then
-             P%Scalar_initial_condition = Ini_Read_Int('initial_condition',initial_adiabatic)
-             if (P%Scalar_initial_condition == initial_vector) then
-                 P%InitialConditionVector=0
-               numstr = Ini_Read_String('initial_vector',.true.)
-               read (numstr,*) P%InitialConditionVector(1:initial_iso_neutrino_vel)
-             end if
- 
-         end if
- 
-         
-        if (P%WantScalars) then
-           ScalarFileName = trim(outroot)//Ini_Read_String('scalar_output_file')
-           LensedFileName =  trim(outroot) //Ini_Read_String('lensed_output_file')
-         end if
-         if (P%WantTensors) then
-           TensorFileName =  trim(outroot) //Ini_Read_String('tensor_output_file')
-          if (P%WantScalars)  then
-           TotalFileName =  trim(outroot) //Ini_Read_String('total_output_file')
-           LensedTotFileName = Ini_Read_String('lensed_total_output_file')
-           if (LensedTotFileName/='') LensedTotFileName= trim(outroot) //trim(LensedTotFileName)
-          end if
-         end if
-         if (P%WantVectors) then
-           VectorFileName =  trim(outroot) //Ini_Read_String('vector_output_file')
-         end if
-          
- #ifdef WRITE_FITS
-         if (P%WantCls) then
-         FITSfilename =  trim(outroot) //Ini_Read_String('FITS_filename',.true.)
-         if (FITSfilename /='') then
-         inquire(file=FITSfilename, exist=bad)
-         if (bad) then
-          open(unit=18,file=FITSfilename,status='old')
-          close(18,status='delete')
-         end if
-        end if
-         end if
- #endif        
-        
- 
-        Ini_fail_on_not_found = .false. 
- 
- !optional parameters controlling the computation
- 
-        P%AccuratePolarization = Ini_Read_Logical('accurate_polarization',.true.)
-        P%AccurateReionization = Ini_Read_Logical('accurate_reionization',.false.)
-        P%AccurateBB = Ini_Read_Logical('accurate_BB',.false.)
-         
-        !Mess here to fix typo with backwards compatibility
-        if (Ini_HasKey('do_late_rad_trunction')) then
-          DoLateRadTruncation = Ini_Read_Logical('do_late_rad_trunction',.true.)
-          if (Ini_HasKey('do_late_rad_truncation')) stop 'check do_late_rad_xxxx'
-        else
-         DoLateRadTruncation = Ini_Read_Logical('do_late_rad_truncation',.true.)
-        end if
-        DoTensorNeutrinos = Ini_Read_Logical('do_tensor_neutrinos',DoTensorNeutrinos)
-        FeedbackLevel = Ini_Read_Int('feedback_level',FeedbackLevel)
-        
-        P%MassiveNuMethod  = Ini_Read_Int('massive_nu_approx',Nu_best)
- 
-        ThreadNum      = Ini_Read_Int('number_of_threads',ThreadNum)
-        AccuracyBoost  = Ini_Read_Double('accuracy_boost',AccuracyBoost)
-        lAccuracyBoost = Ini_Read_Real('l_accuracy_boost',lAccuracyBoost)
-        lSampleBoost   = Ini_Read_Double('l_sample_boost',lSampleBoost)
- 
-        if (outroot /= '') then
-          call Ini_SaveReadValues(trim(outroot) //'params.ini',1)
-        end if
- 
-        call Ini_Close
- 
-        if (.not. CAMB_ValidateParams(P)) stop 'Stopped due to parameter error'
- 
- #ifdef RUNIDLE
-        call SetIdle
- #endif 
- 
-        if (FeedbackLevel > 0) then
-          Age = CAMB_GetAge(P) 
-          write (*,'("Age of universe/GYr  = ",f7.3)') Age  
-        end if 
- 
-        call CAMB_GetResults(P)
-     
-         if (P%WantTransfer .and. .not. (P%NonLinear==NonLinear_lens .and. P%DoLensing)) then
-          call Transfer_SaveToFiles(MT,TransferFileNames)
-          call Transfer_SaveMatterPower(MT,MatterPowerFileNames)
-          if ((P%OutputNormalization /= outCOBE) .or. .not. P%WantCls)  call Transfer_output_sig8(MT)
-         end if
- 
-         if (P%WantCls) then
-   
-          if (P%OutputNormalization == outCOBE) then
- 
-             if (P%WantTransfer) call Transfer_output_Sig8AndNorm(MT)
-            
-           end if
- 
-          call output_cl_files(ScalarFileName, TensorFileName, TotalFileName, &
-               LensedFileName, LensedTotFilename, output_factor)
- 
-          if (P%WantVectors) then
-            call output_veccl_files(VectorFileName, output_factor)
-          end if
- 
- 
- #ifdef WRITE_FITS
-          if (FITSfilename /= '') call WriteFitsCls(FITSfilename, CP%Max_l)
- #endif
-         end if
- 
-         call CAMB_cleanup             
-   
-         end program driver
- 
- 
- #ifdef RUNIDLE
-  !If in Windows and want to run with low priorty so can multitask
-    subroutine SetIdle
-     USE DFWIN
-     Integer dwPriority 
-     Integer CheckPriority
- 
-     dwPriority = 64 ! idle priority
-     CheckPriority = SetPriorityClass(GetCurrentProcess(), dwPriority)
- 
-    end subroutine SetIdle
- #endif
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/inifile.f90 cosmomc_sampler/camb/inifile.f90
*** cosmomc/camb/inifile.f90	2009-10-27 16:41:31.000000000 +0100
--- cosmomc_sampler/camb/inifile.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,671 ****
- !Module to read in name/value pairs from a file, with each line of the form line 'name = value'
- !Should correctly interpret FITS headers
- !Antony Lewis (http://cosmologist.info/). Released to the public domain.
- !This version Oct 2009.
- 
- module IniFile
-  implicit none
-  public
- 
-   integer, parameter :: Ini_max_name_len = 128
- 
-   integer, parameter :: Ini_max_string_len = 1024
-   logical :: Ini_fail_on_not_found = .false.
- 
-   logical :: Ini_Echo_Read = .false.
- 
-   type TNameValue
-    !no known way to make character string pointers..
-     character(Ini_max_name_len)  :: Name
-     character(Ini_max_string_len):: Value
-   end type TNameValue
- 
-   type TNameValue_pointer
-      Type(TNameValue), pointer :: P
-   end type TNameValue_pointer
- 
-   Type TNameValueList
-     integer Count
-     integer Delta
-     integer Capacity
-     type(TNameValue_pointer), dimension(:), pointer :: Items
-   end Type TNameValueList
- 
-   Type TIniFile
-    logical SlashComments
-    Type (TNameValueList) :: L, ReadValues
-   end Type TIniFile
-  
-   Type(TIniFile) :: DefIni
- 
- contains
- 
-    subroutine TNameValueList_Init(L)
-     Type (TNameValueList) :: L
-     
-      L%Count = 0
-      L%Capacity = 0
-      L%Delta = 128
-      nullify(L%Items)
- 
-    end subroutine TNameValueList_Init
- 
-    subroutine TNameValueList_Clear(L)
-     Type (TNameValueList) :: L
-     integer i, status
-      
-     do i=L%count,1,-1
-      deallocate (L%Items(i)%P, stat = status)
-     end do
-     deallocate (L%Items, stat = status)
-     call TNameValueList_Init(L)
- 
-    end subroutine TNameValueList_Clear
- 
-    subroutine TNameValueList_ValueOf(L, AName, AValue)
-      Type (TNameValueList), intent(in) :: L
-      character(LEN=*), intent(in) :: AName
-      CHARACTER(LEN=*), intent(out) :: AValue
-      integer i
- 
-      do i=1, L%Count
-        if (L%Items(i)%P%Name == AName) then
-           AValue = L%Items(i)%P%Value 
-           return
-        end if
-      end do
-      AValue = ''
- 
-    end subroutine TNameValueList_ValueOf
- 
-    function TNameValueList_HasKey(L, AName) result (AValue)
-      Type (TNameValueList), intent(in) :: L
-      character(LEN=*), intent(in) :: AName
-      logical :: AValue
-      integer i
- 
-      do i=1, L%Count
-        if (L%Items(i)%P%Name == AName) then
-           AValue = .true.
-           return
-        end if
-      end do
-      AValue = .false.
-      
-    end function TNameValueList_HasKey
-     
-    subroutine TNameValueList_Add(L, AName, AValue)
-     Type (TNameValueList) :: L
-     character(LEN=*), intent(in) :: AName, AValue
- 
-     if (L%Count == L%Capacity) call TNameValueList_SetCapacity(L, L%Capacity + L%Delta)
-     L%Count = L%Count + 1
-     allocate(L%Items(L%Count)%P)
-     L%Items(L%Count)%P%Name = AName
-     L%Items(L%Count)%P%Value = AValue
- 
-    end subroutine TNameValueList_Add
- 
-    subroutine TNameValueList_SetCapacity(L, C)
-     Type (TNameValueList) :: L
-     integer C
-     type(TNameValue_pointer), dimension(:), pointer :: TmpItems
-     
-     if (L%Count > 0) then
-       if (C < L%Count) stop 'TNameValueList_SetCapacity: smaller than Count'
-       allocate(TmpItems(L%Count))
-       TmpItems = L%Items(1:L%Count)
-       deallocate(L%Items)
-       allocate(L%Items(C))
-       L%Items(1:L%Count) = TmpItems
-       deallocate(TmpItems)
-     else
-      allocate(L%Items(C))
-     end if  
-     L%Capacity = C
-   
-    end subroutine TNameValueList_SetCapacity
- 
-    subroutine TNameValueList_Delete(L, i)
-     Type (TNameValueList) :: L
-     integer, intent(in) :: i
-      
-      deallocate(L%Items(i)%P)
-      if (L%Count > 1) L%Items(i:L%Count-1) = L%Items(i+1:L%Count)
-      L%Count = L%Count -1
-      
-    end subroutine TNameValueList_Delete
- 
-   subroutine Ini_NameValue_Add(Ini,AInLine)
-     Type(TIniFile) :: Ini
-     character (LEN=*), intent(IN) :: AInLine
-     integer EqPos, slashpos, lastpos
-     character (LEN=len(AInLine)) :: AName, S, InLine
- 
-       InLine=trim(adjustl(AInLine))
-       EqPos = scan(InLine,'=')
-       if (EqPos/=0 .and. InLine(1:1)/='#' .and. InLine(1:7) /= 'COMMENT' ) then
-    
-          AName = trim(InLine(1:EqPos-1))
-          
-          S = adjustl(InLine(EqPos+1:)) 
-            if (Ini%SlashComments) then
-            slashpos=scan(S,'/')
-            if (slashpos /= 0) then
-               S  = S(1:slashpos-1)
-            end if
-          end if
-          lastpos=len_trim(S)
-          if (lastpos>1) then
-           if (S(1:1)=='''' .and. S(lastpos:lastpos)=='''') then
-            S = S(2:lastpos-1)
-           end if
-          end if
-          call TNameValueList_Add(Ini%L, AName, S)
- 
-       end if
- 
-   end subroutine Ini_NameValue_Add
- 
-   subroutine Ini_Open(filename, unit_id,  error, slash_comments)
-      character (LEN=*), intent(IN) :: filename
-      integer, intent(IN) :: unit_id
-      logical, optional, intent(OUT) :: error
-      logical, optional, intent(IN) :: slash_comments
-      logical aerror
- 
-      call TNameValueList_Init(DefIni%L)
-      call TNameValueList_Init(DefIni%ReadValues)
-           
-      if (present(slash_comments)) then
-       call Ini_Open_File(DefIni,filename,unit_id,aerror,slash_comments)
-      else
-       call Ini_Open_File(DefIni,filename,unit_id,aerror)
-      end if
- 
-      if (present(error)) then
-        error = aerror
-      else
-       if (aerror) then
-         write (*,*) 'Ini_Open: Error opening file ' // trim(filename)
-         stop
-       end if
-      end if
- 
-   end subroutine Ini_Open
- 
- 
- 
-   subroutine Ini_Open_File(Ini, filename, unit_id,  error, slash_comments)
-      Type(TIniFile) :: Ini
- 
-      character (LEN=*), intent(IN) :: filename
-      integer, intent(IN) :: unit_id
-      logical, intent(OUT) :: error
-      logical, optional, intent(IN) :: slash_comments
-      character (LEN=120) :: InLine
-     
- 
-     call TNameValueList_Init(Ini%L)
-     call TNameValueList_Init(Ini%ReadValues)
- 
-     if (present(slash_comments)) then
-      Ini%SlashComments = slash_comments
-     else
-      Ini%SlashComments = .false.
-     end if
-          
-     open(unit=unit_id,file=filename,form='formatted',status='old', err=500)
-    
-     do 
-       read (unit_id,'(a)',end=400) InLine
-       if (InLine == 'END') exit;
-       if (InLine /= '') call Ini_NameValue_Add(Ini,InLine) 
-     end do
- 
- 400 close(unit_id)
-     error=.false.
-     return
- 
- 500 error=.true.
- 
-   end subroutine Ini_Open_File
- 
-   subroutine Ini_Open_Fromlines(Ini, Lines, NumLines, slash_comments)
-     Type(TIniFile) :: Ini
- 
-     integer, intent(IN) :: NumLines
-     character (LEN=*), dimension(NumLines), intent(IN) :: Lines
-     logical, intent(IN) :: slash_comments
-     integer i
- 
-     call TNameValueList_Init(Ini%L)
-     call TNameValueList_Init(Ini%ReadValues)
- 
-     Ini%SlashComments = slash_comments
- 
-     do i=1,NumLines
-        call Ini_NameValue_Add(Ini,Lines(i))
-     end do
- 
-   end  subroutine Ini_Open_Fromlines
- 
-   subroutine Ini_Close
- 
-     call Ini_close_File(DefIni)
- 
-   end subroutine Ini_Close
- 
- 
-   subroutine Ini_Close_File(Ini)
-     Type(TIniFile) :: Ini
-    
-     call TNameValueList_Clear(Ini%L)
-     call TNameValueList_Clear(Ini%ReadValues)
- 
-   end  subroutine Ini_Close_File
-   
- 
- 
-   function Ini_Read_String(Key, NotFoundFail) result(AValue)
-    character (LEN=*), intent(IN) :: Key
-    logical, optional, intent(IN) :: NotFoundFail
-    character(LEN=Ini_max_string_len) :: AValue
- 
-      if (present(NotFoundFail)) then
-       AValue = Ini_Read_String_File(DefIni, Key, NotFoundFail)
-      else
-       AValue = Ini_Read_String_File(DefIni, Key)
-      end if
- 
-   end function Ini_Read_String
- 
- 
-   function Ini_Read_String_File(Ini, Key, NotFoundFail) result(AValue)
-    Type(TIniFile) :: Ini
-    character (LEN=*), intent(IN) :: Key
-    logical, optional, intent(IN) :: NotFoundFail
-    character(LEN=Ini_max_string_len) :: AValue
- 
-    call TNameValueList_ValueOf(Ini%L, Key, AValue)
- 
-    if (AValue/='') then
- 
-     call  TNameValueList_Add(Ini%ReadValues, Key, AValue)
-     if (Ini_Echo_Read) write (*,*) trim(Key)//' = ',trim(AValue)
-     return
- 
-    end if
-    if (present(NotFoundFail)) then
-       if (NotFoundFail) then
-          write(*,*) 'key not found : '//trim(Key)
-          stop
-       end if
-    else if (Ini_fail_on_not_found) then
-       write(*,*) 'key not found : '//trim(Key)
-       stop
-    end if
- 
-   end function Ini_Read_String_File
-   function Ini_HasKey(Key) result(AValue)
-    character (LEN=*), intent(IN) :: Key
-    logical AValue
- 
-    AValue = Ini_HasKey_File(DefIni, Key)
- 
-   end function Ini_HasKey
- 
-   function Ini_HasKey_File(Ini, Key) result(AValue)
-    type(TIniFile), intent(in) :: Ini
-    character (LEN=*), intent(IN) :: Key
-    logical AValue
- 
-       Avalue = TNameValueList_HasKey(Ini%L, Key)
-       
-   end function Ini_HasKey_File
- 
-  function Ini_Key_To_Arraykey(Key, index)  result(AValue)
-     character (LEN=*), intent(IN) :: Key
-     integer, intent(in) :: index
-     character(LEN=Ini_max_string_len) :: AValue
-     
-     character(LEN=32) :: numstr
-     write (numstr,*) index 
-     numstr=adjustl(numstr)
-     AValue = trim(Key) // '(' // trim(numStr) // ')' 
-  
-  end function Ini_Key_To_Arraykey
- 
-   function Ini_Read_String_Array(Key, index, NotFoundFail) result(AValue)
-    character (LEN=*), intent(IN) :: Key
-    integer, intent(in) :: index
-    logical, optional, intent(IN) :: NotFoundFail
-    character(LEN=Ini_max_string_len) :: AValue
- 
-      if (present(NotFoundFail)) then
-       AValue = Ini_Read_String_Array_File(DefIni, Key, index, NotFoundFail)
-      else
-       AValue = Ini_Read_String_Array_File(DefIni, Key, index)
-      end if
- 
-   end function Ini_Read_String_Array
- 
-   function Ini_Read_String_Array_File(Ini, Key, index, NotFoundFail) result(AValue)
-    Type(TIniFile) :: Ini
-    integer, intent(in) :: index
-    character (LEN=*), intent(IN) :: Key
-    logical, optional, intent(IN) :: NotFoundFail
-    character(LEN=Ini_max_string_len) :: AValue
-    character(LEN=Ini_max_string_len) :: ArrayKey
-    
-      ArrayKey = Ini_Key_To_Arraykey(Key,index)
-      if (present(NotFoundFail)) then
-       AValue = Ini_Read_String_File(Ini, ArrayKey, NotFoundFail)
-      else
-       AValue = Ini_Read_String_File(Ini, ArrayKey)
-      end if
-    
-   end function Ini_Read_String_Array_File
- 
-   function Ini_Read_Int_Array(Key, index, Default)
-      integer, optional, intent(IN) :: Default
-      integer, intent(in) :: index
-      character (LEN=*), intent(IN) :: Key
-      integer Ini_Read_Int_Array
- 
-      if (present(Default)) then
-       Ini_Read_Int_Array = Ini_Read_Int_Array_File(DefIni, Key, index, Default)
-      else
-       Ini_Read_Int_Array = Ini_Read_Int_Array_File(DefIni, Key, index)
-      end if
-      
-    end function Ini_Read_Int_Array
- 
-   function Ini_Read_Int_Array_File(Ini,Key, index, Default)
-   !Reads Key(1), Key(2), etc.
-    Type(TIniFile) :: Ini
-    integer Ini_Read_Int_Array_File 
-    integer, optional, intent(IN) :: Default
-    integer, intent(in) :: index
-    character (LEN=*), intent(IN) :: Key
-    character(LEN=Ini_max_string_len) :: ArrrayKey
-      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
-      if (present(Default)) then
-       Ini_Read_Int_Array_File = Ini_Read_Int_File(Ini, ArrrayKey, Default)
-      else
-       Ini_Read_Int_Array_File = Ini_Read_Int_File(Ini, ArrrayKey)
-      end if
-   end function Ini_Read_Int_Array_File
- 
- 
-   function Ini_Read_Int(Key, Default)
-      integer, optional, intent(IN) :: Default
-      character (LEN=*), intent(IN) :: Key
-      integer Ini_Read_Int
- 
-      if (present(Default)) then
-       Ini_Read_Int = Ini_Read_Int_File(DefIni, Key, Default)
-      else
-       Ini_Read_Int = Ini_Read_Int_File(DefIni, Key)
-      end if
-   end function Ini_Read_Int
- 
-   function Ini_Read_Int_File(Ini, Key, Default)
-    Type(TIniFile) :: Ini
-    integer Ini_Read_Int_File
-    integer, optional, intent(IN) :: Default
-    character  (LEN=*), intent(IN) :: Key
-    character(LEN=Ini_max_string_len) :: S
-    
-    S = Ini_Read_String_File(Ini, Key,.not. present(Default))
-    if (S == '') then
-       if (.not. present(Default)) then
-         write(*,*) 'no value for key: '//Key
-         stop
-       end if
-       Ini_Read_Int_File = Default
-       write (S,*) Default
-       call  TNameValueList_Add(Ini%ReadValues, Key, S)
-    else
-     if (verify(trim(S),'-+0123456789') /= 0) goto 10
-     read (S,*, err = 10) Ini_Read_Int_File
-    end if
-   return
- 10 write (*,*) 'error reading integer for key: '//Key
-    stop
-   
-   end function Ini_Read_Int_File
- 
-   function Ini_Read_Double(Key, Default)
-      double precision, optional, intent(IN) :: Default
-      character (LEN=*), intent(IN) :: Key
-      double precision Ini_Read_Double
- 
-      if (present(Default)) then
-       Ini_Read_Double = Ini_Read_Double_File(DefIni, Key, Default)
-      else
-       Ini_Read_Double = Ini_Read_Double_File(DefIni, Key)
-      end if
-   
-   end function Ini_Read_Double
- 
-   function Ini_Read_Double_File(Ini,Key, Default)
-    Type(TIniFile) :: Ini
-    double precision Ini_Read_Double_File 
-    double precision, optional, intent(IN) :: Default
-    character (LEN=*), intent(IN) :: Key
-    character(LEN=Ini_max_string_len) :: S
-    
-    S = Ini_Read_String_File(Ini,Key,.not. present(Default))
-    if (S == '') then
-       if (.not. present(Default)) then
-         write(*,*) 'no value for key: '//Key
-         stop
-       end if
-       Ini_Read_Double_File = Default
-       write (S,*) Default
- 
-       call  TNameValueList_Add(Ini%ReadValues, Key, S)
- 
-    else
-     read (S,*, err=10) Ini_Read_Double_File
-    end if
- 
-   return
- 
- 10 write (*,*) 'error reading double for key: '//Key
-    stop
- 
-   end function Ini_Read_Double_File
- 
- 
- 
-     function Ini_Read_Double_Array(Key, index, Default)
-      double precision, optional, intent(IN) :: Default
-      integer, intent(in) :: index
-      character (LEN=*), intent(IN) :: Key
-      double precision Ini_Read_Double_Array
- 
-      if (present(Default)) then
-       Ini_Read_Double_Array = Ini_Read_Double_Array_File(DefIni, Key, index, Default)
-      else
-       Ini_Read_Double_Array = Ini_Read_Double_Array_File(DefIni, Key, index)
-      end if
-      
-     end function Ini_Read_Double_Array
- 
- 
-   function Ini_Read_Double_Array_File(Ini,Key, index, Default)
- 
-   !Reads Key(1), Key(2), etc.
- 
-    Type(TIniFile) :: Ini
- 
-    double precision Ini_Read_Double_Array_File 
-    double precision, optional, intent(IN) :: Default
-    integer, intent(in) :: index
-    character (LEN=*), intent(IN) :: Key
-    character(LEN=Ini_max_string_len) ::  ArrrayKey
- 
-      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
-      if (present(Default)) then
- 
-       Ini_Read_Double_Array_File = Ini_Read_Double_File(Ini, ArrrayKey, Default)
-      else
-       Ini_Read_Double_Array_File = Ini_Read_Double_File(Ini, ArrrayKey)
-      end if
-   end function Ini_Read_Double_Array_File
- 
-     function Ini_Read_Real(Key, Default)
-      real, optional, intent(IN) :: Default
-      character (LEN=*), intent(IN) :: Key
-      real Ini_Read_Real
- 
-      if (present(Default)) then
-       Ini_Read_Real = Ini_Read_Real_File(DefIni, Key, Default)
-      else
-       Ini_Read_Real = Ini_Read_Real_File(DefIni, Key)
-      end if
- 
-     end function Ini_Read_Real
- 
-     function Ini_Read_Real_File(Ini,Key, Default)
-     Type(TIniFile) :: Ini
-     real Ini_Read_Real_File 
-     real, optional, intent(IN) :: Default
-     character (LEN=*), intent(IN) :: Key
-     character(LEN=Ini_max_string_len) :: S
-    
-     S = Ini_Read_String_File(Ini,Key,.not. present(Default))
-     if (S == '') then
-       if (.not. present(Default)) then
-         write(*,*) 'no value for key: '//Key
-         stop
-       end if
-       Ini_Read_Real_File = Default
-       write (S,*) Default
-       call  TNameValueList_Add(Ini%ReadValues, Key, S)
- 
-    else
-     read (S,*, err=10) Ini_Read_Real_File
-    end if
- 
-   return
- 
- 10 write (*,*) 'error reading double for key: '//Key
-    stop
- 
-   end function Ini_Read_Real_File
- 
- 
- 
-    function Ini_Read_Real_Array(Key, index, Default)
-      real, optional, intent(IN) :: Default
-      integer, intent(in) :: index
-      character (LEN=*), intent(IN) :: Key
-      real Ini_Read_Real_Array
- 
-      if (present(Default)) then
-       Ini_Read_Real_Array = Ini_Read_Real_Array_File(DefIni, Key, index, Default)
-      else
-       Ini_Read_Real_Array = Ini_Read_Real_Array_File(DefIni, Key, index)
-      end if
-    end function Ini_Read_Real_Array
- 
-   function Ini_Read_Real_Array_File(Ini,Key, index, Default)
-   !Reads Key(1), Key(2), etc.
-    Type(TIniFile) :: Ini
-    real Ini_Read_Real_Array_File 
-    real, optional, intent(IN) :: Default
-    integer, intent(in) :: index
-    character (LEN=*), intent(IN) :: Key
-    character(LEN=Ini_max_string_len) :: ArrrayKey
-    
-      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
-      if (present(Default)) then
-       Ini_Read_Real_Array_File = Ini_Read_Real_File(Ini, ArrrayKey, Default)
-      else
-       Ini_Read_Real_Array_File = Ini_Read_Real_File(Ini, ArrrayKey)
-      end if
-   end function Ini_Read_Real_Array_File
- 
-   function Ini_Read_Logical(Key, Default)
-      Logical, optional, intent(IN) :: Default
-      character (LEN=*), intent(IN) :: Key
-     logical Ini_Read_Logical
- 
-      if (present(Default)) then
-       Ini_Read_Logical = Ini_Read_Logical_File(DefIni, Key, Default)
-      else
-       Ini_Read_Logical = Ini_Read_Logical_File(DefIni, Key)
-      end if
-   end function Ini_Read_Logical
- 
-   function Ini_Read_Logical_File(Ini, Key, Default)
-    Type(TIniFile) :: Ini
- 
-    logical Ini_Read_Logical_File
-    logical, optional, intent(IN) :: Default
-    character  (LEN=*), intent(IN) :: Key
-   
-    character(LEN=Ini_max_string_len) :: S
-    
-    S = Ini_Read_String_File(Ini,Key,.not. present(Default))
-    if (S == '') then
-       if (.not. present(Default)) then
-         write(*,*) 'no value for key: '//Key
-         stop
-       end if
-       Ini_Read_Logical_File = Default
-       write (S,*) Default
- 
-       call  TNameValueList_Add(Ini%ReadValues, Key, S)
- 
-    else
- 
-     if (verify(trim(S),'10TF') /= 0) goto 10  
-     read (S,*, err = 10) Ini_Read_Logical_File
-    end if
- 
-   return
- 
- 10 write (*,*) 'error reading logical for key: '//Key
-    stop
-   end function Ini_Read_Logical_File
- 
- 
- 
-   subroutine Ini_SaveReadValues(afile,unit_id)
-    character(LEN=*)  :: afile
-    integer, intent(in) :: unit_id
- 
-    call Ini_SaveReadValues_File(DefIni, afile, unit_id)
- 
-   end subroutine Ini_SaveReadValues
- 
- 
- 
-   subroutine Ini_SaveReadValues_File(Ini, afile, unit_id)
-    Type(TIniFile) :: Ini
-    character(LEN=*), intent(in) :: afile
-    integer, intent(in) :: unit_id
-    integer i
- 
-    open(unit=unit_id,file=afile,form='formatted',status='replace', err=500)
- 
-    do i=1, Ini%ReadValues%Count
- 
-     write (unit_id,'(a)') trim(Ini%ReadValues%Items(i)%P%Name) // ' = ' &
-                         //trim(Ini%ReadValues%Items(i)%P%Value)
- 
-    end do
- 
-    close(unit_id)
-    return
- 
- 500 write(*,*) 'Ini_SaveReadValues_File: Error creating '//trim(afile)
- 
-   end subroutine Ini_SaveReadValues_File
- 
- end module IniFile
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/lensing.f90 cosmomc_sampler/camb/lensing.f90
*** cosmomc/camb/lensing.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/lensing.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1401 ****
- !Lensing the C_l using the deflection angle from the computed lensing potential
- !power spectrum. 
- !lensing_method=1: using an accurate curved-sky correlation function method
- !lensing_method=2: using the flat-sky lower order result of astro-ph/9505109 
- !                  and astro-ph/9803150 as in CMBFAST 
- !lensing_method=3: using inaccurate full sky harmonic method of astro-ph/0001303
- 
- !The flat sky result is accurate to about 0.1% in TT, and 0.4% in EE and is
- !about a factor of two faster than lensing_method=1.
- !lensing_method=3 is only present for comparison and is not recommended in any regime
- 
- !Set accurate_BB=T if you want BB accurately by integrating the full angular range
- !otherwise it saves a large amount of time by only integrating the small scales
- !accute_BB only does *not* include any non-linear corrections or ensure you have
- !chosen sufficiently high l_max and k_max, so does not neccessarily give an accurate
- !result
- 
- !Uses the un-lensed Cls and the computed lensing potential power spectrum.
- !Usual values of k_max are fine for all but the lensed BB Cls
- !To get the lensed BB accurate around l=1000 you need to go to l_max >2000, and
- !higher for higher l. Since this probes small scales in the lensing power spectrum you
- !also need to go to higher k_max - for concordance models something like 
- !k_eta_max_scalar=10000. At l>1000 you can expect to need higher k_max, and for 
- !non-linear evolution to cause a significant error.
- 
- !Correlation function routines by AL+AC Nov 2004 with flat-sky borrowings from CMBFAST
- !Curved sky results use the method of astro-ph/xxx.
- 
- !Full sky harmonic lensing routines by Gayoung Chon and AC.
- !Ref: astro-ph/0001303 by W. Hu. 
- !For better derivations see also astro-ph/0301064 and astro-ph/0301031
- !Adapted for CAMB and optimized by AL.
- !Uses f90 version of "J1-RECURSION OF 3J-COEFFICIENTS" by K. Schulten and R.G. Gordon 
- !obtainable from the CPC program library (www.cpc.cs.qub.ac.uk).
- 
- !March 2006: fixed problem with l_max when generating with tensors (thanks Chad Fendt)
- 
- module lensing
- use Precision
- use ModelParams
- implicit none
-  integer, parameter :: lensing_method_curv_corr=1,lensing_method_flat_corr=2, &
-                        lensing_method_harmonic=3
-  
-  integer :: lensing_method = lensing_method_curv_corr
- 
- private
- 
-  logical  :: lensing_includes_tensors = .false.
- 
- !flat method stores
-  real(dl), parameter :: dbessel = 0.05_dl 
-  real(dl), dimension(:), allocatable :: Bess0, ddBess0
-  real(dl), dimension(:), allocatable :: Bess2, ddBess2
-  real(dl), dimension(:), allocatable :: Bess4, ddBess4
-  real(dl), dimension(:), allocatable :: Bess6, ddBess6
- 
- !Harmonic method stores
-  integer :: lmax_donelnfa = 0
-  real(dl), dimension(:), allocatable  :: lnfa
- 
- public lens_Cls, lensing_includes_tensors, lensing_method, lensing_method_flat_corr,&
-       lensing_method_curv_corr,lensing_method_harmonic, BessI, bessj0
- contains
- 
- 
- subroutine lens_Cls
-  use lvalues
- 
-  !Must set l again in case computed tessors (thanks to Chad)
-  call initlval(lSamp,CP%Max_l)
-  if (lensing_method == lensing_method_curv_corr) then
-     call CorrFuncFullSky()
-   elseif (lensing_method == lensing_method_flat_corr) then 
-     call CorrFuncFlatSky()
-   elseif (lensing_method == lensing_method_harmonic) then 
-     call BadHarmonic
-   else
-     stop 'Unknown lensing method'
-  end if
- end subroutine lens_Cls
- 
- 
- subroutine CorrFuncFullSky
-  !Accurate curved sky correlation function method
-  !Uses non-perturbative isotropic term with 2nd order expansion in C_{gl,2}
-  !Neglects C_{gl}(theta) terms (very good approx)
-   use ModelParams
-   use ModelData
-   use lvalues
-   implicit none
-   integer l, i, in
-   integer :: npoints 
-   real(dl) corr(4), Cg2, sigmasq, theta
-   real(dl) dtheta
-   real(dl) llp1,fac, fac1,fac2,fac3, rootllp1, rootfac1, rootfac2, rootfac3
-   real(dl) P(CP%Max_l),dP(CP%Max_l)
-   real(dl) d_11(CP%Max_l),d_m11(CP%Max_l)
-   real(dl) d_22(CP%Max_l),d_2m2(CP%Max_l),d_20(CP%Max_l)
-   real(dl) Cphil3(lmin:CP%Max_l), CTT(lmin:CP%Max_l), CTE(lmin:CP%Max_l),CEE(lmin:CP%Max_l)
-   integer max_lensed_ix
-   real(dl) sinth,halfsinth, x, T2,T4
-   real(dl) roots(-1:CP%Max_l+4), lfacs(CP%Max_l), lfacs2(CP%Max_l), lrootfacs(CP%Max_l)
-   real(dl), allocatable, dimension(:,:,:) :: lens_contrib(:,:,:)
-   integer thread_ix
-   real(dl) pmm, pmmp1
-   real(dl) d4m4,d11,dm11,d2m2,d22,d20,d23,d2m3,d33,d3m3,d04,d1m2,d12,d13,d1m3,d2m4
-   real(dl) sinfac, Cg2sq
-   real(dl) X000,X022,X220,X121,X132,X242
-   real(dl) dX000,dX022
-   real(sp) timeprev
-   integer  interp_fac
-   integer j,jmax
-   real(dl) ls(CP%Max_l)
-   real(dl) xl(CP%Max_l),ddcontribs(CP%Max_l,4),corrcontribs(CP%Max_l,4)
-   integer llo, lhi
-   real(dl) a0,b0,ho
- 
-   logical, parameter :: approx = .false.
- 
- !$ integer  OMP_GET_THREAD_NUM, OMP_GET_MAX_THREADS
- !$ external OMP_GET_THREAD_NUM, OMP_GET_MAX_THREADS
- 
-     if (lensing_includes_tensors) stop 'Haven''t implemented tensor lensing'
- 
-     max_lensed_ix = lSamp%l0-1
-     do while(lSamp%l(max_lensed_ix) > CP%Max_l -250)
-       max_lensed_ix = max_lensed_ix -1
-     end do
-     lmax_lensed = lSamp%l(max_lensed_ix)
-     if (allocated(Cl_lensed)) deallocate(Cl_lensed)
-     allocate(Cl_lensed(lmin:lmax_lensed,CP%InitPower%nn,1:4))
-     
-     Cl_Lensed = 0
-    
-     npoints = CP%Max_l  * 2    
-     if (CP%AccurateBB .or. CP%Max_l>3000) npoints = npoints * 2 
-  
-     dtheta = pi / npoints
-     if (.not. CP%AccurateBB .and. CP%Max_l<=3000) then
-       npoints = int(npoints /32 *min(32._dl,AccuracyBoost)) 
-       !OK for TT, EE, TE but inaccurate for low l BB
-       !this induces high frequency ringing on very small scales
-     end if
- 
-     if (DebugMsgs) timeprev=GetTestTime()
- 
-     if (CP%AccurateBB .or. CP%Max_l > 3000) then
-      !There is an odd serious problem with interpolating if you do a large
-      !angular range.
-       
-      interp_fac =1
-     else
-      interp_fac = max(1,nint(10/AccuracyBoost))
-     end if
- 
-     jmax = 0
-     do l=lmin,CP%Max_l
-        if (l<=15 .or. mod(l-15,interp_fac)==interp_fac/2) then
-          jmax =jmax+1
-          ls(jmax)=l
-          xl(jmax)=l
-        end if
-        lfacs(l) = real(l*(l+1),dl)
-        lfacs2(l) = real((l+2)*(l-1),dl)
-        lrootfacs(l) = sqrt(lfacs(l)*lfacs2(l))
-     end do
- 
-     roots(-1)=0 !just so dipole doesn't screw up
-     do l=0,CP%Max_l+4
-      roots(l) = sqrt(real(l,dl))
-     end do
- 
- 
-     thread_ix = 1
-     !$ thread_ix = OMP_GET_MAX_THREADS()  
-     allocate(lens_contrib(4,lmax_lensed,thread_ix))
- 
-     do in = 1, CP%InitPower%nn
- 
-     do l=lmin,CP%Max_l
-      ! (2*l+1)l(l+1)/4pi C_phi_phi: Cl_scalar(l,1,C_Phi) is l^4 C_phi_phi
-        Cphil3(l) = Cl_scalar(l,in,C_Phi)*(2*l+1)*(l+1)/real(l,dl)**3/(4*pi) 
-        fac = (2*l+1)/(4*pi) * 2*pi/(l*(l+1))
-        CTT(l) =  Cl_scalar(l,in,C_Temp)*fac
-        CEE(l) =  Cl_scalar(l,in,C_E)*fac
-        CTE(l) =  Cl_scalar(l,in,C_Cross)*fac
-     end do
- 
-     if (Cphil3(10) > 1e-7) then
-      write (*,*) 'You need to normalize realistically to use lensing.'
-      write (*,*) 'see http://cosmocoffee.info/viewtopic.php?t=94'
-      stop
-     end if
- 
-   lens_contrib=0
- 
-   !uncomment second line for PGF90 workaround
-   !$OMP PARALLEL DO DEFAULT(PRIVATE),  &
-   !OMP PRIVATE(P,dP,d11,dm11,d22,d2m2,d20,corrcontribs,ddcontribs),& 
-   !$OMP SHARED(lfacs,lfacs2,lrootfacs,Cphil3,CTT,CTE,CEE,lens_contrib), &
-   !$OMP SHARED(dtheta,CP,lmax_lensed,roots, npoints,interp_fac,jmax,ls,xl) 
-       do i=1,npoints-1
- 
-       theta = i * dtheta 
-       x = cos(theta)
-       sinth = sin(theta)
-       halfsinth = sinth/2
- 
-       pmm=1
-       pmmp1=x
- 
-       Cg2=0
-       sigmasq=0
-       if (lmin==1) then
-         d_11(1) = cos(theta/2)**2
-         d_m11(1) = sin(theta/2)**2
-         sigmasq = sigmasq  +  (1-d_11(1))*Cphil3(lmin) 
-         Cg2 = Cg2  + d_m11(1)*Cphil3(lmin)
-         P(1) = x
-         d_22(1)=0
-         d_2m2(1)=0
-         d_20(1)=0
-       end if
-       do l=2,CP%Max_l
- 
-         P(l)= ((2*l-1)* x *pmmp1 - (l-1)*Pmm)/ l
-         dP(l) = l*(pmmp1-x*P(l))/sinth**2
-         Pmm=pmmp1
-         pmmp1=P(l)
-         llp1 = lfacs(l)
-   
-         fac1 = (1-x)
-         fac2 = (1+x)
-         fac = fac1/fac2
- 
-         d_11(l) =  fac1*dP(l)/llp1 + P(l)
-         d_m11(l) = fac2*dP(l)/llp1 - P(l)
- 
-         sigmasq = sigmasq  +  (1-d_11(l))*Cphil3(l) 
-         Cg2 = Cg2  + d_m11(l)*Cphil3(l)
-         
-         d_22(l) = ( ((4*x-8)/fac2 + llp1)*P(l) &
-             + 4*fac*( fac2 + (x - 2)/llp1)*dP(l) )/ lfacs2(l)
-                   
-         d_2m2(l) = ( (llp1- (4*x+8)/fac1) *P(l) &
-             +4/fac*( -fac1 + (x+2)/llp1) *dP(l) )/lfacs2(l)              
- 
-         d_20(l) = (2*x*dP(l) - llp1*P(l) ) / lrootfacs(l)
- 
-       end do
- 
-        do j=1,jmax
-         l =ls(j)
-  
-         fac1 = (1-x)
-         fac2 = (1+x)
-         llp1 = lfacs(l)
-   
-         rootllp1 = roots(l)*roots(l+1) 
-         rootfac1 = roots(l+2)*roots(l-1)
-         rootfac2 = roots(l+3)*roots(l-2)
- 
-         llp1=lfacs(l)
-         dm11=d_m11(l)
-         d11=d_11(l)
-         if (l<2) then
-          d2m2=0
-          d22=0
-          d20=0
-          d1m2 = 0
-          d12 =  0     
-         else
-          d2m2=d_2m2(l)
-          d22=d_22(l)
-          d20=d_20(l)
-          d1m2 = sinth/rootfac1*(dP(l) -2/fac1*dm11)
-          d12 =  sinth/rootfac1*(dP(l) -2/fac2*d11)
-         end if
-         if (l<3) then
-          d1m3=0
-          d2m3=0
-          d3m3=0
-          d13 =0 
-          d23 =0
-          d33 =0 
-         else
-          sinfac=4/sinth
-          d1m3 = (-(x+0.5_dl)*d1m2*sinfac - lfacs2(l)*dm11/rootfac1 )/rootfac2
-          d2m3 = (-fac2*d2m2*sinfac - rootfac1*d1m2)/rootfac2
-          d3m3 = (-(x+1.5_dl)*d2m3*sinfac - rootfac1*d1m3)/rootfac2
-          d13  =  ((x-0.5_dl)*d12*sinfac - lfacs2(l)*d11/rootfac1 ) /rootfac2
-          d23  = (-fac1*d22*sinfac + rootfac1*d12 ) / rootfac2
-          d33  = (-(x-1.5_dl)*d23*sinfac - rootfac1*d13)/rootfac2
-         end if 
-         if (l<4) then
-          d04=0
-          d2m4=0
-          d4m4=0
-          rootfac3=0
-         else
-          rootfac3=roots(l-3)*roots(l+4)
-          d04=( (-llp1 + (18*x**2 + 6)/sinth**2 )*d20  -&
-              6*x*lfacs2(l)*dP(l)/lrootfacs(l) ) / (rootfac2*rootfac3)
-          d2m4= (-(6*x+4)*d2m3/sinth - rootfac2*d2m2 ) / rootfac3
-          d4m4 = (-7/5._dl*(llp1-6)*d2m2 + &
-                 12/5._dl*( -llp1+(9*x+26)/fac1)*d3m3 ) / (llp1-12)
-         end if
- 
-        !Non perturbative isotropic integrals
-        !these are approx, but extremely good approximations
-          X000 = exp(-llp1*sigmasq/4)
-          if (approx) then
- 
-          X022 = X000  
-          X220 = rootllp1**2/4*X000
-          X121 = -0.5_dl*rootllp1*X000
-          X132 = -0.5_dl*rootllp1*X000
-          X242 = 0.25_dl*rootllp1**2*X022 
-          
-          dX000 = -llp1/4*X000
-          dX022 = -llp1/4*X022
-         
- 
-          else
-          X022 = X000*(1+sigmasq)   !exp(-(llp1-4)*sigmasq/4)
-          X220 = lrootfacs(l)/4*X000
-          X121 = -0.5_dl*rootfac1*X000
-          X132 = -0.5_dl*rootfac2*X000
-          X242 = 0.25_dl*rootfac2*rootfac3*X022 
-          
-          dX000 = -llp1/4*X000
-          dX022 = (1-llp1/4)*X022
-          end if  
- !second order
-          !TT
-          fac1 = dX000**2
-          fac3 = X220**2
-          Cg2sq = Cg2**2
- 
- !Here we drop terms in Cgt which are down by powers of l
- !Approx good to 1e-4 level
-          fac = ( (X000**2-1) + Cg2sq*fac1)*P(l)+ Cg2sq*fac3*d2m2 &
-                     + 8/llp1* fac1*Cg2*dm11 
-      
-          corrcontribs(j,1)=  CTT(l) * fac 
- 
-          fac2=(Cg2*dX022)**2+(X022**2-1)
- !Q+U
-          fac = 2*Cg2*X121*X132*d13 + fac2*d22 +Cg2sq*X242*X220*d04 
- 
-          corrcontribs(j,2)= CEE(l) * fac 
- 
- !Q-U 
-          fac = ( fac3*P(l) + X242**2*d4m4)*Cg2sq/2 &
-               + Cg2*(X121**2*dm11+ X132**2*d3m3) + fac2*d2m2 
- 
-          corrcontribs(j,3)= CEE(l) * fac 
- 
- !TE
-         fac = (X000*X022-1)*d20+ &
-           2*dX000*Cg2*(X121*d11 + X132*d1m3)/rootllp1 &
-              + Cg2sq*(X220/2*d2m4*X242 +( fac3/2 + dX022*dX000)*d20) 
- 
-         corrcontribs(j,4)= CTE(l) * fac 
- 
-       end do
- 
- do j=1,4
-   corr(j) = sum(corrcontribs(1:14,j))+interp_fac*sum(corrcontribs(15:jmax,j))
- end do
- 
- !Interpolate contributions
- !Increasing interp_fac and using this seems to be slower than above
- if (.false.) then
-       if (abs(sum(corrcontribs(1:jmax,1)))>1e-11) print *,i,sum(corrcontribs(1:jmax,1))
-       do j=1,4
-        call spline(xl,corrcontribs(1,j),jmax,1d30,1d30,ddcontribs(1,j))
-       end do 
-       corr=0
-       llo=1
-       do l=lmin,CP%Max_l
-            if ((l > ls(llo+1)).and.(llo < jmax)) then
-               llo=llo+1
-            end if
-            lhi=llo+1
-            ho=ls(lhi)-ls(llo)
-            a0=(ls(lhi)-l)/ho
-            b0=(l-ls(llo))/ho
-            fac1 = ho**2/6
-            fac2 = (b0**3-b0)*fac1
-            fac1 = (a0**3-a0)*fac1 
-   
-            corr(1) = Corr(1)+ a0*corrcontribs(llo,1)+ b0*corrcontribs(lhi,1)+ &
-             fac1* ddcontribs(llo,1) +fac2*ddcontribs(lhi,1)
-            corr(2) = Corr(2)+ a0*corrcontribs(llo,2)+ b0*corrcontribs(lhi,2)+ &
-             fac1* ddcontribs(llo,2) +fac2*ddcontribs(lhi,2)
-            corr(3) = Corr(3)+ a0*corrcontribs(llo,3)+ b0*corrcontribs(lhi,3)+ &
-             fac1* ddcontribs(llo,3) +fac2*ddcontribs(lhi,3)
-            corr(4) = Corr(4)+ a0*corrcontribs(llo,4)+ b0*corrcontribs(lhi,4)+ &
-             fac1* ddcontribs(llo,4) +fac2*ddcontribs(lhi,4)
-          
-       end do
- end if 
-       
-  !$   thread_ix = OMP_GET_THREAD_NUM()+1
- 
-       do l=lmin, lmax_lensed
-        !theta factors were put in earlier (already in corr)
- 
- 
-        lens_contrib(C_Temp, l, thread_ix)= lens_contrib(C_Temp,l, thread_ix) + &
-                                           corr(1)*P(l)*sinth 
- 
-        T2 = corr(2)* d_22(l)
-        T4 = corr(3)* d_2m2(l)
- 
- 
-        lens_contrib(CT_E, l, thread_ix)= lens_contrib(CT_E,l, thread_ix) + &
-                                           (T2+T4)*halfsinth 
-        lens_contrib(CT_B, l, thread_ix)= lens_contrib(CT_B,l, thread_ix) + &
-                                           (T2-T4)*halfsinth 
-  
-        lens_contrib(CT_Cross, l, thread_ix)= lens_contrib(CT_Cross,l, thread_ix) + &
-                                           corr(4)*d_20(l)*sinth 
-  
-       end do
- 
-      end do
-   !$OMP END PARALLEL DO
-      
-       do l=lmin, lmax_lensed
-          !sign from d(cos theta) = -sin theta dtheta
-        fac = l*(l+1)/OutputDenominator*dtheta *2*pi
-        Cl_lensed(l,in,CT_Temp) = sum(lens_contrib(CT_Temp,l,:))*fac &
-                  + Cl_scalar(l,in,C_Temp) 
-        Cl_lensed(l,in,CT_E) = sum(lens_contrib(CT_E,l,:))*fac &
-                  + Cl_scalar(l,in,C_E) 
-        Cl_lensed(l,in,CT_B) = sum(lens_contrib(CT_B,l,:))*fac
-        Cl_lensed(l,in,CT_Cross) = sum(lens_contrib(CT_Cross,l,:))*fac &
-                  + Cl_scalar(l,in,C_Cross) 
- 
-       end do
- 
-       end do !loop over different initial power spectra
-      deallocate(lens_contrib)
- 
-      if (DebugMsgs) write(*,*) GetTestTime()-timeprev, 'Time for corr lensing'
- 
- end subroutine CorrFuncFullSky
- 
- 
- 
- subroutine CorrFuncFlatSky
-  !Do flat sky approx partially non-perturbative lensing, lensing_method=2
-    use ModelParams
-   use ModelData
-   use lvalues
-   integer l, i
-   integer :: npoints 
-   real(dl) Cgl2,  sigmasq, theta
-   real(dl) dtheta
-   real(dl) dbessfac, fac, fac1,fac2,  C2term, expsig, corr(4)
-   real(sp) timeprev
-   real(dl) Bessel0(lmin:CP%Max_l),Bessel2(lmin:CP%Max_l)
-   real(dl) Bessel4(lmin:CP%Max_l),Bessel6(lmin:CP%Max_l)
-   real(dl) Cphil3(lmin:CP%Max_l), CTT(lmin:CP%Max_l), CTE(lmin:CP%Max_l),CEE(lmin:CP%Max_l)
-   integer max_lensed_ix
-   integer b_lo
-   integer in
-   real(dl) T2,T4,a0, b0
-   real(dl) lfacs(CP%Max_l)
-   real(dl), allocatable, dimension(:,:,:) :: lens_contrib(:,:,:)
-   integer thread_ix
- !$ integer OMP_GET_THREAD_NUM, OMP_GET_MAX_THREADS
- !$ external OMP_GET_THREAD_NUM, OMP_GET_MAX_THREADS
- 
-     if (lensing_includes_tensors) stop 'Haven''t implemented tensor lensing'
- 
-     max_lensed_ix = lSamp%l0-1
-     do while(lSamp%l(max_lensed_ix) > CP%Max_l -250)
-       max_lensed_ix = max_lensed_ix -1
-     end do
-     lmax_lensed = lSamp%l(max_lensed_ix)
-     if (allocated(Cl_lensed)) deallocate(Cl_lensed)
-     allocate(Cl_lensed(lmin:lmax_lensed,CP%InitPower%nn,1:4))
-     
-     Cl_Lensed = 0
-    
-     npoints = CP%Max_l  * 2   
-     if (CP%AccurateBB) npoints = npoints * 2
- 
-     dtheta = pi / npoints
-     if (.not. CP%AccurateBB) then
-      npoints = int(npoints /32 *min(32._dl,AccuracyBoost)) 
-       !OK for TT, EE, TE but inaccurate for low l BB
-       !this induces high frequency ringing on very small scales
-     end if
- 
-     call GetBessels(npoints*dtheta*CP%Max_l)
- 
-     if (DebugMsgs) timeprev=GetTestTime()
- 
-     dbessfac = dbessel**2/6
- 
-     thread_ix = 1
-     !$ thread_ix = OMP_GET_MAX_THREADS()  
-     allocate(lens_contrib(4,lmax_lensed,thread_ix))
- 
-     do in = 1, CP%InitPower%nn
- 
-     do l=lmin,CP%Max_l
-      ! l^3 C_phi_phi/2/pi: Cl_scalar(l,1,C_Phi) is l^4 C_phi_phi
-        Cphil3(l) = Cl_scalar(l,in,C_Phi)/l /(2*pi)
-        fac = l/(2*pi)*2*pi/(l*(l+1))
-        CTT(l) =  Cl_scalar(l,in,C_Temp)*fac
-        CEE(l) =  Cl_scalar(l,in,C_E)*fac
-        CTE(l) =  Cl_scalar(l,in,C_Cross)*fac
-        lfacs(l) = l**2*0.5_dl
-     end do
- 
-     if (Cphil3(10) > 1e-7) then
-      write (*,*) 'You need to normalize realistically to use lensing.'
-      write (*,*) 'see http://cosmocoffee.info/viewtopic.php?t=94'
-      stop
-     end if
- 
-   lens_contrib=0
- 
-   !$OMP PARALLEL DO DEFAULT(SHARED),  &
-   !$OMP PRIVATE(theta, sigmasq,cgl2,b_lo,a0,b0,fac,fac1,fac2), &
-   !$OMP PRIVATE(Bessel0,Bessel2,Bessel4,Bessel6), &
-   !$OMP PRIVATE(corr,expsig,C2term,T2,T4,i,l, thread_ix)     
- 
-     do i=1,npoints-1
- 
-       theta = i * dtheta 
-       sigmasq =0
-       Cgl2=0
-       fac = theta /dbessel
-      
-       do l=lmin,CP%Max_l
- 
- !Interpolate the Bessel functions, and compute sigma^2 and C_{gl,2} 
-         b0 = l*fac
-         b_lo = int(b0) +1 
-         a0=  b_lo - b0                
-         b0=  1._dl - a0 
-         fac1 = a0*b0*dbessfac
-         fac2 = fac1*(a0-2)
-         fac1 = fac1*(b0-2)
- 
-         Bessel0(l) = a0*Bess0(b_lo)+ b0*Bess0(b_lo+1) +fac1*ddBess0(b_lo) &
-                        +fac2*ddBess0(b_lo+1)
-         sigmasq = sigmasq + (1-Bessel0(l))*Cphil3(l) 
- 
- 
-         Bessel2(l) = a0*Bess2(b_lo)+ b0*Bess2(b_lo+1) +fac1*ddBess2(b_lo) &
-                       +fac2*ddBess2(b_lo+1)
-         Cgl2 =  Cgl2 + Bessel2(l)*Cphil3(l)
- 
-         Bessel4(l) = a0*Bess4(b_lo)+ b0*Bess4(b_lo+1) +fac1*ddBess4(b_lo) &
-                       +fac2*ddBess4(b_lo+1)
-         Bessel6(l) = a0*Bess6(b_lo)+ b0*Bess6(b_lo+1) +fac1*ddBess6(b_lo) &
-                       +fac2*ddBess6(b_lo+1)
- 
-       end do
- 
- !Get difference between lensed and unlensed correlation function
-      corr = 0
-       do l=lmin,CP%Max_l
- !For 2nd order perturbative result use 
- !         expsig = 1 -sigmasq*l**2/2._dl
- !         C2term = l**2*Cgl2/2._dl
-           fac = sigmasq*lfacs(l)
-           expsig = exp(-fac) 
-           C2term = Cgl2*lfacs(l)
- !Put theta factor later  in here
-           fac1 = expsig*theta
-           fac2 = C2term*fac1
-           fac1 = fac1 - theta  !we want expsig-1 to get lensing difference
- 
-           fac = fac1*Bessel0(l) + fac2*Bessel2(l) 
- 
-           !TT
-           corr(1) = corr(1) + CTT(l) * fac                              
- 
-           !Q + U
-           corr(2) = corr(2) + CEE(l) * fac                              
-           fac2 = fac2*0.5_dl
-           !Q-U
-           corr(3) = corr(3) + CEE(l) * &
-               (fac1*Bessel4(l) + fac2*(Bessel2(l)+Bessel6(l)))                               
-           !Cross
-           corr(4) = corr(4) + CTE(l) * &
-               (fac1*Bessel2(l) + fac2*(Bessel0(l)+Bessel4(l)))                               
-  
- 
-       end do
- 
-       
-  !$   thread_ix = OMP_GET_THREAD_NUM()+1
- 
-       do l=lmin, lmax_lensed
-        !theta factors were put in earlier (already in corr)
-        lens_contrib(C_Temp, l, thread_ix)= lens_contrib(C_Temp,l, thread_ix) + &
-                                           corr(1)*Bessel0(l) 
-        T2 = corr(2)*Bessel0(l)
-        T4 = corr(3)*Bessel4(l)
-        lens_contrib(CT_E,l,thread_ix)  = lens_contrib(CT_E,l, thread_ix) + T2+T4
-        lens_contrib(CT_B,l,thread_ix)  = lens_contrib(CT_B,l, thread_ix) + T2-T4
-        lens_contrib(CT_Cross,l, thread_ix) = lens_contrib(CT_Cross,l, thread_ix) + &
-                                               corr(4)*Bessel2(l)
-       end do
- 
-      end do
-   !$OMP END PARALLEL DO
-      
-       do l=lmin, lmax_lensed
-        fac = l*(l+1)* 2*pi/OutputDenominator*dtheta
-        Cl_lensed(l,in,CT_Temp) = sum(lens_contrib(CT_Temp,l,:))*fac &
-                  + Cl_scalar(l,in,CT_Temp) 
-        Cl_lensed(l,in,CT_Cross) = sum(lens_contrib(CT_Cross,l,:))*fac &
-                  +Cl_scalar(l,in,C_Cross)
-        fac = fac /2 !(factor of 1/2 should have been in T2+/-T4 above           
-        Cl_lensed(l,in,CT_E) = sum(lens_contrib(CT_E,l,:))*fac &
-                  + Cl_scalar(l,in,CT_E) 
-        Cl_lensed(l,in,CT_B) = sum(lens_contrib(CT_B,l,:))*fac
-       end do
- 
-       end do !loop over different initial power spectra
-      deallocate(lens_contrib)
- 
-      if (DebugMsgs) write(*,*) GetTestTime()-timeprev, 'Time for corr lensing'
- 
- end subroutine CorrFuncFlatSky
- 
- subroutine BadHarmonic
-   use ModelParams
-   use ModelData
-   use lvalues
-   use InitialPower
-   integer maxl, i, in, almin, max_lensed_ix, maxl_phi
-   real(dl) , dimension (:,:,:), allocatable :: bare_cls
-   real(dl) pp(CP%InitPower%nn,CP%Max_l)
-   real(dl) asum(CP%InitPower%nn), RR(CP%InitPower%nn), roots(CP%Max_l)
-   real(dl) asum_TE(CP%InitPower%nn), asum_EE(CP%InitPower%nn), asum_BB(CP%InitPower%nn)
-   integer l1,l2,al,j, j1, k, hk, llp_1, llp_al, g1
-   real(dl)  F, fct
-   real(dl) g2l,g2l1, norm
-   real(dl) a3j(CP%Max_l*2+1), tF, expF
-   logical DoPol
-   real(dl) iContribs(lSamp%l0,CP%InitPower%nn, 1:4), intcontrib(lmin:lSamp%l(lSamp%l0))
-   real(dl) , dimension (:,:,:), allocatable :: iCl_lensed
-   integer max_j_contribs
- 
-   real(sp) timeprev
-     
- !Otherwise use second order perturbative harmonic method
- 
-   if (DebugMsgs) timeprev=GetTestTime()
- 
-   DoPol = CP%AccuratePolarization
- 
-   maxl = CP%Max_l
-  
-   if (allocated(Cl_lensed)) deallocate(Cl_lensed)
- 
- 
-   allocate(bare_cls(CP%InitPower%nn,maxl,1:4))
-   
-   RR = 0
-   do j=lmin,maxl
-      norm = OutputDenominator/(j*(j+1))
-      if (lensing_includes_tensors .and. CP%WantTensors .and. j<= CP%Max_l_tensor) then !Use total Cls
-       bare_cls(:,j,CT_Temp:CT_E) = (Cl_scalar(j,:,C_Temp:C_E) + &
-            Cl_tensor(j,:,CT_Temp:CT_E))*norm
-       bare_cls(:,j,CT_B) = Cl_tensor(j,:,CT_B)*norm
-       bare_cls(:,j,CT_Cross) =  (Cl_scalar(j,:,C_Cross) + &
-           Cl_tensor(j,:,CT_Cross))*norm
-      else
-       bare_cls(:,j,CT_Temp:CT_E) = Cl_scalar(j,:,C_Temp:C_E)*norm
-       bare_cls(:,j,CT_B) = 0
-       bare_cls(:,j,CT_Cross) =  Cl_scalar(j,:,C_Cross)*norm
-      end if
-      pp(:,j) = Cl_scalar(j,:,C_Phi)/real(j**2,dl)**2
-      RR = RR + j*(j+1)*real(2*j+1,dl)*pp(:,j)
-      roots(j) = sqrt(real(2*j+1,dl))
-   end do
- 
-   RR = RR/2/fourpi
-   if (RR(1) > 1e-5) then
-      write (*,*) 'You need to normalize realistically to use lensing.'
-      write (*,*) 'see http://cosmocoffee.info/viewtopic.php?t=94'
-    stop
-   end if
-   if (maxl > lmax_donelnfa) then 
-    !Get ln factorials
-    if (allocated(lnfa)) deallocate(lnfa)
-    allocate(lnfa(0:maxl*3+1))
-    lmax_donelnfa = maxl 
-    lnfa(0) = 0
-    do i=1,CP%Max_l*3+1 
-      lnfa(i)=lnfa(i-1) + log(real(i,dl))
-    end do
-   end if
-    
-   max_lensed_ix = lSamp%l0-1
-   do while(lSamp%l(max_lensed_ix) > maxl -250)
-      max_lensed_ix = max_lensed_ix -1
-   end do
-   lmax_lensed = lSamp%l(max_lensed_ix)
- 
-   allocate(iCl_lensed(max_lensed_ix, CP%InitPower%nn, 1:4))
- 
-   max_j_contribs = lSamp%l0-1
-   if (.not. DoPol) then
-            maxl_phi = min(maxl,nint(max(600,(maxl*2)/5)*scale*AccuracyBoost))
-            do while (lSamp%l(max_j_contribs) > maxl_phi)
-               max_j_contribs=max_j_contribs-1
-            end do
-   end if
- 
-   !$OMP PARALLEL DO DEFAULT(SHARED), SCHEDULE(DYNAMIC), SHARED(max_j_contribs) &
-   !$OMP PRIVATE(al,g1,llp_al,llp_1,g2l,asum,l1,g2l1,l2,k,hk,F,fct,almin), &
-   !$OMP PRIVATE(asum_EE,asum_BB,asum_TE,expF,tF, a3j, iContribs,in,intcontrib)
-   do j=max_lensed_ix,1,-1  
-      !Only compute lensed spectra at lSamp%l(j). Start with slow ones.
-      
-      al=lSamp%l(j)
- 
-      llp_al = al*(al+1)
-      g2l=sqrt((2*al+1)/fourpi)
- 
-      asum = 0
-      asum_EE = 0
-      asum_BB = 0
-      asum_TE = 0
- 
-    
-      do j1 = 1, max_j_contribs
-         !  Contributions to C_al are a smooth function of l_1 - so interpolate
-         l1=lSamp%l(j1)
- 
-         llp_1 = l1*(l1+1)
-         g2l1=roots(l1)
- 
-         almin = max(abs(al-l1),2)
- 
-         if (DoPol) then
- 
-           call rec3jj(a3j(almin),dble(l1),dble(al),0._dl,2._dl)
-           do l2= almin, min(maxl,al+l1)
-               g1 = llp_1+l2*(l2+1)-llp_al
-               if (g1 == 0 ) cycle
- 
-               k=al+l1+l2
-               fct=g1*g2l*g2l1*roots(l2)/2
-               tF = fct*a3j(l2)
- 
-               if (mod(k,2)==0) then
- 
-                  hk = k/2
-                  F = lnfa(hk)-lnfa(hk-al)-lnfa(hk-l1)-lnfa(hk-l2)+(lnfa(k-2*al)+lnfa(k-2*l1)&
-                   & +lnfa(k-2*l2)-lnfa(k+1))/2
-                  
-                  expF = exp(F)
- 
-                  asum=asum + bare_cls(:,l2,C_Temp)*(expF*fct)**2
-         
-                  asum_EE = asum_EE + bare_cls(:,l2,CT_E)*tF**2
-                  asum_BB = asum_BB + bare_cls(:,l2,CT_B)*tF**2
-                  if (mod(hk,2)/=0) tF=-tF
-                  asum_TE = asum_TE + bare_cls(:,l2,CT_Cross)*expF*fct*tF
- 
-               else
-                 
-                  asum_BB = asum_BB + bare_cls(:,l2,CT_E)*tF**2
-                  asum_EE = asum_EE +bare_cls(:,l2,CT_B)*tF**2 
- 
-               end if
-               
-           end do
- 
-         else !No polarization
-           do l2= almin +mod(al+l1+almin,2),min(maxl,al+l1), 2 
-              !Only do lSamp%l's where al + l1 + l2 is even
-              
-               g1 = llp_1+l2*(l2+1)-llp_al
-             
-               if (g1 == 0 ) cycle  !Contribution is zero
- 
-               k=al+l1+l2
-               hk=k/2
-            
-               fct=g1*g2l*g2l1*roots(l2)/2
-               expF = exp(2*(lnfa(hk)-lnfa(hk-al)-lnfa(hk-l1)-lnfa(hk-l2))+lnfa(k-2*al)+lnfa(k-2*l1)&
-                   & +lnfa(k-2*l2)-lnfa(k+1))
-               asum=asum + bare_cls(:,l2,CT_Temp)*expF *fct**2
-           
-           end do
-           end if !No polarization
- 
- 
-              iContribs(j1,:,CT_Temp) = asum*pp(:,l1)
-              if (DoPol) then
-                 iContribs(j1,:,CT_E) = asum_EE*pp(:,l1)
-                 iContribs(j1,:,CT_B) = asum_BB*pp(:,l1)
-                 iContribs(j1,:,CT_Cross) = asum_TE*pp(:,l1)
-              end if
-              asum = 0
-              asum_EE = 0
-              asum_BB = 0
-              asum_TE = 0
- 
-         
-        end do
- 
-           
-        !Interpolate contributions to sum and add up
-          do in=1, CP%InitPower%nn
-           
-             call InterpolateClArr(lSamp,iContribs(1,in,CT_Temp),intcontrib,max_j_contribs)
-             asum(in) = sum(intcontrib(lmin:lSamp%l(max_j_contribs)))
-             if (DoPol) then
-                call InterpolateClArr(lSamp,iContribs(1,in,CT_E),intcontrib,max_j_contribs)
-                asum_EE(in) = sum(intcontrib(lmin:lSamp%l(max_j_contribs)))
-                call InterpolateClArr(lSamp,iContribs(1,in,CT_B),intcontrib,max_j_contribs)
-                asum_BB(in) = sum(intcontrib(lmin:lSamp%l(max_j_contribs)))
-                call InterpolateClArr(lSamp,iContribs(1,in,CT_Cross),intcontrib,max_j_contribs)
-                asum_TE(in) = sum(intcontrib(lmin:lSamp%l(max_j_contribs)))
-             end if
-          end do
- 
-      iCl_lensed(j,:,CT_Temp) =  ((1-al*(al+1)*RR)*bare_cls(:,al,CT_Temp)  & !Linear part
-               + asum/(2*al+1))*llp_al/OutputDenominator !add quadratic part and *l(l+1)/2pi
-      if (DoPol) then
-         iCl_lensed(j,:,CT_E) = ((1-(al**2+al-4)*RR)*bare_cls(:,al,CT_E)  & 
-               + asum_EE/(2*al+1))*llp_al/OutputDenominator
-         iCl_lensed(j,:,CT_B) = ((1-(al**2+al-4)*RR)*bare_cls(:,al,CT_B)  & 
-               + asum_BB/(2*al+1))*llp_al/OutputDenominator
-         iCl_lensed(j,:,CT_Cross) =  ((1-(al**2+al-2)*RR)*bare_cls(:,al,CT_Cross) &
-                 + asum_TE/(2*al+1))*llp_al/OutputDenominator
- 
-      else
-         iCl_lensed(j,:,CT_E:CT_Cross) = bare_cls(:,al,CT_E:CT_Cross)
-      end if
- 
-   end do
-   !$OMP END PARALLEL DO
- 
-   deallocate(bare_cls)
- 
-   allocate(Cl_lensed(lmin:lmax_lensed,CP%InitPower%nn,1:4))
- 
-   !Interpolate to get final spectrum
-   do in=1, CP%InitPower%nn
-      do j = CT_Temp, CT_Cross
-       call InterpolateClArr(lSamp,iCl_lensed(1,in,j),Cl_lensed(lmin, in, j),max_lensed_ix)
-      end do
-   end do
- 
-   deallocate(iCl_lensed)
- 
-   if (DebugMsgs) then
-         if (FeedbackLevel>0) write(*,*) GetTestTime()-timeprev,' Timing for lensing'
-    end if
- 
- end subroutine BadHarmonic
- 
-       subroutine GetBessels(MaxArg)
-        real(dl), intent(in):: MaxArg
-        integer i
-        real(dl), allocatable, dimension(:) :: x
-        integer max_bes_ix
-        integer, save :: last_max = 0
- 
-        max_bes_ix = nint(MaxArg / dbessel) + 3
-        if (max_bes_ix > last_max) then
-            last_max = max_bes_ix
-            if (allocated(Bess0)) then
-              deallocate(Bess0,ddBess0)
-              deallocate(Bess2,ddBess2)
-              deallocate(Bess4,ddBess4)
-              deallocate(Bess6,ddBess6)
-            end if
-            allocate(Bess0(max_bes_ix),ddBess0(max_bes_ix))
-            allocate(Bess2(max_bes_ix),ddBess2(max_bes_ix))
-            allocate(Bess4(max_bes_ix),ddBess4(max_bes_ix))
-            allocate(Bess6(max_bes_ix),ddBess6(max_bes_ix))
- 
-            allocate(x(max_bes_ix))
-            Bess0(1)=1
-            Bess2(1)=0; Bess4(1)=0; Bess6(1)=0
-            x(1)=0
-            do i=2, max_bes_ix
-              x(i) = (i-1)*dbessel
-              Bess0(i) = Bessj0(x(i)) 
-              Bess2(i) = Bessj(2,x(i)) 
-              Bess4(i) = Bessj(4,x(i)) 
-              Bess6(i) = Bessj(6,x(i)) 
-            end do 
-            call spline(x,Bess0,max_bes_ix,spl_large,spl_large,ddBess0)
-            call spline(x,Bess2,max_bes_ix,spl_large,spl_large,ddBess2)
-            call spline(x,Bess4,max_bes_ix,spl_large,spl_large,ddBess4)
-            call spline(x,Bess6,max_bes_ix,spl_large,spl_large,ddBess6)
- 
-            deallocate(x)
-        end if
- 
-       end subroutine GetBessels
- 
- 
- 
-       FUNCTION bessj0(x)
-       real(dl) bessj0,x
-       real(dl) ax,xx,z
-       real(dl) p1,p2,p3,p4,p5,q1,q2,q3,q4,q5,r1,r2,r3,r4,r5,r6, &
-         s1,s2,s3,s4,s5,s6,y
-       SAVE p1,p2,p3,p4,p5,q1,q2,q3,q4,q5,r1,r2,r3,r4,r5,r6,s1,s2,s3,s4, &
-        s5,s6
-       DATA p1,p2,p3,p4,p5/1.d0,-.1098628627d-2,.2734510407d-4, &
-       -.2073370639d-5,.2093887211d-6/, q1,q2,q3,q4,q5/-.1562499995d-1, &
-       .1430488765d-3,-.6911147651d-5,.7621095161d-6,-.934945152d-7/
-       DATA r1,r2,r3,r4,r5,r6/57568490574.d0,-13362590354.d0, &
-        651619640.7d0,-11214424.18d0,77392.33017d0,-184.9052456d0/,s1,s2, &
-        s3,s4,s5,s6/57568490411.d0,1029532985.d0,9494680.718d0, &
-        59272.64853d0,267.8532712d0,1.d0/
- 
-       if(abs(x).lt.8.d0)then
-         y=x**2
-         bessj0=(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6)))))/(s1+y*(s2+y*(s3+y* &
-           (s4+y*(s5+y*s6)))))
-       else
-         ax=abs(x)
-         z=8.d0/ax
-         y=z**2
-         xx=ax-.785398164d0
-         bessj0=sqrt(.636619772d0/ax)*(cos(xx)*(p1+y*(p2+y*(p3+y*(p4+y* &
-            p5))))-z*sin(xx)*(q1+y*(q2+y*(q3+y*(q4+y*q5)))))
-       endif
- !  (C) Copr. 1986-92 Numerical Recipes Software
- 
-       END FUNCTION bessj0
- 
- 
- 
-       FUNCTION BESSJ1(X)
-       real(dl), intent(in) :: x
-       real(dl) bessj1,ax,z,xx
-       real(dl) Y,P1,P2,P3,P4,P5,Q1,Q2,Q3,Q4,Q5,R1,R2,R3,R4,R5, &
-          R6,S1,S2,S3,S4,S5,S6
-       DATA R1,R2,R3,R4,R5,R6/72362614232.D0,-7895059235.D0,242396853.1D0,&
-          -2972611.439D0,15704.48260D0,-30.16036606D0/, &
-          S1,S2,S3,S4,S5,S6/144725228442.D0,2300535178.D0, &
-          18583304.74D0,99447.43394D0,376.9991397D0,1.D0/
-       DATA P1,P2,P3,P4,P5/1.D0,.183105D-2,-.3516396496D-4,.2457520174D-5, & 
-          -.240337019D-6/, Q1,Q2,Q3,Q4,Q5/.04687499995D0,-.2002690873D-3, &     
-          .8449199096D-5,-.88228987D-6,.105787412D-6/
-       IF(ABS(X).LT.8.)THEN
-         Y=X**2
-         BESSJ1=X*(R1+Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6))))) &
-            /(S1+Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6)))))
-       ELSE
-         AX=ABS(X)
-         Z=8.0d0/AX
-         Y=Z**2
-         XX=AX-2.356194491d0
-         BESSJ1=SQRT(.636619772d0/AX)*(COS(XX)*(P1+Y*(P2+Y*(P3+Y*(P4+Y &
-            *P5))))-Z*SIN(XX)*(Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5))))) &
-            *SIGN(1._dl,x)
-       ENDIF
- 
-       END FUNCTION BESSJ1
- 
- 
-       FUNCTION BESSJ(N,X)
-       real(dl) bessj
-       real(dl), intent(in) :: x
-       integer, intent(in) :: n
-       integer, parameter :: IACC = 40
-       real(dl), parameter :: BIGNO=1.d10,BIGNI=1.d-10
-       integer jsum,j,m
-       real(dl) bj,bjm, bjp, tox, sum
-       
-       IF(N.LT.2)STOP 'bad argument N in BESSJ'
- 
-       TOX=2/X
-       IF(X.GT.FLOAT(N))THEN
-         BJM=BESSJ0(X)
-         BJ=BESSJ1(X)
-         DO J=1,N-1
-           BJP=J*TOX*BJ-BJM
-           BJM=BJ
-           BJ=BJP
-         END DO
-         BESSJ=BJ
-       ELSE
-         M=2*((N+INT(SQRT(FLOAT(IACC*N))))/2)
-         BESSJ=0.0d0
-         JSUM=0
-         SUM=0._dl
-         BJP=0._dl
-         BJ=1._dl
-         DO J=M,1,-1
-           BJM=J*TOX*BJ-BJP
-           BJP=BJ
-           BJ=BJM
-           IF(ABS(BJ).GT.BIGNO)THEN
-             BJ=BJ*BIGNI
-             BJP=BJP*BIGNI
-             BESSJ=BESSJ*BIGNI
-             SUM=SUM*BIGNI
-           ENDIF
-           IF(JSUM.NE.0)SUM=SUM+BJ
-           JSUM=1-JSUM
-           IF(J.EQ.N)BESSJ=BJP
-         end do
-         SUM=2.*SUM-BJ
-         BESSJ=BESSJ/SUM
-       ENDIF
-       END FUNCTION BESSJ
- 
- 
- subroutine rec3jj(thrcof,l2,l3,m2,m3)
-   !Recursive evaluation of 3j symbols. Does minimal error checking on input parameters.
-   use Precision
- 
-   implicit none
-   real(dl), intent(in) :: l2,l3, m2,m3
-   real(dl) :: l1, m1, l1min,l1max, newfac,lmatch
-   real(dl), dimension(*) :: thrcof
-   integer ier
-   real(dl), parameter :: zero=0._dl, eps=0.01_dl, one=1._dl
-   real(dl) :: srtiny, sum1, tiny, oldfac, a1, a2, c1, dv, denom, c1old, &
-               x, sumuni, c2, sumfor, srhuge, huge, x1, x2, x3, sum2, &
-               a1s, a2s, y, sumbac, y1, y2, y3, ratio, cnorm, sign1, &
-               sign2, thresh
-   integer :: l1cmin, l1cmax, nfin, lstep, i, nstep2, nfinp1, nfinp2, &
-              nfinp3, index, nlim, n
- 
- 
- ! routine to generate set of 3j-coeffs (l1,l2,l3\\ m1,m2,m3)
- 
- ! by recursion from l1min = max(abs(l2-l3),abs(m1)) 
- !                to l1max = l2+l3
- ! the resulting 3j-coeffs are stored as thrcof(l1-l1min+1)
- 
- ! to achieve the numerical stability, the recursion will proceed
- ! simultaneously forwards and backwards, starting from l1min and l1max
- ! respectively.
- !
- ! lmatch is the l1-value at which forward and backward recursion are matched.
- !
- ! ndim is the length of the array thrcof
- !
- ! ier = -1 for all 3j vanish(l2-abs(m2)<0, l3-abs(m3)<0 or not integer)
- ! ier = -2 if possible 3j's exceed ndim
- ! ier >= 0 otherwise
- !
-   data tiny,srtiny /1.0d-30,1.0d-15/
-   data huge,srhuge /1.0d30,1.0d15/
- 
-   lmatch = zero
-   m1 = -(m2+m3)
- 
- ! check relative magnitude of l and m values
-   ier = 0
-  
-   if (l2 < abs(m2) .or. l3 < m3) then
-   ier = -1
-   return
-   end if
- 
- ! limits for l1
-   l1min = max(abs(l2-l3),abs(m1))
-   l1max = l2+l3
- 
-   if (l1min >= l1max-eps) then
-    if (l1min/=l1max) then
-    ier = -1
-    return
-    end if
- 
- ! reached if l1 can take only one value, i.e.l1min=l1max
-   thrcof(1) = (-1)**nint(abs(l2+m2-l3+m3))/sqrt(l1min+l2+l3+one)
-   l1cmin = l1min
-   l1cmax = l1max
-   return
- 
-   end if
- 
-   nfin = int(l1max-l1min+one)
-  
- 
- ! starting forward recursion from l1min taking nstep1 steps
-   l1 = l1min
-   thrcof(1) = srtiny
-   sum1 = (2*l1 + 1)*tiny
- 
-   lstep = 1
- 
- 30  lstep = lstep+1
-   l1 = l1+1
- 
-   oldfac = newfac
-   a1 = (l1+l2+l3+1)*(l1-l2+l3)*(l1+l2-l3)*(-l1+l2+l3+1)
-   a2 = (l1+m1)*(l1-m1)
-   newfac = sqrt(a1*a2)
-   if (l1 < one+eps) then
-      !IF L1 = 1  (L1-1) HAS TO BE FACTORED OUT OF DV, HENCE
-      c1 = -(2*l1-1)*l1*(m3-m2)/newfac
-   else
- 
-    dv = -l2*(l2+1)*m1 + l3*(l3+1)*m1 + l1*(l1-1)*(m3-m2)
-    denom = (l1-1)*newfac
- 
-    if (lstep > 2) c1old = abs(c1)
-    c1 = -(2*l1-1)*dv/denom
- 
-   end if
- 
-   if (lstep<= 2) then
- 
- ! if l1=l1min+1 the third term in the recursion eqn vanishes, hence
-    x = srtiny*c1
-    thrcof(2) = x
-    sum1 = sum1+tiny*(2*l1+1)*c1*c1
-    if(lstep==nfin) then
-       sumuni=sum1
-       go to 230
-    end if
-    goto 30
- 
-   end if
- 
-   c2 = -l1*oldfac/denom
- 
- ! recursion to the next 3j-coeff x  
-   x = c1*thrcof(lstep-1) + c2*thrcof(lstep-2)
-   thrcof(lstep) = x
-   sumfor = sum1
-   sum1 = sum1 + (2*l1+1)*x*x
-   if (lstep/=nfin) then
- 
- ! see if last unnormalised 3j-coeff exceeds srhuge
-   if (abs(x) >= srhuge) then
-      
-      ! REACHED IF LAST 3J-COEFFICIENT LARGER THAN SRHUGE
-      ! SO THAT THE RECURSION SERIES THRCOF(1), ... , THRCOF(LSTEP)
-      ! HAS TO BE RESCALED TO PREVENT OVERFLOW
-      
-      ier = ier+1
-      do i = 1, lstep
-         if (abs(thrcof(i)) < srtiny) thrcof(i)= zero
-         thrcof(i) = thrcof(i)/srhuge
-      end do
- 
-      sum1 = sum1/huge
-      sumfor = sumfor/huge
-      x = x/srhuge
- 
-   end if
- 
- ! as long as abs(c1) is decreasing, the recursion proceeds towards increasing
- ! 3j-valuse and so is numerically stable. Once an increase of abs(c1) is 
- ! detected, the recursion direction is reversed.
- 
-  if (c1old > abs(c1)) goto 30
- 
-  end if !lstep/=nfin
- 
- ! keep three 3j-coeffs around lmatch for comparison with backward recursion
- 
-   lmatch = l1-1
-   x1 = x
-   x2 = thrcof(lstep-1)
-   x3 = thrcof(lstep-2)
-   nstep2 = nfin-lstep+3
- 
- ! --------------------------------------------------------------------------
- !
- ! starting backward recursion from l1max taking nstep2 stpes, so that
- ! forward and backward recursion overlap at 3 points 
- ! l1 = lmatch-1, lmatch, lmatch+1
- 
-   nfinp1 = nfin+1
-   nfinp2 = nfin+2
-   nfinp3 = nfin+3
-   l1 = l1max
-   thrcof(nfin) = srtiny
-   sum2 = tiny*(2*l1+1)
-  
-   l1 = l1+2
-   lstep=1
- 
-   do
-   lstep = lstep + 1
-   l1= l1-1
- 
-   oldfac = newfac
-   a1s = (l1+l2+l3)*(l1-l2+l3-1)*(l1+l2-l3-1)*(-l1+l2+l3+2)
-   a2s = (l1+m1-1)*(l1-m1-1)
-   newfac = sqrt(a1s*a2s)
- 
-   dv = -l2*(l2+1)*m1 + l3*(l3+1)*m1 +l1*(l1-1)*(m3-m2)
- 
-   denom = l1*newfac
-   c1 = -(2*l1-1)*dv/denom
-   if (lstep <= 2) then
- 
-      ! if l2=l2max+1, the third term in the recursion vanishes
-      
-      y = srtiny*c1
-      thrcof(nfin-1) = y
-      sumbac = sum2
-      sum2 = sum2 + tiny*(2*l1-3)*c1*c1
- 
-      cycle
- 
-   end if
- 
-   c2 = -(l1-1)*oldfac/denom
- 
- ! recursion to the next 3j-coeff y
-   y = c1*thrcof(nfinp2-lstep)+c2*thrcof(nfinp3-lstep)
- 
-   if (lstep==nstep2) exit
-   
-   thrcof(nfinp1-lstep) = y
-   sumbac = sum2
-   sum2 = sum2+(2*l1-3)*y*y
- 
- ! see if last unnormalised 3j-coeff exceeds srhuge
-   if (abs(y) >= srhuge) then
-      
-      ! reached if 3j-coeff larger than srhuge so that the recursion series
-      ! thrcof(nfin),..., thrcof(nfin-lstep+1) has to be rescaled to prevent overflow
-      
-      ier=ier+1
-      do i = 1, lstep
-         index=nfin-i+1
-         if (abs(thrcof(index)) < srtiny) thrcof(index)=zero
-         thrcof(index) = thrcof(index)/srhuge
-      end do
- 
-      sum2=sum2/huge
-      sumbac=sumbac/huge
- 
-   end if
- 
-   end do
- 
- ! the forward recursion 3j-coeffs x1, x2, x3 are to be matched with the 
- ! corresponding backward recursion vals y1, y2, y3
- 
-   y3 = y
-   y2 = thrcof(nfinp2-lstep)
-   y1 = thrcof(nfinp3-lstep)
- 
- ! determine now ratio such that yi=ratio*xi (i=1,2,3) holds with minimal error
- 
-   ratio = (x1*y1+x2*y2+x3*y3)/(x1*x1+x2*x2+x3*x3)
-   nlim = nfin-nstep2+1
- 
-   if (abs(ratio) >= 1) then
- 
-    thrcof(1:nlim) = ratio*thrcof(1:nlim) 
-    sumuni = ratio*ratio*sumfor + sumbac
- 
-   else
- 
-   nlim = nlim+1
-   ratio = 1/ratio
-   do n = nlim, nfin
-      thrcof(n) = ratio*thrcof(n)
-   end do
-   sumuni = sumfor + ratio*ratio*sumbac
- 
-   end if
- ! normalise 3j-coeffs
- 
- 230 cnorm = 1/sqrt(sumuni)
- 
- ! sign convention for last 3j-coeff determines overall phase
- 
-   sign1 = sign(one,thrcof(nfin))
-   sign2 = (-1)**nint(abs(l2+m2-l3+m3))
-   if (sign1*sign2 <= 0) then
-     cnorm = -cnorm
-   end if
-   if (abs(cnorm) >= one) then
-      thrcof(1:nfin) = cnorm*thrcof(1:nfin)
-      return
-   end if
- 
-   thresh = tiny/abs(cnorm)
- 
-   do n = 1, nfin
-      if (abs(thrcof(n)) < thresh) thrcof(n) = zero
-      thrcof(n) = cnorm*thrcof(n)
-   end do
-   return 
- 
- end subroutine rec3jj
- 
- ! ----------------------------------------------------------------------
- ! Auxiliary Bessel functions for N=0, N=1
-       FUNCTION BESSI0(X)
-       double precision X,BESSI0,Y,P1,P2,P3,P4,P5,P6,P7,  &
-       Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,AX,BX
-       DATA P1,P2,P3,P4,P5,P6,P7/1.D0,3.5156229D0,3.0899424D0,1.2067429D0,  &
-       0.2659732D0,0.360768D-1,0.45813D-2/
-       DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,0.1328592D-1, &
-       0.225319D-2,-0.157565D-2,0.916281D-2,-0.2057706D-1,  &
-       0.2635537D-1,-0.1647633D-1,0.392377D-2/
-       IF(ABS(X).LT.3.75D0) THEN
-       Y=(X/3.75D0)**2
-       BESSI0=P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7)))))
-       ELSE
-       AX=ABS(X)
-       Y=3.75D0/AX
-       BX=EXP(AX)/SQRT(AX)
-       AX=Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9)))))))
-       BESSI0=AX*BX
-       ENDIF
-       RETURN
-       END FUNCTION BESSI0
- ! ----------------------------------------------------------------------
-       FUNCTION BESSI1(X)
-       double precision X,BESSI1,Y,P1,P2,P3,P4,P5,P6,P7,  &
-       Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9,AX,BX
-       DATA P1,P2,P3,P4,P5,P6,P7/0.5D0,0.87890594D0,0.51498869D0,  &
-       0.15084934D0,0.2658733D-1,0.301532D-2,0.32411D-3/
-       DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,-0.3988024D-1, &
-       -0.362018D-2,0.163801D-2,-0.1031555D-1,0.2282967D-1, &
-       -0.2895312D-1,0.1787654D-1,-0.420059D-2/
-       IF(ABS(X).LT.3.75D0) THEN
-       Y=(X/3.75D0)**2
-       BESSI1=X*(P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
-       ELSE
-       AX=ABS(X)
-       Y=3.75D0/AX
-       BX=EXP(AX)/SQRT(AX)
-       AX=Q1+Y*(Q2+Y*(Q3+Y*(Q4+Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9)))))))
-       BESSI1=AX*BX
-       ENDIF
-       RETURN
-       END FUNCTION BESSI1
- 
- 
-       FUNCTION BESSI(N,X)
-       !from http://perso.orange.fr/jean-pierre.moreau/Fortran/tbessi_f90.txt
- !
- !     This subroutine calculates the first kind modified Bessel function
- !     of integer order N, for any REAL X. We use here the classical
- !     recursion formula, when X > N. For X < N, the Miller's algorithm
- !     is used to avoid overflows. 
- !     REFERENCE:
- !     C.W.CLENSHAW, CHEBYSHEV SERIES FOR MATHEMATICAL FUNCTIONS,
- !     MATHEMATICAL TABLES, VOL.5, 1962.
-       integer, intent(in) :: N
-       integer, PARAMETER :: IACC = 40
-       integer m,j
-       double precision, parameter ::  BIGNO = 1.D10, BIGNI = 1.D-10
-       double precision X,BESSI,TOX,BIM,BI,BIP
-       IF (N.EQ.0) THEN
-       BESSI = BESSI0(X)
-       RETURN
-       ENDIF
-       IF (N.EQ.1) THEN
-       BESSI = BESSI1(X)
-       RETURN
-       ENDIF
-       IF(X.EQ.0.D0) THEN
-       BESSI=0.D0
-       RETURN
-       ENDIF
-       TOX = 2.D0/X
-       BIP = 0.D0
-       BI  = 1.D0
-       BESSI = 0.D0
-       M = 2*((N+INT(SQRT(FLOAT(IACC*N)))))
-       DO J = M,1,-1
-       BIM = BIP+ J*TOX*BI
-       BIP = BI
-       BI  = BIM
-       IF (ABS(BI).GT.BIGNO) THEN
-       BI  = BI*BIGNI
-       BIP = BIP*BIGNI
-       BESSI = BESSI*BIGNI
-       ENDIF
-       IF (J.EQ.N) BESSI = BIP
-       END DO
-       BESSI = BESSI*BESSI0(X)/BI
-       RETURN
-       END FUNCTION BESSI
- 
- 
- end module lensing
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/Makefile cosmomc_sampler/camb/Makefile
*** cosmomc/camb/Makefile	2009-10-22 15:59:31.000000000 +0200
--- cosmomc_sampler/camb/Makefile	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,69 ****
- #CAMB Makefile
- 
- #Edit for your compiler
- #Note there are many ifc versions, some of which behave oddly
- 
- #Intel , -openmp toggles mutli-processor:
- #note version 10.0 gives wrong result for lensed when compiled with -openmp [fixed in 10.1]
- F90C     = ifort
- FFLAGS = -openmp -O2 -ip -W0 -WB -fpp2 -vec_report0
- 
- # Intel 9 on IA-64 (eg. COSMOS)
- # (do "module load icomp90" before compiling)
- #F90C = ifort
- #FFLAGS = -openmp -fpp2 -w -O3 -ip -mP2OPT_hlo_prefetch=F
- 
- #Intel ifc, add -openmp for multi-processor (some have bugs):
- #F90C     = ifc
- #FFLAGS = -O2 -Vaxlib -ip -W0 -WB -quiet -fpp2
- #some systems can can also add e.g. -tpp7 -xW
- 
- #G95 compiler
- #F90C   = g95
- #FFLAGS = -O2
- 
- #Gfortran compiler: if pre v4.3 add -D__GFORTRAN__
- #F90C     = gfc
- #FFLAGS =  -O2 
- 
- #SGI, -mp toggles multi-processor. Use -O2 if -Ofast gives problems.
- #F90C     = f90
- #FFLAGS  = -Ofast -mp
- 
- #Digital/Compaq fortran, -omp toggles multi-processor
- #F90C    = f90
- #FFLAGS  = -omp -O4 -arch host -math_library fast -tune host -fpe1
- 
- #Absoft ProFortran, single processor:
- #F90C     = f95
- #FFLAGS = -O2 -cpu:athlon -s -lU77 -w -YEXT_NAMES="LCS" -YEXT_SFX="_"
- 
- #NAGF95, single processor:
- #F90C     = f95
- #FFLAGS = -DNAGF95 -O3
- 
- #PGF90
- #F90C = pgf90
- #FFLAGS = -O2 -DESCAPEBACKSLASH
- 
- #Sun V880
- #F90C = mpf90
- #FFLAGS =  -O4 -openmp -ftrap=%none -dalign -DMPI
- 
- #Sun parallel enterprise:
- #F90C     = f95
- #FFLAGS =  -O2 -xarch=native64 -openmp -ftrap=%none
- #try removing -openmp if get bus errors. -03, -04 etc are dodgy.
- 
- #IBM XL Fortran, multi-processor (run gmake)
- #F90C     = xlf90_r
- #FFLAGS  = -DESCAPEBACKSLASH -DIBMXL -qsmp=omp -qsuffix=f=f90:cpp=F90 -O3 -qstrict -qarch=pwr3 -qtune=pwr3
- 
- #Settings for building camb_fits
- #Location of FITSIO and name of library
- FITSDIR       = /home/cpac/cpac-tools/lib
- FITSLIB       = cfitsio
- #Location of HEALPIX for building camb_fits
- HEALPIXDIR    = /home/cpac/cpac-tools/healpix
- 
- include ./Makefile_main
\ No newline at end of file
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/Makefile_main cosmomc_sampler/camb/Makefile_main
*** cosmomc/camb/Makefile_main	2009-10-22 16:11:40.000000000 +0200
--- cosmomc_sampler/camb/Makefile_main	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,63 ****
- 
- #Files containing evolution equations initial power spectrum module
- EQUATIONS     = equations
- POWERSPECTRUM = power_tilt
- REIONIZATION = reionization
- RECOMBINATION = recfast
- 
- #Module doing non-linear scaling
- NONLINEAR     = halofit
- 
- #Driver program
- DRIVER        = inidriver.F90
- #DRIVER        = sigma8.f90
- #DRIVER        = tester.f90
- 
- 
- CAMBLIB       = libcamb.a
- 
- #Shouldn't need to change anything else...
- 
- F90FLAGS      = $(FFLAGS)
- HEALPIXLD     = -L$(HEALPIXDIR)/lib -lhealpix -L$(FITSDIR) -l$(FITSLIB)
- 
- CAMBOBJ       = constants.o utils.o subroutines.o inifile.o $(POWERSPECTRUM).o $(RECOMBINATION).o $(REIONIZATION).o modules.o \
- 	bessels.o $(EQUATIONS).o $(NONLINEAR).o lensing.o cmbmain.o camb.o
- 
- default: camb
- 
- all: camb $(CAMBLIB)
- 
- 
- subroutines.o: constants.o utils.o
- $(POWERSPECTRUM): subroutines.o  inifile.o
- $(RECOMBINATION).o: subroutines.o inifile.o
- $(REIONIZATION).o: constants.o inifile.o
- modules.o: $(REIONIZATION).o
- bessels.o: modules.o
- $(EQUATIONS): bessels.o
- $(NONLINEAR).o:  modules.o
- lensing.o: bessels.o
- cmbmain.o: lensing.o
- camb.o: cmbmain.o
- 
- 
- camb: $(CAMBOBJ) $(DRIVER)
- 	$(F90C) $(F90FLAGS) $(CAMBOBJ) $(DRIVER) -o $@
- 
- $(CAMBLIB): $(CAMBOBJ)
- 	ar -r $@ $?
- 
- camb_fits: writefits.f90 $(CAMBOBJ) $(DRIVER)
- 	$(F90C) $(F90FLAGS) -I$(HEALPIXDIR)/include $(CAMBOBJ) writefits.f90 $(DRIVER) $(HEALPIXLD) -DWRITE_FITS -o $@
- 
- %.o: %.f90
- 	$(F90C) $(F90FLAGS) -c $*.f90
- 
- utils.o:
- 	$(F90C) $(F90FLAGS) -c utils.F90	
- 
- clean:
- 	-rm -f *.o *.a *.d core *.mod
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/modules.f90 cosmomc_sampler/camb/modules.f90
*** cosmomc/camb/modules.f90	2008-09-16 17:57:58.000000000 +0200
--- cosmomc_sampler/camb/modules.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,2460 ****
- !     Modules used by cmbmain and other routines.
- 
- !     Code for Anisotropies in the Microwave Background
- !     by Antony Lewis (http://cosmologist.info) and Anthony Challinor
- !     See readme.html for documentation. This version July 2008.
- !
- !     Based on CMBFAST  by  Uros Seljak and Matias Zaldarriaga, itself based
- !     on Boltzmann code written by Edmund Bertschinger, Chung-Pei Ma and Paul Bode.
- !     Original CMBFAST copyright and disclaimer:
- !
- !     Copyright 1996 by Harvard-Smithsonian Center for Astrophysics and
- !     the Massachusetts Institute of Technology.  All rights reserved.
- !
- !     THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. OR C.f.A. MAKE NO
- !     REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.
- !     By way of example, but not limitation,
- !     M.I.T. AND C.f.A MAKE NO REPRESENTATIONS OR WARRANTIES OF
- !     MERCHANTABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE OR THAT
- !     THE USE OF THE LICENSED SOFTWARE OR DOCUMENTATION WILL NOT INFRINGE
- !     ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.
- !
- !     portions of this software are based on the COSMICS package of
- !     E. Bertschinger.  See the LICENSE file of the COSMICS distribution
- !     for restrictions on the modification and distribution of this software.
- 
- 
-         module ModelParams
-         use precision
-         use Ranges
-         use InitialPower
-         use Reionization
-         use Recombination
-         
-         implicit none    
-         public
- 
-         character(LEN=*), parameter :: version = 'Sept_08'
-         
-         integer :: FeedbackLevel = 0 !if >0 print out useful information about the model
- 
-         logical, parameter :: DebugMsgs=.false. !Set to true to view progress and timing
- 
-         logical, parameter :: DebugEvolution = .false. !Set to true to do all the evolution for all k
- 
-         integer, parameter :: Nu_int = 0, Nu_trunc=1, Nu_approx = 2, Nu_best = 3
-          !For CAMBparams%MassiveNuMethod
-          !Nu_int: always integrate distribution function
-          !Nu_trunc: switch to expansion in velocity once non-relativistic
-          !Nu_approx: approximate scheme - good for CMB, but not formally correct and no good for matter power
-          !Nu_best: automatically use mixture which is fastest and most accurate
- 
-         integer, parameter :: max_Nu = 5 !Maximum number of neutrino species    
-         integer, parameter :: max_transfer_redshifts = 128
-         integer, parameter :: fileio_unit = 13 !Any number not used elsewhere will do       
-         integer, parameter :: outCOBE=0, outNone=1
-     
-         integer :: max_bessels_l_index  = 1000000
-         real(dl) :: max_bessels_etak = 1000000*2
- 
- 
-         real(dl), parameter ::  OutputDenominator =twopi
-        !When using outNone the output is l(l+1)Cl/OutputDenominator
- 
- 
-         Type(Regions) :: TimeSteps
- 
- 
-         type TransferParams
-             logical     ::  high_precision
-             integer     ::  num_redshifts
-             real(dl)    ::  kmax         !these are acutally q values, but same as k for CP%flat
-             integer     ::  k_per_logint ! ..
-             real(dl)    ::  redshifts(max_transfer_redshifts)         
-         end type TransferParams
- 
- !other variables, options, derived variables, etc.
- 
-          integer, parameter :: NonLinear_none=0, NonLinear_Pk =1, NonLinear_Lens=2
- 
- ! Main parameters type
-         type CAMBparams
-     
-          logical   :: WantCls, WantTransfer
-          logical   :: WantScalars, WantTensors, WantVectors
-          logical   :: DoLensing
-          integer   :: NonLinear
- 
-          integer   :: Max_l, Max_l_tensor
-          real(dl)  :: Max_eta_k, Max_eta_k_tensor
-           ! _tensor settings only used in initialization, 
-           !Max_l and Max_eta_k are set to the tensor variables if only tensors requested
- 
-          real(dl)  :: omegab, omegac, omegav, omegan
-          !Omega baryon, CDM, Lambda and massive neutrino
-          real(dl)  :: H0,TCMB,yhe,Num_Nu_massless,Num_Nu_massive
- 
-          logical :: Nu_mass_splittings
-          integer   :: Nu_mass_eigenstates  !1 for degenerate masses
-          real(dl)  :: Nu_mass_degeneracies(max_nu)
-          real(dl)  :: Nu_mass_fractions(max_nu)
-              !The ratios of the masses
- 
-          integer   :: Scalar_initial_condition 
-          !must be one of the initial_xxx values defined in GaugeInterface
-          
-          integer   :: OutputNormalization  
-          !outNone, outCOBE, or C_OutputNormalization=1 if > 1
- 
-          logical   :: AccuratePolarization
-            !Do you care about the accuracy of the polarization Cls?
-   
-          logical   :: AccurateBB
-            !Do you care about BB accuracy (e.g. in lensing)
- 
- !Reionization settings - used if Reion%Reionization=.true.
-          logical   :: AccurateReionization
-            !Do you care about pecent level accuracy on EE signal from reionization?
- 
-          integer   :: MassiveNuMethod
-         
-          type(InitialPowerParams) :: InitPower  !see power_tilt.f90 - you can change this
-          type(ReionizationParams) :: Reion
-          type(RecombinationParams) :: Recomb
-          type(TransferParams)     :: Transfer 
- 
-          real(dl) ::  InitialConditionVector(1:10) !Allow up to 10 for future extensions
-           !ignored unless Scalar_initial_condition == initial_vector
- 
-          logical OnlyTransfers !Don't use initial power spectrum data, instead get Delta_q_l array
-            !If trye, sigma_8 is not calculated either
- 
- !Derived parameters, not set initially
-          type(ReionizationHistory) :: ReionHist
-          
-          logical flat,closed,open
-          real(dl) omegak
-          real(dl) curv,r, Ksign !CP%r = 1/sqrt(|CP%curv|), CP%Ksign = 1,0 or -1
-          real(dl) tau0,chi0 !time today and rofChi(CP%tau0/CP%r) 
-     
-          
-          end type CAMBparams
- 
-         type(CAMBparams) CP  !Global collection of parameters
- 
- 
-        real(dl) scale !relative to CP%flat. e.g. for scaling lSamp%l sampling.
- 
-        logical ::call_again = .false.
-           !if being called again with same parameters to get different thing
- 
-  
- !     grhom =kappa*a^2*rho_m0
- !     grhornomass=grhor*number of massless neutrino species
- !     taurst,taurend - time at start/end of recombination
- !     dtaurec - dtau during recombination
- !     adotrad - a(tau) in radiation era
- 
-         real(dl) grhom,grhog,grhor,grhob,grhoc,grhov,grhornomass,grhok
-         real(dl) taurst,dtaurec,taurend, tau_maxvis,adotrad
- 
- !Neutrinos
-         real(dl) grhormass(max_nu)
-      
- !     nu_masses=m_nu*c**2/(k_B*T_nu0)      
-        real(dl) :: nu_masses(max_nu) 
-         
-        real(dl) akthom !sigma_T * (number density of protons now)
-        real(dl) fHe !n_He_tot / n_H_tot
-        real(dl) Nnow
- 
- 
-       integer :: ThreadNum = 0 
-        !If zero assigned automatically, obviously only used if parallelised
-    
- !Parameters for checking/changing overall accuracy
- !1._dl corresponds to target 1% scalar accuracy for non-extreme models
- 
-       real(dl) :: lSampleBoost=1._dl
-           !Increase lSampleBoost to increase sampling in lSamp%l for Cl interpolation
-           
-       real(dl) :: AccuracyBoost =1._dl  
- 
- 
-           !Decrease step sizes, etc. by this parameter. Useful for checking accuracy.
-           !Can also be used to improve speed significantly if less accuracy is required.              
-           !or improving accuracy for extreme models. 
-           !Note this does not increase lSamp%l sampling or massive neutrino q-sampling
- 
-       real(sp) :: lAccuracyBoost=1. 
-           !Boost number of multipoles integrated in Boltzman heirarchy
- 
-       integer, parameter :: lmin = 2
-           !must be either 1 or 2       
- 
-       real(dl), parameter :: OmegaKFlat = 5e-7_dl !Value at which to use flat code
- 
-       real(dl),parameter :: tol=1.0d-4 !Base tolerance for integrations
- 
- !     used as parameter for spline - tells it to use 'natural' end values
-       real(dl), parameter :: spl_large=1.e40_dl
- 
-       integer, parameter:: l0max=4000
- 
- !     lmax is max possible number of l's evaluated
-       integer, parameter :: lmax_arr = 100+l0max/7
-  
-         contains
-       
- 
-          subroutine CAMBParams_Set(P, error, DoReion)
-            use constants
-            type(CAMBparams), intent(in) :: P
-            real(dl) GetOmegak
-            integer, optional :: error !Zero if OK
-            logical, optional :: DoReion
-            logical WantReion
-            integer nu_i
-            external GetOmegak
-            real(dl), save :: last_tau0
-            !Constants in SI units
- 
-             if ((P%WantTensors .or. P%WantVectors).and. P%WantTransfer .and. .not. P%WantScalars) then
-               write (*,*) 'Cannot generate tensor C_l and transfer without scalar C_l'
-               if (present(error)) then
-                 error = 1
-                 return
-               else
-                 stop
-               end if
-            end if
-            
-            if (present(DoReion)) then
-             WantReion = DoReion
-            else
-             WantReion = .true.
-            end if
-         
-            CP=P
-           
-            CP%Max_eta_k = max(CP%Max_eta_k,CP%Max_eta_k_tensor)
-            
-            if (CP%WantTransfer) then
-               CP%WantScalars=.true.
-               if (.not. CP%WantCls) then
-                  CP%AccuratePolarization = .false.
-                  CP%Reion%Reionization = .false.
-               end if
-            else
-               CP%transfer%num_redshifts=0
-            end if
- 
-            if (CP%Omegan == 0 .and. CP%Num_Nu_Massive /=0) then
-               CP%Num_Nu_Massless = CP%Num_Nu_Massless + CP%Num_Nu_Massive
-               CP%Num_Nu_Massive  = 0
-            end if
- 
-            if (CP%Num_nu_massive > 0) then
-                if (.not. CP%Nu_mass_splittings) then
-                  !Default totally degenerate masses
-                  CP%Nu_mass_eigenstates = 1
-                  CP%Nu_mass_degeneracies(1) = CP%Num_Nu_Massive 
-                  CP%Nu_mass_fractions(1) = 1
-                else
-                  if (CP%Nu_mass_degeneracies(1)==0) CP%Nu_mass_degeneracies(1) = CP%Num_Nu_Massive 
-                  if (abs(sum(CP%Nu_mass_fractions(1:CP%Nu_mass_eigenstates))-1) > 1e-4) &
-                    stop 'Nu_mass_fractions do not add up to 1'
- 
-                  if (abs(sum(CP%Nu_mass_degeneracies(1:CP%Nu_mass_eigenstates))-CP%Num_nu_massive) >1e-4 ) &
-                     stop 'nu_mass_eigenstates do not add up to num_nu_massive'
-                  if (CP%Nu_mass_eigenstates==0) stop 'Have Num_nu_massive>0 but no nu_mass_eigenstates'
- 
-                end if
-            else
-             CP%Nu_mass_eigenstates = 0
-            end if
-            
-            if ((CP%WantTransfer).and. CP%MassiveNuMethod==Nu_approx) then
-               CP%MassiveNuMethod = Nu_trunc
-            end if
- 
-            CP%omegak = GetOmegak()
-           
-            CP%flat = (abs(CP%omegak) <= OmegaKFlat)
-            CP%closed = CP%omegak < -OmegaKFlat
-         
-            CP%open = .not.CP%flat.and..not.CP%closed
-            if (CP%flat) then
-               CP%curv=0
-               CP%Ksign=0
-               CP%r=1._dl !so we can use tau/CP%r, etc, where CP%r's cancel
-            else   
-            CP%curv=-CP%omegak/((c/1000)/CP%h0)**2
-            CP%Ksign =sign(1._dl,CP%curv)
-            CP%r=1._dl/sqrt(abs(CP%curv))
-            end if
- !  grho gives the contribution to the expansion rate from: (g) photons,
- !  (r) one flavor of relativistic neutrino (2 degrees of freedom),
- !  (m) nonrelativistic matter (for Omega=1).  grho is actually
- !  8*pi*G*rho/c^2 at a=1, with units of Mpc**(-2).
- !  a=tau(Mpc)*adotrad, with a=1 today, assuming 3 neutrinos.
- !  (Used only to set the initial conformal time.)
- 
-            !H0 is in km/s/Mpc
- 
-            grhom = 3*CP%h0**2/c**2*1000**2 !3*h0^2/c^2 (=8*pi*G*rho_crit/c^2)
-         
-           !grhom=3.3379d-11*h0*h0 
-            grhog = kappa/c**2*4*sigma_boltz/c**3*CP%tcmb**4*Mpc**2 !8*pi*G/c^2*4*sigma_B/c^3 T^4
-           ! grhog=1.4952d-13*tcmb**4
-            grhor = 7._dl/8*(4._dl/11)**(4._dl/3)*grhog !7/8*(4/11)^(4/3)*grhog (per neutrino species)
-           !grhor=3.3957d-14*tcmb**4
-            grhornomass=grhor*CP%Num_Nu_massless
-            grhormass=0
-            do nu_i = 1, CP%Nu_mass_eigenstates
-             grhormass(nu_i)=grhor*CP%Nu_mass_degeneracies(nu_i)
-            end do
-            grhoc=grhom*CP%omegac
-            grhob=grhom*CP%omegab
-            grhov=grhom*CP%omegav
-            grhok=grhom*CP%omegak
- !  adotrad gives the relation a(tau) in the radiation era:
-            adotrad = sqrt((grhog+grhornomass+sum(grhormass(1:CP%Nu_mass_eigenstates)))/3)
-        
-           
-            Nnow = CP%omegab*(1-CP%yhe)*grhom*c**2/kappa/m_H/Mpc**2
- 
-            akthom = sigma_thomson*Nnow*Mpc
-               !sigma_T * (number density of protons now)
-     
-            fHe = CP%YHe/(mass_ratio_He_H*(1.d0-CP%YHe))  !n_He_tot / n_H_tot
-       
-            if (CP%omegan==0) then
-               CP%Num_nu_massless = CP%Num_nu_massless + CP%Num_nu_massive
-               CP%Num_nu_massive = 0
-            end if
- 
-            if (.not.call_again) then
-       
-             call init_massive_nu(CP%omegan /=0)
-             call init_background
-             CP%tau0=TimeOfz(0._dl)
-         ! print *, 'chi = ',  (CP%tau0 - TimeOfz(0.15_dl)) * CP%h0/100   
-             last_tau0=CP%tau0
-             if (WantReion) call Reionization_Init(CP%Reion,CP%ReionHist, CP%YHe, akthom, CP%tau0, FeedbackLevel)
-            else
-               CP%tau0=last_tau0
-            end if         
-            
-            if ( CP%NonLinear==NonLinear_Lens) then
-              CP%Transfer%kmax = max(CP%Transfer%kmax, CP%Max_eta_k/CP%tau0) 
-              if (FeedbackLevel > 0 .and. CP%Transfer%kmax== CP%Max_eta_k/CP%tau0) &
-                   write (*,*) 'max_eta_k changed to ', CP%Max_eta_k
-            end if
- 
- 
-            if (CP%closed .and. CP%tau0/CP%r >3.14) then
-              if (present(error)) then
-               error = 2
-               return
-              else
-               stop 'chi >= pi in closed model not supported'
-              end if
-            end if
-     
-            if (present(error)) then
-               error = 0
-            else if (FeedbackLevel > 0 .and. .not. call_again) then
-               write(*,'("Om_b h^2             = ",f9.6)') CP%omegab*(CP%H0/100)**2
-               write(*,'("Om_c h^2             = ",f9.6)') CP%omegac*(CP%H0/100)**2
-               write(*,'("Om_nu h^2            = ",f9.6)') CP%omegan*(CP%H0/100)**2
-               write(*,'("Om_Lambda            = ",f9.6)') CP%omegav
-               write(*,'("Om_K                 = ",f9.6)') CP%omegak
-               write(*,'("Om_m (1-Om_K-Om_L)   = ",f9.6)') 1-CP%omegak-CP%omegav
-               write(*,'("100 theta (CosmoMC)  = ",f9.6)') 100*CosmomcTheta()
-               if (CP%Num_Nu_Massive > 0) then
-                 do nu_i=1, CP%Nu_mass_eigenstates 
-                  write(*,'(f5.2, " nu, m_nu*c^2/k_B/T_nu0   = ",f8.2," (m_nu = ",f6.3," eV)")') &
-                      CP%nu_mass_degeneracies(nu_i), nu_masses(nu_i),1.68e-4*nu_masses(nu_i)
-                 end do
-               end if
-            end if
-            CP%chi0=rofChi(CP%tau0/CP%r)
-            scale= CP%chi0*CP%r/CP%tau0  !e.g. changel sampling depending on approx peak spacing      
-            
-          end subroutine CAMBParams_Set
- 
-     
-          function GetTestTime()
-            real(sp) GetTestTime
-            real(sp) atime
- 
- !           GetTestTime = etime(tarray)
-          !Can replace this if etime gives problems
-          !Or just comment out - only used if DebugMsgs = .true.
-            call cpu_time(atime)
-            GetTestTime = atime
-             
-          end function GetTestTime
- 
-         
-          function rofChi(Chi) !sinh(chi) for open, sin(chi) for closed.
-          real(dl) Chi,rofChi
- 
-          if (CP%closed) then
-             rofChi=sin(chi)
-          else if (CP%open) then
-             rofChi=sinh(chi)
-          else
-             rofChi=chi
-          endif
-          end function rofChi  
-          
- 
-          function cosfunc (Chi)
-          real(dl) Chi,cosfunc
- 
-          if (CP%closed) then
-             cosfunc= cos(chi)
-          else if (CP%open) then
-             cosfunc=cosh(chi)
-          else
-             cosfunc = 1._dl
-          endif
-          end function cosfunc  
- 
-          function tanfunc(Chi)
-          real(dl) Chi,tanfunc
-          if (CP%closed) then
-             tanfunc=tan(Chi)
-          else if (CP%open) then
-             tanfunc=tanh(Chi)
-          else
-             tanfunc=Chi
-          end if
- 
-          end  function tanfunc
- 
-          function invsinfunc(x)
-          real(dl) invsinfunc,x
- 
-          if (CP%closed) then
-           invsinfunc=asin(x)
-           else if (CP%open) then
-           invsinfunc=log((x+sqrt(1._dl+x**2)))  
-           else
-           invsinfunc = x
-          endif
-          end function invsinfunc    
- 
-         function f_K(x)
-          real(dl) :: f_K
-          real(dl), intent(in) :: x
-          f_K = CP%r*rofChi(x/CP%r)
-           
-         end function f_K
- 
- 
-         function DeltaTime(a1,a2)
-         implicit none
-         real(dl) DeltaTime, atol
-         real(dl), intent(IN) :: a1,a2
-         real(dl) dtauda, rombint !diff of tau w.CP%r.t a and integration
-         external dtauda, rombint
- 
-         atol = tol/1000/exp(AccuracyBoost-1)
-         DeltaTime=rombint(dtauda,a1,a2,atol)
-       
-         end function DeltaTime
- 
-         function TimeOfz(z)
-         implicit none
-         real(dl) TimeOfz
-         real(dl), intent(IN) :: z
-         
-         TimeOfz=DeltaTime(0._dl,1._dl/(z+1._dl))
-         end function TimeOfz
- 
-         function AngularDiameterDistance(z)
-           real(dl) AngularDiameterDistance
-           real(dl), intent(in) :: z
- 
-           AngularDiameterDistance = CP%r/(1+z)*rofchi(DeltaTime(1/(1+z),1._dl)/CP%r)
- 
-         end function AngularDiameterDistance
- 
-        function dsound_da(a)
-           implicit none
-           real(dl) dsound_da,dtauda,a,R,cs
-           external dtauda
- 
-            R=3.0d4*a*CP%omegab*(CP%h0/100.0d0)**2
-            cs=1.0d0/sqrt(3*(1+R))
-            dsound_da=dtauda(a)*cs
-         
-        end function dsound_da
- 
- 
-        function CosmomcTheta()
-          real(dl) zstar, astar, atol, rs, DA
-          real(dl) CosmomcTheta
-          real(dl) ombh2, omdmh2
-          real(dl) rombint
-          external rombint
- 
-          ombh2 = CP%omegab*(CP%h0/100.0d0)**2
-          omdmh2 = (CP%omegac+CP%omegan)*(CP%h0/100.0d0)**2
- 
- 
-     !!From Hu & Sugiyama
-            zstar =  1048*(1+0.00124*ombh2**(-0.738))*(1+ &
-             (0.0783*ombh2**(-0.238)/(1+39.5*ombh2**0.763)) * &
-                (omdmh2+ombh2)**(0.560/(1+21.1*ombh2**1.81)))
-      
-            astar = 1/(1+zstar)
-            atol = 1e-6
-            rs = rombint(dsound_da,1d-8,astar,atol)
-            DA = AngularDiameterDistance(zstar)/astar
-            CosmomcTheta = rs/DA
-     !       print *,'z* = ',zstar, 'r_s = ',rs, 'DA = ',DA, rs/DA
- 
-       end function CosmomcTheta
- 
-    end module ModelParams
- 
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         module lvalues
-         use precision
-         use ModelParams
-         implicit none
-         public
- 
-         Type lSamples
-             integer l0
-            ! integer, dimension(:), pointer :: lSamp%l 
-             integer l(lmax_arr)
-         end Type lSamples
- 
-         Type(lSamples) :: lSamp
- 
-        contains
- 
- 
-         subroutine initlval(lSet,max_l)
- 
- ! This subroutines initializes lSet%l arrays. Other values will be interpolated.
-   
-         implicit none
-         type(lSamples) :: lSet
-          
-         integer, intent(IN) :: max_l
-         integer lind, lvar, step,top,bot,ls(lmax_arr)
-         real(dl) AScale
-     
-         Ascale=scale/lSampleBoost       
-       
-         lind=0
-         do lvar=lmin, 10
-            lind=lind+1
-            ls(lind)=lvar 
-         end do
- 
-         if (CP%AccurateReionization) then
-             if (lSampleBoost > 1) then
-              do lvar=11, 37,1
-                lind=lind+1
-                ls(lind)=lvar 
-              end do       
-             else
-              do lvar=11, 37,2
-                lind=lind+1
-                ls(lind)=lvar 
-              end do       
-             end if 
- 
-             step = max(nint(5*Ascale),2)           
-             bot=40
-             top=bot + step*10
-         else
- 
-             if (lSampleBoost >1) then
-              do lvar=11, 15
-                lind=lind+1
-                ls(lind)=lvar 
-              end do           
-             else
-              lind=lind+1
-              ls(lind)=12
-              lind=lind+1
-              ls(lind)=15
-             end if
-             step = max(nint(10*Ascale),3)           
-             bot=15+max(step/2,2)
-             top=bot + step*7
-         end if
- 
-         do lvar=bot, top, step
-            lind=lind+1
-            ls(lind)=lvar          
-         end do
- 
-         step=max(nint(20*Ascale),4)
-         bot=ls(lind)+step
-         top=bot+step*2
- 
-         do lvar = bot,top,step 
-           lind=lind+1
-           ls(lind)=lvar
-         end do
- 
-         if (ls(lind)>=max_l) then
-            do lvar=lind,1,-1
-             if (ls(lvar)<=max_l) exit  
-            end do
-            lind=lvar
-            if (ls(lind)<max_l) then
-               lind=lind+1
-               ls(lind)=max_l
-            end if
-         else
- 
-         step=max(nint(25*Ascale),4)
- !Get EE right around l=200 by putting extra point at 175
-         bot=ls(lind)+step
-         top=bot+step
- 
-         do lvar = bot,top,step 
-           lind=lind+1
-           ls(lind)=lvar
-         end do
- 
- 
-         if (ls(lind)>=max_l) then
-            do lvar=lind,1,-1
-             if (ls(lvar)<=max_l) exit  
-            end do
-            lind=lvar
-            if (ls(lind)<max_l) then
-               lind=lind+1
-               ls(lind)=max_l
-            end if
-         else
- 
-         step=max(nint(50*Ascale),7)
-         bot=ls(lind)+step
-         top=min(5000,max_l)
- 
-          do lvar = bot,top,step
-           lind=lind+1
-           ls(lind)=lvar
-          end do
- 
-          if (max_l > 5000) then
-              !Should be pretty smooth or tiny out here   
-              step=max(nint(400*Ascale),50)
-              lvar = ls(lind)
-             
-              do
-               lvar = lvar + step
-               if (lvar > max_l) exit
-               lind=lind+1
-               ls(lind)=lvar
-               step = nint(step*1.5) !log spacing
-              end do
- 
-          end if
- 
-          if (ls(lind) /=max_l) then          
-            lind=lind+1
-            ls(lind)=max_l
-          end if
-         if (.not. CP%flat) ls(lind-1)=int(max_l+ls(lind-2))/2
-         !Not in CP%flat case so interpolation table is the same when using lower l_max
-         end if
-         end if
-         lSet%l0=lind
-         lSet%l(1:lind) = ls(1:lind)
-         
-       end subroutine initlval
- 
-       subroutine InterpolateClArr(lSet,iCl, all_Cl, max_ind)
-       type (lSamples), intent(in) :: lSet        
-       real(dl), intent(in) :: iCl(*)
-       real(dl), intent(out):: all_Cl(lmin:*)
-       integer, intent(in) :: max_ind
-       integer il,llo,lhi, xi
-       real(dl) ddCl(lSet%l0)
-       real(dl) xl(lSet%l0)
- 
-       real(dl) a0,b0,ho
-       real(dl), parameter :: cllo=1.e30_dl,clhi=1.e30_dl
- 
-       if (max_ind > lSet%l0) stop 'Wrong max_ind in InterpolateClArr'
- 
-       xl = real(lSet%l(1:lSet%l0),dl)
-       call spline(xl,iCl(1),max_ind,cllo,clhi,ddCl(1))
-      
-             llo=1
-             do il=lmin,lSet%l(max_ind)
-                xi=il
-                if ((xi > lSet%l(llo+1)).and.(llo < max_ind)) then
-                   llo=llo+1
-                end if
-                lhi=llo+1
-                ho=lSet%l(lhi)-lSet%l(llo)
-                a0=(lSet%l(lhi)-xi)/ho
-                b0=(xi-lSet%l(llo))/ho
-       
-                all_Cl(il) = a0*iCl(llo)+ b0*iCl(lhi)+((a0**3-a0)* ddCl(llo) &
-                        +(b0**3-b0)*ddCl(lhi))*ho**2/6
-               
-             end do
- 
-       end subroutine InterpolateClArr
- 
-  
-     
- 
- !ccccccccccccccccccccccccccc
- 
-         end module lvalues
-         
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         module ModelData
-         use precision
-         use ModelParams
-         use InitialPower
-         use lValues
-         use Ranges
-         use AMlUtils
-         implicit none
-         public
- 
-          Type ClTransferData
-       !Cl transfer function variables
-        !values of q for integration over q to get C_ls
-           Type (lSamples) :: ls ! scalar and tensor l that are computed
-           integer :: NumSources 
-           !Changes -scalars:  2 for just CMB, 3 for lensing
-           !- tensors: T and E and phi (for lensing), and T, E, B respectively
-         
-           Type (Regions) :: q
- 
-           real(dl), dimension(:,:,:), pointer :: Delta_p_l_k
-       
-          end Type ClTransferData
- 
-          Type(ClTransferData), target :: CTransScal, CTransTens, CTransVec
- 
-         !Computed output power spectra data
-                          
-         integer, parameter :: C_Temp = 1, C_E = 2, C_Cross =3, C_Phi = 4, C_PhiTemp = 5
-         integer :: C_last = C_PhiTemp
-         integer, parameter :: CT_Temp =1, CT_E = 2, CT_B = 3, CT_Cross=  4
-   
- 
-         real(dl), dimension (:,:,:), allocatable :: Cl_scalar, Cl_tensor, Cl_vector
-         !Indices are Cl_xxx( l , intial_power_index, Cl_type)
-         !where Cl_type is one of the above constants
- 
-         !The following are set only if doing lensing
-         integer lmax_lensed !Only accurate to rather less than this 
-         real(dl) , dimension (:,:,:), allocatable :: Cl_lensed
-           !Cl_lensed(l, power_index, Cl_type) are the interpolated Cls
-     
-         real(dl), dimension (:), allocatable ::  COBElikelihoods,COBE_scales
-         !Set by COBEnormalize if using outCOBE
-         contains
- 
- 
-         subroutine Init_ClTransfer(CTrans)
-         !Need to set the Ranges array q before calling this
-           Type(ClTransferData) :: CTrans
-           integer st
- 
-           deallocate(CTrans%Delta_p_l_k, STAT = st)
-           call Ranges_getArray(CTrans%q, .true.)
- 
-           allocate(CTrans%Delta_p_l_k(CTrans%NumSources,min(max_bessels_l_index,CTrans%ls%l0), CTrans%q%npoints))
-           CTrans%Delta_p_l_k = 0
- 
-   
-          end subroutine Init_ClTransfer
- 
- 
-         subroutine Free_ClTransfer(CTrans)
-           Type(ClTransferData) :: CTrans
-           integer st
- 
-            deallocate(CTrans%Delta_p_l_k, STAT = st)
-            nullify(CTrans%Delta_p_l_k)
-            call Ranges_Free(CTrans%q)
- 
-         end subroutine Free_ClTransfer
- 
- 
- 
-         subroutine Init_Cls
-       
-         if (CP%WantScalars) then
-          if (allocated(Cl_scalar)) deallocate(Cl_scalar)
-          allocate(Cl_scalar(lmin:CP%Max_l, CP%InitPower%nn, C_Temp:C_last))
-          Cl_scalar = 0
-         end if
- 
-         if (CP%WantVectors) then
-          if (allocated(Cl_vector)) deallocate(Cl_vector)
-          allocate(Cl_vector(lmin:CP%Max_l, CP%InitPower%nn, CT_Temp:CT_Cross))
-          Cl_vector = 0
-         end if
- 
- 
-         if (CP%WantTensors) then
-           if (allocated(Cl_tensor)) deallocate(Cl_tensor)
-           allocate(Cl_tensor(lmin:CP%Max_l_tensor, CP%InitPower%nn, CT_Temp:CT_Cross))
-           Cl_tensor = 0
-         end if
- 
-         end subroutine Init_Cls
-        
-         subroutine output_cl_files(ScalFile,TensFile, TotFile, LensFile, LensTotFile, factor)
-         implicit none
-         integer in,il
-         character(LEN=*) ScalFile, TensFile, TotFile, LensFile, LensTotFile
-         real(dl), intent(in), optional :: factor
-         real(dl) fact
- 
- 
-         if (present(factor)) then
-           fact = factor
-         else
-           fact =1
-         end if
- 
-          if (CP%WantScalars .and. ScalFile /= '') then
-  
-            open(unit=fileio_unit,file=ScalFile,form='formatted',status='replace')
-            do in=1,CP%InitPower%nn
-              do il=lmin,min(10000,CP%Max_l)
-                write(fileio_unit,trim(numcat('(1I6,',C_last))//'E15.5)')il ,fact*Cl_scalar(il,in,C_Temp:C_last)
-              end do
-              do il=10100,CP%Max_l, 100
-                write(fileio_unit,trim(numcat('(1E15.5,',C_last))//'E15.5)') real(il) ,fact*Cl_scalar(il,in,C_Temp:C_last)
-              end do
-             end do
-             close(fileio_unit)
-          end if
-   
-        if (CP%WantTensors .and. TensFile /= '') then
-            open(unit=fileio_unit,file=TensFile,form='formatted',status='replace')
-             do in=1,CP%InitPower%nn
-              do il=lmin,CP%Max_l_tensor
-                write(fileio_unit,'(1I6,4E15.5)')il, fact*Cl_tensor(il, in, CT_Temp:CT_Cross)
-              end do
-             end do
-            close(fileio_unit)
-         end if
-  
-         if (CP%WantTensors .and. CP%WantScalars .and. TotFile /= '') then
-            open(unit=fileio_unit,file=TotFile,form='formatted',status='replace')
-            do in=1,CP%InitPower%nn
-              do il=lmin,CP%Max_l_tensor
- 
-                 write(fileio_unit,'(1I6,4E15.5)')il, fact*(Cl_scalar(il, in, C_Temp:C_E)+ Cl_tensor(il,in, C_Temp:C_E)), &
-                    fact*Cl_tensor(il,in, CT_B), fact*(Cl_scalar(il, in, C_Cross) + Cl_tensor(il, in, CT_Cross))
-              end do
-              do il=CP%Max_l_tensor+1,CP%Max_l
-                   write(fileio_unit,'(1I6,4E15.5)')il ,fact*Cl_scalar(il,in,C_Temp:C_E), 0._dl, fact*Cl_scalar(il,in,C_Cross)
-              end do
-            end do
-            close(fileio_unit)
-         end if
-  
-         if (CP%WantScalars .and. CP%DoLensing .and. LensFile /= '') then
-            open(unit=fileio_unit,file=LensFile,form='formatted',status='replace')
-             do in=1,CP%InitPower%nn
-              do il=lmin, lmax_lensed
-                write(fileio_unit,'(1I6,4E15.5)')il, fact*Cl_lensed(il, in, CT_Temp:CT_Cross)
-              end do
-             end do
-            close(fileio_unit)      
-         end if
- 
- 
-        if (CP%WantScalars .and. CP%WantTensors .and. CP%DoLensing .and. LensTotFile /= '') then
-            open(unit=fileio_unit,file=LensTotFile,form='formatted',status='replace')
-            do in=1,CP%InitPower%nn
-              do il=lmin,min(CP%Max_l_tensor,lmax_lensed)
-                 write(fileio_unit,'(1I6,4E15.5)')il, fact*(Cl_lensed(il, in, CT_Temp:CT_Cross)+ Cl_tensor(il,in, CT_Temp:CT_Cross))
-              end do
-              do il=min(CP%Max_l_tensor,lmax_lensed)+1,lmax_lensed
-                 write(fileio_unit,'(1I6,4E15.5)')il, fact*Cl_lensed(il, in, CT_Temp:CT_Cross)
-              end do
-            end do
-      
-         end if
- 
- 
- 
-         end subroutine output_cl_files
- 
-         subroutine output_veccl_files(VecFile, factor)
-         implicit none
-         integer in,il
-         character(LEN=*) VecFile
-         real(dl), intent(in), optional :: factor
-         real(dl) fact
- 
- 
-         if (present(factor)) then
-           fact = factor
-         else
-           fact =1
-         end if
- 
-   
-        if (CP%WantVectors .and. VecFile /= '') then
-            open(unit=fileio_unit,file=VecFile,form='formatted',status='replace')
-             do in=1,CP%InitPower%nn
-              do il=lmin,CP%Max_l
-                write(fileio_unit,'(1I5,4E15.5)')il, fact*Cl_vector(il, in, CT_Temp:CT_Cross)
-              end do
-             end do
- 
-            close(fileio_unit)
-         end if
-  
-         end subroutine output_veccl_files
- 
- 
-         subroutine output_COBElikelihood
-           integer in
-           do in=1, CP%InitPower%nn
-              write(*,*)'COBE Likelihood relative to CP%flat=',COBElikelihoods(in)
-           end do
-         end  subroutine output_COBElikelihood
- 
-         
-       subroutine NormalizeClsAtL(lnorm)
-         implicit none
-         integer, intent(IN) :: lnorm
-         integer in
-         real(dl) Norm
- 
-          do in=1,CP%InitPower%nn
-              
-              if (CP%WantScalars) then
-                 Norm=1/Cl_scalar(lnorm,in, C_Temp)
-                 Cl_scalar(lmin:CP%Max_l, in, C_Temp:C_Cross) = Cl_scalar(lmin:CP%Max_l, in, C_Temp:C_Cross) * Norm
-              end if
- 
-              if (CP%WantTensors) then
-                   if (.not.CP%WantScalars) Norm = 1/Cl_tensor(lnorm,in, C_Temp)
-                   !Otherwise Norm already set correctly
-                   Cl_tensor(lmin:CP%Max_l_tensor, in, CT_Temp:CT_Cross) =  &
-                     Cl_tensor(lmin:CP%Max_l_tensor, in, CT_Temp:CT_Cross) * Norm
-              end if
-        end do
- 
-       end  subroutine NormalizeClsAtL
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         subroutine COBEnormalize
-         use precision
-         use ModelParams
-         
- 
-         integer in
-         real(dl) xlog10
-         real(dl) c10, d1,d2,d3,d4,d5,d6,d7, xlogl, COBE_scale
-         real(dl) x1, x2,x3,x4,x5,x6,x7,sy,s,sx,sxy,sxx,delt,d1pr,d1ppr
-         real(dl) Ctot(lmin:20)
- 
-     
-            if (allocated(COBElikelihoods)) deallocate(COBElikelihoods)
-            if (allocated(COBE_scales)) deallocate(COBE_scales)
-            allocate(COBElikelihoods(CP%InitPower%nn))
-            allocate(COBE_scales(CP%InitPower%nn))
-     
- 
-           
-         xlog10=log(10._dl)
-   
- 
- ! COBE normalization
- ! fit the spectrum to a quadratic around C_10 with equal weights in logl
- 
-         do in=1,CP%InitPower%nn
- 
-            if (CP%WantTensors) then
-               Ctot =  Cl_tensor(lmin:20, in, C_Temp)
-            else
-               Ctot = 0
-            end if
-            if (CP%WantScalars) then
-               Ctot=Ctot + Cl_scalar(lmin:20, in, C_Temp)
-      
-            end if
-            c10=Ctot(10)
-       
-            d1=(Ctot(3))/c10-1._dl
-            d2=(Ctot(4))/c10-1._dl
-            d3=(Ctot(6))/c10-1._dl
-            d4=(Ctot(8))/c10-1._dl
-            d5=(Ctot(12))/c10-1._dl
-            d6=(Ctot(15))/c10-1._dl
-            d7=(Ctot(20))/c10-1._dl
- 
-      
-            x1=log(3._dl)/xlog10-1._dl
-            x2=log(4._dl)/xlog10-1._dl
-            x3=log(6._dl)/xlog10-1._dl
-            x4=log(8._dl)/xlog10-1._dl
-            x5=log(12._dl)/xlog10-1._dl
-            x6=log(15._dl)/xlog10-1._dl
-            x7=log(20._dl)/xlog10-1._dl
-            sy=x1*d1+x2*d2+x3*d3+x4*d4+x5*d5+x6*d6+x7*d7
-            s=x1*x1+x2*x2+x3*x3+x4*x4+x5*x5+x6*x6+x7*x7
-            sx=x1**3+x2**3+x3**3+x4**3+x5**3+x6**3+x7**3
-            sxy=x1**2*d1+x2**2*d2+x3**2*d3+x4**2*d4+ &
-               x5**2*d5+x6**2*d6+x7**2*d7
-            sxx=x1**4+x2**4+x3**4+x4**4+x5**4+x6**4+x7**4
-            delt=s*sxx-sx*sx
-            d1pr=(sxx*sy-sx*sxy)/delt
-            d1ppr=2._dl*(s*sxy-sx*sy)/delt
- 
- ! Bunn and White fitting formula
-            c10=(0.64575d0+0.02282d0*d1pr+0.01391d0*d1pr*d1pr &
-            -0.01819d0*d1ppr-0.00646d0*d1pr*d1ppr &
-            +0.00103d0*d1ppr*d1ppr)/c10
- ! logl
-            xlogl=-0.01669d0+1.19895d0*d1pr-0.83527d0*d1pr*d1pr &
-                  -0.43541d0*d1ppr-0.03421d0*d1pr*d1ppr &
-                  +0.01049d0*d1ppr*d1ppr
-           ! write(*,*)'COBE Likelihood relative to CP%flat=',exp(xlogl)
-            COBElikelihoods(in) = exp(xlogl)
- 
- ! density power spectrum normalization;
- 
-            COBE_scale=c10/OutputDenominator*1.1d-9
-            COBE_scales(in)=COBE_scale
- 
- !!$!delta^2 = k^4*(tf)^2*ScalarPower(k,in)*COBE_scale where (tf) is output in the transfer function file
- !!$!delta^2 = 4*pi*k^3 P(k)
- 
- 
- ! C_l normalization; output l(l+1)C_l/twopi
-            c10=c10*2.2d-9/fourpi
- 
-            if (CP%WantScalars) Cl_scalar(lmin:CP%Max_l, in, C_Temp:C_last) = &
-                         Cl_scalar(lmin:CP%Max_l, in, C_Temp:C_last)*c10
-            if (CP%WantTensors) Cl_tensor(lmin:CP%Max_l_tensor, in, CT_Temp:CT_Cross) = &
-                                     Cl_tensor(lmin:CP%Max_l_tensor, in, CT_Temp:CT_Cross)*c10
-            
-           end do !in
-          end subroutine COBEnormalize
-         
-          subroutine ModelData_Free
- 
-              call Free_ClTransfer(CTransScal)
-              call Free_ClTransfer(CTransVec)
-              call Free_ClTransfer(CTransTens)
-              if (allocated(Cl_vector)) deallocate(Cl_vector)
-              if (allocated(Cl_tensor)) deallocate(Cl_tensor)
-              if (allocated(Cl_scalar)) deallocate(Cl_scalar)
-              if (allocated(Cl_lensed)) deallocate(Cl_lensed)
-              if (allocated(COBElikelihoods)) deallocate(COBElikelihoods)
-              if (allocated(COBE_scales)) deallocate(COBE_scales) 
-  
-          end subroutine ModelData_Free
- 
-         end module ModelData
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-     module MassiveNu
-       use precision
-       use ModelParams
-       implicit none
-         private 
-         
-           real(dl), parameter  :: const  = 7._dl/120*pi**4 ! 5.68219698_dl
-              !const = int q^3 F(q) dq = 7/120*pi^4
-           real(dl), parameter  :: const2 = 5._dl/7/pi**2   !0.072372274_dl
-           real(dl), parameter  :: zeta3  = 1.2020569031595942853997_dl
-           real(dl), parameter  :: zeta5  = 1.0369277551433699263313_dl
-           real(dl), parameter  :: zeta7  = 1.0083492773819228268397_dl
- 
-           integer, parameter  :: nrhopn=2000  
-           real(dl), parameter :: am_min = 0.01_dl  !0.02_dl
-             !smallest a*m_nu to integrate distribution function rather than using series
-           real(dl), parameter :: am_max = 600._dl 
-             !max a*m_nu to integrate
-           
-           real(dl),parameter  :: am_minp=am_min*1.1
-           real(dl), parameter :: am_maxp=am_max*0.9
-    
-           real(dl) dlnam
- 
-           real(dl), dimension(:), allocatable ::  r1,p1,dr1,dp1,ddr1,qdn
-           
-           real(dl), parameter :: dq=1._dl  
-           !Sample for massive neutrino momentum; increase nqmax0 appropriately
-           !These settings appear to be OK for P_k accuate at 1e-3 level
-           integer, parameter :: nqmax0=15 !number of q to sample for each l
- 
-           real(dl) dlfdlq(nqmax0) !pre-computed array
-           integer nqmax
-  
-        public Nu_Init,Nu_background,Nu_Integrate,Nu_Integrate01,Nu_Intvsq, &
-               Nu_Shear,Nu_derivs, Nu_rho, nqmax, dlfdlq, dq, nqmax0
-        contains
-   !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         subroutine Nu_init
-       
- !  Initialize interpolation tables for massive neutrinos.
- !  Use cubic splines interpolation of log rhonu and pnu vs. log a*m.
-  
-          integer i
-          real(dl) q, am, rhonu,pnu
-          real(dl) spline_data(nrhopn)
- 
-      
- !  nu_masses=m_nu(i)*c**2/(k_B*T_nu0).
- !  Get number density n of neutrinos from
- !  rho_massless/n = int q^3/(1+e^q) / int q^2/(1+e^q)=7/180 pi^4/Zeta(3)
- !  then m = Omega_nu/N_nu rho_crit /n
- !  Error due to velocity < 1e-5
-         
-         do i=1, CP%Nu_mass_eigenstates 
-          nu_masses(i)=const/(1.5d0*zeta3)*grhom/grhor*CP%omegan*CP%Nu_mass_fractions(i) &
-                /CP%Nu_mass_degeneracies(i)
-         end do
- 
-         if (allocated(r1)) return
-          
- 
-         allocate(r1(nrhopn),p1(nrhopn),dr1(nrhopn),dp1(nrhopn),ddr1(nrhopn),qdn(nqmax0))
- 
-          do i=1,nqmax0
-             q=(i-0.5d0)*dq
-             dlfdlq(i)=-q/(1._dl+exp(-q))
-             qdn(i)=dq*q**3/(exp(q)+1._dl)
-          end do
- 
-         dlnam=-(log(am_min/am_max))/(nrhopn-1)
-  
- 
-         !$OMP PARALLEL DO DEFAULT(SHARED),SCHEDULE(STATIC) &
-         !$OMP & PRIVATE(am, rhonu,pnu) 
-         do i=1,nrhopn
-           am=am_min*exp((i-1)*dlnam)
-           call nuRhoPres(am,rhonu,pnu)
-           r1(i)=log(rhonu)
-           p1(i)=log(pnu)
-         end do
-         !$OMP END PARALLEL DO
- 
- 
-         call splini(spline_data,nrhopn)
-         call splder(r1,dr1,nrhopn,spline_data)
-         call splder(p1,dp1,nrhopn,spline_data)
-         call splder(dr1,ddr1,nrhopn,spline_data)       
- 
-        
-         end subroutine Nu_init
- 
- 
-       
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine nuRhoPres(am,rhonu,pnu)
- !  Compute the density and pressure of one eigenstate of massive neutrinos,
- !  in units of the mean density of one flavor of massless neutrinos.
- 
-         real(dl),  parameter :: qmax=30._dl
-         integer, parameter :: nq=1000
-         real(dl) dum1(nq+1),dum2(nq+1)
-         real(dl), intent(in) :: am
-         real(dl), intent(out) ::  rhonu,pnu
-         integer i
-         real(dl) q,aq,v,aqdn,adq
-        
- 
- !  q is the comoving momentum in units of k_B*T_nu0/c.
- !  Integrate up to qmax and then use asymptotic expansion for remainder.
-         adq=qmax/nq
-         dum1(1)=0._dl
-         dum2(1)=0._dl
-         do  i=1,nq
-           q=i*adq
-           aq=am/q
-           v=1._dl/sqrt(1._dl+aq*aq)
-           aqdn=adq*q*q*q/(exp(q)+1._dl)
-           dum1(i+1)=aqdn/v
-           dum2(i+1)=aqdn*v
-         end do
-         call splint(dum1,rhonu,nq+1)
-         call splint(dum2,pnu,nq+1)
- !  Apply asymptotic corrrection for q>qmax and normalize by relativistic
- !  energy density.
-         rhonu=(rhonu+dum1(nq+1)/adq)/const
-         pnu=(pnu+dum2(nq+1)/adq)/const/3._dl
-        
-         end subroutine nuRhoPres
- 
- !cccccccccccccccccccccccccccccccccccccccccc
-        subroutine Nu_background(am,rhonu,pnu)
-         use precision
-         use ModelParams
-         real(dl), intent(in) :: am
-         real(dl), intent(out) :: rhonu, pnu
- 
- !  Compute massive neutrino density and pressure in units of the mean
- !  density of one eigenstate of massless neutrinos.  Use cubic splines to
- !  interpolate from a table.
- 
-         real(dl) d
-         integer i
-       
-         if (am <= am_minp) then
-           rhonu=1._dl + const2*am**2  
-           pnu=(2-rhonu)/3._dl
-           return
-         else if (am >= am_maxp) then
-           rhonu = 3/(2*const)*(zeta3*am + (15*zeta5)/2/am)
-           pnu = 900._dl/120._dl/const*(zeta5-63._dl/4*Zeta7/am**2)/am
-           return
-         end if
- 
-         
-         d=log(am/am_min)/dlnam+1._dl
-         i=int(d)
-         d=d-i
-        
- !  Cubic spline interpolation.
-           rhonu=r1(i)+d*(dr1(i)+d*(3._dl*(r1(i+1)-r1(i))-2._dl*dr1(i) &
-                -dr1(i+1)+d*(dr1(i)+dr1(i+1)+2._dl*(r1(i)-r1(i+1)))))
-           pnu=p1(i)+d*(dp1(i)+d*(3._dl*(p1(i+1)-p1(i))-2._dl*dp1(i) &
-                -dp1(i+1)+d*(dp1(i)+dp1(i+1)+2._dl*(p1(i)-p1(i+1)))))
-           rhonu=exp(rhonu)
-           pnu=exp(pnu)
- 
-         end subroutine Nu_background
- 
- !cccccccccccccccccccccccccccccccccccccccccc
-        subroutine Nu_rho(am,rhonu)
-         use precision
-         use ModelParams
-         real(dl), intent(in) :: am
-         real(dl), intent(out) :: rhonu
- 
- !  Compute massive neutrino density in units of the mean
- !  density of one eigenstate of massless neutrinos.  Use cubic splines to
- !  interpolate from a table.
- 
-         real(dl) d
-         integer i
-       
-         if (am <= am_minp) then
-           rhonu=1._dl + const2*am**2  
-           return
-         else if (am >= am_maxp) then
-           rhonu = 3/(2*const)*(zeta3*am + (15*zeta5)/2/am)
-           return
-         end if
-         
-         d=log(am/am_min)/dlnam+1._dl
-         i=int(d)
-         d=d-i
-        
- !  Cubic spline interpolation.
-         rhonu=r1(i)+d*(dr1(i)+d*(3._dl*(r1(i+1)-r1(i))-2._dl*dr1(i) &
-                -dr1(i+1)+d*(dr1(i)+dr1(i+1)+2._dl*(r1(i)-r1(i+1)))))
-         rhonu=exp(rhonu)
-        end subroutine Nu_rho
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine Nu_Integrate01(am,drhonu,fnu,psi0,psi1)
-         use precision
-         use ModelParams
-     
- !  Compute the perturbations of density and energy flux
- !  of one eigenstate of massive neutrinos, in units of the mean
- !  density of one eigenstate of massless neutrinos, by integrating over
- !  momentum.
-         real(dl), intent(IN)  :: am,psi0(nqmax0),psi1(nqmax0) 
-         real(dl), intent(OUT) ::  drhonu,fnu
-         real(dl), parameter   :: qmax=nqmax0-0.5d0
-     
- 
-         real(dl) g0(4),g1(nqmax0+1),g3(nqmax0+1)
-         real(dl) aq,v,q
-         integer iq
-    
- !  q is the comoving momentum in units of k_B*T_nu0/c.
-         g1(1)=0
-         g3(1)=0
-         do iq=2,(nqmax0+1)
-             q=(iq-1.5d0)*dq
-             aq=am/q
-             v=1._dl/sqrt(1._dl+aq*aq)          
-             g1(iq)=qdn(iq-1)*psi0(iq-1)/v           
-             g3(iq)=qdn(iq-1)*psi1(iq-1)           
-         end do
-         call splint(g1,g0(1),nqmax0+1)
-         call splint(g3,g0(3),nqmax0+1)
-   
-         drhonu=(g0(1)+g1(nqmax0+1)*2._dl/qmax)/const
-         fnu=(g0(3)+g3(nqmax0+1)*2._dl/qmax)/const
-      
-         end subroutine Nu_Integrate01
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine Nu_Integrate(am,drhonu,fnu,dpnu,shearnu,psi0,psi1,psi2)
-         use precision
-         use ModelParams
-     
- !  Compute the perturbations of density, energy flux, pressure, and
- !  shear stress of one eigenstate of massive neutrinos, in units of the mean
- !  density of one eigenstate of massless neutrinos, by integrating over
- !  momentum.
-         real(dl), intent(IN)  :: am,psi0(nqmax0),psi1(nqmax0),psi2(nqmax0) 
-         real(dl), intent(OUT) ::  drhonu,fnu,dpnu,shearnu
-         real(dl), parameter   :: qmax=nqmax0-0.5d0
-     
- 
-         real(dl) g0(4),g1(nqmax0+1),g2(nqmax0+1)
-         real(dl) g3(nqmax0+1),g4(nqmax0+1)
-         real(dl) aq,v,q
-         integer iq
-    
- 
- !  q is the comoving momentum in units of k_B*T_nu0/c.
-         g1(1)=0._dl
-         g2(1)=0._dl
-         g3(1)=0._dl
-         g4(1)=0._dl
-         do iq=2,(nqmax0+1)
-             q=(iq-1.5d0)*dq
-             aq=am/q
-             v=1._dl/sqrt(1._dl+aq*aq)          
-             g1(iq)=qdn(iq-1)*psi0(iq-1)/v
-             g2(iq)=qdn(iq-1)*psi0(iq-1)*v
-             g3(iq)=qdn(iq-1)*psi1(iq-1)
-             g4(iq)=qdn(iq-1)*psi2(iq-1)*v         
-         end do
-         call splint(g1,g0(1),nqmax0+1)
-         call splint(g2,g0(2),nqmax0+1)
-         call splint(g3,g0(3),nqmax0+1)
-         call splint(g4,g0(4),nqmax0+1)
-   
-         drhonu=(g0(1)+g1(nqmax0+1)*2._dl/qmax)/const
-         fnu=(g0(3)+g3(nqmax0+1)*2._dl/qmax)/const
-         dpnu=(g0(2)+g2(nqmax0+1)*2._dl/qmax)/const/3._dl
-         shearnu=(g0(4)+g4(nqmax0+1)*2._dl/qmax)/const*2._dl/3._dl
- 
-         end subroutine Nu_Integrate
- 
- !cccccccccccccccccccccccccccccccccccccccccccccc
-    subroutine Nu_Intvsq(am,G11,G30,psi1,psi3)
-         use precision
-         use ModelParams
- 
- !  Compute the third order variables (in velocity dispersion) 
- !by integrating over momentum.
- 
-         real(dl), intent(IN) :: am
-         real(dl), parameter :: qmax=nqmax0-0.5d0
-         real(dl)  psi1(nqmax0),psi3(nqmax0)
- 
-         real(dl) g0(4),g1(nqmax0+1),g2(nqmax0+1)
-             
-         real(dl) G11,G30
-         real(dl) aq,q,v
-         integer iq
- 
- !  q is the comoving momentum in units of k_B*T_nu0/c.
-         g1(1)=0._dl
-         g2(1)=0._dl
-    
-         do iq=2,(nqmax0+1)
-             q=(iq-1.5d0)*dq
-             aq=am/q
-             v=1._dl/sqrt(1._dl+aq*aq)          
-             g1(iq)=qdn(iq-1)*psi1(iq-1)*v**2
-             g2(iq)=qdn(iq-1)*psi3(iq-1)*v**2
-          
-         end do
-         call splint(g1,g0(1),nqmax0+1)
-         call splint(g2,g0(2),nqmax0+1)
-              
-         G11=(g0(1)+g1(nqmax0+1)*2._dl/qmax)/const
-         G30=(g0(2)+g2(nqmax0+1)*2._dl/qmax)/const
-        
-         end subroutine Nu_Intvsq
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine Nu_Shear(am,shearnu,psi2)
-         use precision
-         use ModelParams
- 
- !  Compute the perturbations of 
- !  shear stress of one eigenstate of massive neutrinos, in units of the mean
- !  density of one eigenstate of massless neutrinos, by integrating over
- !  momentum.
-         real(dl), intent(IN) :: am 
-      
-         real(dl), parameter :: qmax=nqmax0-0.5d0
-         real(dl) psi2(nqmax0)
- 
-         real(dl) g0(4),g4(nqmax0+1)
-         real(dl) shearnu,q,aq,v
-         integer iq
- 
-         if (nqmax==0) then
-           shearnu=0._dl
-           return
-         end if
- !
- !  q is the comoving momentum in units of k_B*T_nu0/c.
-         g4(1)=0._dl      
-         do  iq=2,(nqmax0+1)
-             q=(iq-1.5d0)*dq
-             aq=am/q
-             v=1._dl/sqrt(1._dl+aq*aq)                     
-             g4(iq)=qdn(iq-1)*psi2(iq-1)*v         
-         end do
-         call splint(g4,g0(4),nqmax0+1)       
-         shearnu=(g0(4)+g4(nqmax0+1)*2._dl/qmax)/const*2._dl/3._dl
- 
-         end subroutine Nu_Shear
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         subroutine Nu_derivs(am,adotoa,rhonu,rhonudot,shearnudot,psi2,psi2dot)
-         use precision
-         use ModelParams
- 
- !  Compute the time derivative of the mean density in massive neutrinos
- !  and the shear perturbation.
- !
-       
-         real(dl), parameter :: qmax=nqmax0-0.5d0
-         real(dl) psi2(nqmax0),psi2dot(nqmax0)
- 
-         real(dl) g1(nqmax0+1)
-         real(dl) adotoa,rhonu,rhonudot,shearnudot
-         real(dl) aq,q,v,d,aqdot,vdot,g0
-         real(dl), intent(IN) :: am
-         integer iq,i
-      
- 
- !  q is the comoving momentum in units of k_B*T_nu0/c.
-         g1(1)=0._dl
-         do iq=2,(nqmax0+1)
-             q=(iq-1.5d0)*dq
-             aq=am/q
-             aqdot=aq*adotoa
-             v=1._dl/sqrt(1._dl+aq*aq)
-             vdot=-aq*aqdot/(1._dl+aq*aq)**1.5d0
-             g1(iq)=qdn(iq-1)*(psi2dot(iq-1)*v+psi2(iq-1)*vdot)
-         end do
-         call splint(g1,g0,nqmax0+1)
-      
-         shearnudot=(g0+g1(nqmax0+1)*2._dl/qmax)/const*2._dl/3._dl
- 
-         if (am< am_minp) then
- 
-            rhonudot = 2*const2*am**2*adotoa
- 
-         else if (am>am_maxp) then
- 
-            rhonudot = 3/(2*const)*(zeta3*am - (15*zeta5)/2/am)*adotoa
- 
-         else
-            
-            d=log(am/am_min)/dlnam+1._dl
-            i=int(d)
-            d=d-i
-            !  Cubic spline interpolation for rhonudot.
-            rhonudot=dr1(i)+d*(ddr1(i)+d*(3._dl*(dr1(i+1)-dr1(i)) &
-                 -2._dl*ddr1(i)-ddr1(i+1)+d*(ddr1(i)+ddr1(i+1) &
-                 +2._dl*(dr1(i)-dr1(i+1)))))
-      
-            rhonudot=rhonu*adotoa*rhonudot/dlnam
-         end if
-       
-         end subroutine Nu_derivs
- 
-       end module MassiveNu
- 
- ! wrapper function to avoid cirular module references
-       subroutine init_massive_nu(has_massive_nu)
-         use MassiveNu
-         use ModelParams
-         implicit none
-         logical, intent(IN) :: has_massive_nu
- 
-         if (has_massive_nu) then
-              nqmax=nqmax0 
-              call Nu_Init  
-         else
-              nu_masses = 0
-              nqmax= 0
-         end if
-       end subroutine init_massive_nu
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         module Transfer
-         use ModelData
-         implicit none
-         public
-         integer, parameter :: Transfer_kh =1, Transfer_cdm=2,Transfer_b=3,Transfer_g=4, &
-                               Transfer_r=5, Transfer_nu = 6,  & !massless and massive neutrino
-                               Transfer_tot=7
-        
-         integer, parameter :: Transfer_max = Transfer_tot
- 
-         logical :: transfer_interp_matterpower  = .true. !output regular grid in log k
-          !set to false to output calculated values for later interpolation
- 
-         integer :: transfer_power_var = Transfer_tot 
-          !What to use to calulcate the output matter power spectrum and sigma_8
-          !Transfer_tot uses total matter perturbation
- 
-         Type MatterTransferData
-          !Computed data
-          integer   ::  num_q_trans   !    number of steps in k for transfer calculation
-          real(dl), dimension (:), pointer :: q_trans
-          real(dl), dimension (:,:), pointer ::  sigma_8
-          real, dimension(:,:,:), pointer :: TransferData
-          !TransferData(entry,k_index,z_index) for entry=Tranfer_kh.. Transfer_tot
-         end Type MatterTransferData
- 
-         Type MatterPowerData
-          !everything is a function of k/h
-           integer   ::  num_k, num_z          
-           real(dl), dimension(:), pointer :: log_kh, redshifts
-           !matpower is log(P_k)
-           real(dl), dimension(:,:), pointer :: matpower, ddmat
-           !if NonLinear, nonlin_ratio =  sqrt(P_nonlinear/P_linear)
-           !function of k and redshift NonLinearScaling(k_index,z_index)         
-           real(dl), dimension(:,:), pointer :: nonlin_ratio
-         end Type MatterPowerData
- 
-         Type (MatterTransferData) :: MT        
- 
-       contains
- 
-         subroutine Transfer_GetMatterPowerData(MTrans, PK_data, in, itf_only)
-          !Does *NOT* include non-linear corrections
-           !Get total matter power spectrum in units of (h Mpc^{-1})^3 ready for interpolation.
-           !Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
-           !We are assuming that Cls are generated so any baryonic wiggles are well sampled and that matter power
-           !sepctrum is generated to beyond the CMB k_max
-           Type(MatterTransferData), intent(in) :: MTrans
-           Type(MatterPowerData) :: PK_data
-           integer, intent(in) :: in
-           integer, intent(in), optional :: itf_only
-           real(dl) h, kh, k
-           integer ik
-           integer nz,itf, itf_start, itf_end
-           
-           if (present(itf_only)) then
-               itf_start=itf_only
-               itf_end = itf_only
-               nz = 1
-           else
-               itf_start=1
-               nz= size(MTrans%TransferData,3)
-               itf_end = nz
-           end if
-           PK_data%num_k = MTrans%num_q_trans
-           PK_Data%num_z = nz
- 
-           allocate(PK_data%matpower(PK_data%num_k,nz))
-           allocate(PK_data%ddmat(PK_data%num_k,nz))
-           allocate(PK_data%nonlin_ratio(PK_data%num_k,nz))
-           allocate(PK_data%log_kh(PK_data%num_k))
-           allocate(PK_data%redshifts(nz))
-           PK_data%redshifts = CP%Transfer%Redshifts(itf_start:itf_end)
-        
-           h = CP%H0/100
- 
-           do ik=1,MTrans%num_q_trans
-                  kh = MTrans%TransferData(Transfer_kh,ik,1)
-                  k = kh*h
-                  PK_data%log_kh(ik) = log(kh)
-                  do itf = 1, nz
-                    PK_data%matpower(ik,itf) = &
-                     log(MTrans%TransferData(transfer_power_var,ik,itf_start+itf-1)**2*k & 
-                                    *pi*twopi*h**3*ScalarPower(k,in))
-                  end do
-           end do
-      
-           call MatterPowerdata_getsplines(PK_data)
- 
-         end subroutine Transfer_GetMatterPowerData
- 
-         subroutine MatterPowerData_Load(PK_data,fname)
-           !Loads in kh, P_k from file for one redshiftr and one initial power spectrum
-           !Not redshift is not stored in file, so not set correctly
-           !Also note that output _matterpower file is already interpolated, so re-interpolating is probs not a good idea
- 
-           !Get total matter power spectrum in units of (h Mpc^{-1})^3 ready for interpolation.
-           !Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
-           use AmlUtils
-           character(LEN=*) :: fname
-           Type(MatterPowerData) :: PK_data
-           real(dl)kh, Pk
-           integer ik
-           integer nz
-           
- 
-           nz = 1
-           call openTxtFile(fname, fileio_unit)
-          
-           PK_data%num_k = FileLines(fileio_unit)
-           PK_Data%num_z = 1
- 
-           allocate(PK_data%matpower(PK_data%num_k,nz))
-           allocate(PK_data%ddmat(PK_data%num_k,nz))
-           allocate(PK_data%nonlin_ratio(PK_data%num_k,nz))
-           allocate(PK_data%log_kh(PK_data%num_k))
-        
-           allocate(PK_data%redshifts(nz))
-           PK_data%redshifts = 0
- 
-           do ik=1,PK_data%num_k
-               read (fileio_unit,*) kh, Pk
-               PK_data%matpower(ik,1) = log(Pk) 
-               PK_data%log_kh(ik) = log(kh)
-           end do
-      
-           call MatterPowerdata_getsplines(PK_data)
- 
-         end subroutine MatterPowerData_Load
- 
- 
-         subroutine MatterPowerdata_getsplines(PK_data)
-           Type(MatterPowerData) :: PK_data
-           integer i
-           real(dl), parameter :: cllo=1.e30_dl,clhi=1.e30_dl
- 
-           do i = 1,PK_Data%num_z
-           
-            call spline(PK_data%log_kh,PK_data%matpower(1,i),PK_data%num_k,&
-                                cllo,clhi,PK_data%ddmat(1,i))
-           end do
- 
-         end subroutine MatterPowerdata_getsplines
-         
-         subroutine MatterPowerdata_MakeNonlinear(PK_data)
-           Type(MatterPowerData) :: PK_data
- 
-           call NonLinear_GetRatios(PK_data)
-           PK_data%matpower = PK_data%matpower +  2*log(PK_data%nonlin_ratio)
-           call MatterPowerdata_getsplines(PK_data)
- 
-         end subroutine MatterPowerdata_MakeNonlinear
- 
-         subroutine MatterPowerdata_Free(PK_data)
-           Type(MatterPowerData) :: PK_data
-           integer i
- 
-           deallocate(PK_data%log_kh,stat=i)
-           deallocate(PK_data%matpower,stat=i)
-           deallocate(PK_data%ddmat,stat=i)
-           deallocate(PK_data%nonlin_ratio,stat=i)
-           deallocate(PK_data%redshifts)
- 
-         end subroutine MatterPowerdata_Free
- 
-         function MatterPowerData_k(PK,  kh, itf) result(outpower)
-          !Get matter power spectrum at particular k/h by interpolation
-           Type(MatterPowerData) :: PK
-           integer, intent(in) :: itf
-           real (dl), intent(in) :: kh
-           real(dl) :: logk
-           integer llo,lhi
-           real(dl) outpower, dp
-           real(dl) ho,a0,b0
-           integer, save :: i_last = 1          
-           
-            logk = log(kh)
-            if (logk < PK%log_kh(1)) then
-               dp = (PK%matpower(2,itf) -  PK%matpower(1,itf)) / &
-                  ( PK%log_kh(2)-PK%log_kh(1) )
-               outpower = PK%matpower(1,itf) + dp*(logk - PK%log_kh(1))
-            else if (logk > PK%log_kh(PK%num_k)) then
-             !Do dodgy linear extrapolation on assumption accuracy of result won't matter
-            
-              dp = (PK%matpower(PK%num_k,itf) -  PK%matpower(PK%num_k-1,itf)) / &
-                  ( PK%log_kh(PK%num_k)-PK%log_kh(PK%num_k-1) )
-              outpower = PK%matpower(PK%num_k,itf) + dp*(logk - PK%log_kh(PK%num_k))
-            else 
- 
-             llo=min(i_last,PK%num_k)
-             do while (PK%log_kh(llo) > logk)
-                llo=llo-1
-             end do
-             do while (PK%log_kh(llo+1)< logk)
-                llo=llo+1
-             end do
-             i_last =llo  
-             lhi=llo+1
-             ho=PK%log_kh(lhi)-PK%log_kh(llo) 
-             a0=(PK%log_kh(lhi)-logk)/ho
-             b0=1-a0
-               
-             outpower = a0*PK%matpower(llo,itf)+ b0*PK%matpower(lhi,itf)+&
-                   ((a0**3-a0)* PK%ddmat(llo,itf) &
-                        +(b0**3-b0)*PK%ddmat(lhi,itf))*ho**2/6
-               
-           end if
- 
-           outpower = exp(max(-30._dl,outpower))
- 
-         end function MatterPowerData_k
- 
- 
-         subroutine Transfer_GetMatterPower(MTrans,outpower, itf, in, minkh, dlnkh, npoints)
-           !Allows for non-smooth priordial spectra
-           !if CP%Nonlinear/ = NonLinear_none includes non-linear evolution
-           !Get total matter power spectrum at logarithmically equal intervals dlnkh of k/h starting at minkh
-           !in units of (h Mpc^{-1})^3.   
-           !Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
-           !We are assuming that Cls are generated so any baryonic wiggles are well sampled and that matter power
-           !sepctrum is generated to beyond the CMB k_max
-           Type(MatterTransferData), intent(in) :: MTrans
-           Type(MatterPowerData) :: PK
-         
-           integer, intent(in) :: itf, in, npoints
-           real, intent(out) :: outpower(npoints)
-           real, intent(in) :: minkh, dlnkh
-           real(dl), parameter :: cllo=1.e30_dl,clhi=1.e30_dl
-           integer ik, llo,il,lhi,lastix
-           real(dl) matpower(MTrans%num_q_trans), kh, kvals(MTrans%num_q_trans), ddmat(MTrans%num_q_trans)
-           real(dl) atransfer,xi, a0, b0, ho, logmink,k, h
-           
- 
-           if (npoints < 2) stop 'Need at least 2 points in Transfer_GetMatterPower'
- 
- !         if (minkh < MTrans%TransferData(Transfer_kh,1,itf)) then
- !            stop 'Transfer_GetMatterPower: kh out of computed region'
- !          end if
-           if (minkh*exp((npoints-1)*dlnkh) > MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf) &
-                 .and. FeedbackLevel > 0 ) &
-                     write(*,*) 'Warning: extrapolating matter power in Transfer_GetMatterPower'
- 
-           
-           if (CP%NonLinear/=NonLinear_None) then
-            call Transfer_GetMatterPowerData(MTrans, PK, in, itf)
-            call NonLinear_GetRatios(PK)
-           end if
-            
-           h = CP%H0/100
-           logmink = log(minkh)
-           do ik=1,MTrans%num_q_trans
-              kh = MTrans%TransferData(Transfer_kh,ik,itf)
-              k = kh*h
-              kvals(ik) = log(kh)
-              atransfer=MTrans%TransferData(transfer_power_var,ik,itf)
-              if (CP%NonLinear/=NonLinear_None) &
-                  atransfer = atransfer* PK%nonlin_ratio(ik,1) !only one element, this itf
-              matpower(ik) = log(atransfer**2*k*pi*twopi*h**3)
-                  !Put in power spectrum later: transfer functions should be smooth, initial power may not be                
-           end do
-              
-           call spline(kvals,matpower,MTrans%num_q_trans,cllo,clhi,ddmat)
- 
-             llo=1
-             lastix = npoints + 1
-             do il=1, npoints
-                xi=logmink + dlnkh*(il-1)
-                if (xi < kvals(1)) then
-                  outpower(il)=-30.
-                  cycle
-                end if
-                do while ((xi > kvals(llo+1)).and.(llo < MTrans%num_q_trans))
-                   llo=llo+1
-                   if (llo >= MTrans%num_q_trans) exit
-                end do
-                if (llo == MTrans%num_q_trans) then
-                    lastix = il
-                    exit
-                end if
-                lhi=llo+1
-                ho=kvals(lhi)-kvals(llo) 
-                a0=(kvals(lhi)-xi)/ho
-                b0=(xi-kvals(llo))/ho
-               
-                outpower(il) = a0*matpower(llo)+ b0*matpower(lhi)+((a0**3-a0)* ddmat(llo) &
-                        +(b0**3-b0)*ddmat(lhi))*ho**2/6
-               
-             end do
- 
-             do while (lastix <= npoints)
-                !Do linear extrapolation in the log
-                !Obviouly inaccurate, non-linear etc, but OK if only using in tails of window functions
-                outpower(lastix) = 2*outpower(lastix-1) - outpower(lastix-2)
-                lastix = lastix+1
-             end do
- 
-             outpower = exp(max(-30.,outpower))
- 
-             do il = 1, npoints
-                k = exp(logmink + dlnkh*(il-1))*h
-                outpower(il) = outpower(il) * ScalarPower(k,in) 
-             end do
- 
-           if (CP%NonLinear/=NonLinear_None) call MatterPowerdata_Free(PK)
- 
-         end subroutine Transfer_GetMatterPower
-      
-         subroutine Transfer_Get_sigma8(MTrans, sigr8)
-           use MassiveNu
-           Type(MatterTransferData) :: MTrans
-           integer ik, itf, in
-           real(dl) kh, k, h, x, win, delta
-           real(dl) lnk, dlnk, lnko
-           real(dl) dsig8, dsig8o, sig8, sig8o, powers
-           real(dl), intent(IN) :: sigr8
-          
-           !Calculate MTrans%sigma_8^2 = int dk/k win**2 T_k**2 P(k), where win is the FT of a spherical top hat
-           !of radius sigr8 h^{-1} Mpc
-           
-          H=CP%h0/100._dl
-          do in = 1, CP%InitPower%nn
-           do itf=1,CP%Transfer%num_redshifts
-             lnko=0
-             dsig8o=0
-             sig8=0
-             sig8o=0
-           do ik=1, MTrans%num_q_trans
-                kh = MTrans%TransferData(Transfer_kh,ik,itf)
-                if (kh==0) cycle
-                k = kh*H
-                
-                delta = k**2*MTrans%TransferData(transfer_power_var,ik,itf)
-                !if (CP%NonLinear/=NonLinear_None) delta= delta* MTrans%NonLinearScaling(ik,itf)
-                !sigma_8 defined "as though it were linear"
- 
-                x= kh *sigr8
-                win =3*(sin(x)-x*cos(x))/x**3
-                lnk=log(k)
-                if (ik==1) then
-                   dlnk=0.5_dl 
-                  !Approx for 2._dl/(CP%InitPower%an(in)+3)  [From int_0^k_1 dk/k k^4 P(k)]
-                  !Contribution should be very small in any case 
-                else
-                   dlnk=lnk-lnko
-                end if
-                powers = ScalarPower(k,in)
-                dsig8=(win*delta)**2*powers
-                sig8=sig8+(dsig8+dsig8o)*dlnk/2
-                dsig8o=dsig8
-                lnko=lnk
- 
- 
-           end do
-     
-           MTrans%sigma_8(itf,in) = sqrt(sig8)
-           end do
-          end do
- 
-         end subroutine Transfer_Get_sigma8
- 
-         subroutine Transfer_output_Sig8(MTrans)
-            Type(MatterTransferData), intent(in) :: MTrans
-            
-            integer in, j
-        
-            do in=1, CP%InitPower%nn
-             if (CP%InitPower%nn>1)  write(*,*) 'Power spectrum : ', in
-             do j = 1, CP%Transfer%num_redshifts
-                write(*,*) 'at z = ',real(CP%Transfer%redshifts(j)), ' sigma8 (all matter)=', real(MTrans%sigma_8(j,in))
-             end do
-            end do
- 
-          end subroutine Transfer_output_Sig8
- 
- 
-         subroutine Transfer_output_Sig8AndNorm(MTrans)
-            Type(MatterTransferData), intent(in) :: MTrans
-            integer in, j
- 
-            do in=1, CP%InitPower%nn
-              write(*,*) 'Power spectrum ',in, ' COBE_scale = ',real(COBE_scales(in))
-             do j = 1, CP%Transfer%num_redshifts
-                write(*,*) 'at z = ',real(CP%Transfer%redshifts(j)), ' sigma8(all matter) = ', &
-                     real(MTrans%sigma_8(j,in)*sqrt(COBE_scales(in)))
-             end do
-            end do
-                 
-          end subroutine Transfer_output_Sig8AndNorm
- 
- 
-         subroutine Transfer_Allocate(MTrans)
-          Type(MatterTransferData) :: MTrans
-          integer st
- 
-           deallocate(MTrans%q_trans, STAT = st)
-           deallocate(MTrans%TransferData, STAT = st)
-           deallocate(MTrans%sigma_8, STAT = st)
-           allocate(MTrans%q_trans(MTrans%num_q_trans))            
-           allocate(MTrans%TransferData(Transfer_max,MTrans%num_q_trans,CP%Transfer%num_redshifts))  
-           allocate(MTrans%sigma_8(CP%Transfer%num_redshifts, CP%InitPower%nn))
-            
-         end  subroutine Transfer_Allocate
- 
-         subroutine Transfer_Free(MTrans)
-           Type(MatterTransferData):: MTrans
-           integer st
- 
-           deallocate(MTrans%q_trans, STAT = st)
-           deallocate(MTrans%TransferData, STAT = st)
-           deallocate(MTrans%sigma_8, STAT = st)
-           nullify(MTrans%q_trans)
-           nullify(MTrans%TransferData)
-           nullify(MTrans%sigma_8)
-           
-         end subroutine Transfer_Free
- 
-        subroutine Transfer_SetForNonlinearLensing(P)
-           Type(TransferParams) :: P
-           integer i
- 
-           P%kmax = 5*AccuracyBoost
-           P%k_per_logint  = 0
-           P%num_redshifts =  nint(10*AccuracyBoost)
-           if (P%num_redshifts > max_transfer_redshifts) &
-                 stop 'Transfer_SetForNonlinearLensing: Too many redshifts'
-           do i=1,P%num_redshifts
-            P%redshifts(i) = real(P%num_redshifts-i)/(P%num_redshifts/10)
-           end do
- 
-        end subroutine Transfer_SetForNonlinearLensing
- 
- 
- 
-         subroutine Transfer_SaveToFiles(MTrans,FileNames)
-           use IniFile
-           Type(MatterTransferData), intent(in) :: MTrans
-           integer i,ik
-           character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
- 
-           do i=1, CP%Transfer%num_redshifts
-             if (FileNames(i) /= '') then
-             open(unit=fileio_unit,file=FileNames(i),form='formatted',status='replace')
-              do ik=1,MTrans%num_q_trans
-                 if (MTrans%TransferData(Transfer_kh,ik,i)/=0) then
-                  write(fileio_unit,'(7E14.6)') MTrans%TransferData(Transfer_kh:Transfer_max,ik,i)
-                 end if
-              end do
-             close(fileio_unit)
-             end if
-           end do
- 
-           
-         end subroutine Transfer_SaveToFiles
- 
-         subroutine Transfer_SaveMatterPower(MTrans, FileNames)
-           use IniFile
-           !Export files of total  matter power spectra in h^{-1} Mpc units, against k/h.
-           Type(MatterTransferData), intent(in) :: MTrans
-           character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
-           integer itf,in,i
-           integer points
-           real, dimension(:,:), allocatable :: outpower
-           character(LEN=80) fmt
-           real minkh,dlnkh
-           Type(MatterPowerData) :: PK_data
- 
- 
-           write (fmt,*) CP%InitPower%nn+1
-           fmt = '('//trim(adjustl(fmt))//'E15.5)'
-           do itf=1, CP%Transfer%num_redshifts
-             if (FileNames(itf) /= '') then
- 
-             
-              if (.not. transfer_interp_matterpower ) then
-              
-              points = MTrans%num_q_trans
-              allocate(outpower(points,CP%InitPower%nn))
-        
-                  do in = 1, CP%InitPower%nn
- 
-                    call Transfer_GetMatterPowerData(MTrans, PK_data, in, itf)
- 
-                   if (CP%NonLinear/=NonLinear_None) call MatterPowerdata_MakeNonlinear(PK_Data)
- 
-                    outpower(:,in) = exp(PK_data%matpower(:,1))
-                    call MatterPowerdata_Free(PK_Data)
-                  end do
- 
-                  open(unit=fileio_unit,file=FileNames(itf),form='formatted',status='replace')
-                  do i=1,points
-                   write (fileio_unit, fmt) MTrans%TransferData(Transfer_kh,i,1),outpower(i,1:CP%InitPower%nn)
-                  end do
-                  close(fileio_unit)
- 
-              else
- 
- 
-              minkh = 1e-4
-              dlnkh = 0.02
-              points = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/dlnkh+1
- !             dlnkh = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/(points-0.999)
-              allocate(outpower(points,CP%InitPower%nn))
-              do in = 1, CP%InitPower%nn
-               call Transfer_GetMatterPower(MTrans,outpower(1,in), itf, in, minkh,dlnkh, points)
-               if (CP%OutputNormalization == outCOBE) then
-                  if (allocated(COBE_scales)) then
-                   outpower(:,in) = outpower(:,in)*COBE_scales(in)
-                  else
-                   if (FeedbackLevel>0) write (*,*) 'Cannot COBE normalize - no Cls generated'
-                  end if
-              end if
-              end do
-      
-              open(unit=fileio_unit,file=FileNames(itf),form='formatted',status='replace')
-              do i=1,points
-               write (fileio_unit, fmt) minkh*exp((i-1)*dlnkh),outpower(i,1:CP%InitPower%nn)
-              end do
-              close(fileio_unit)
-              
-              end if
- 
-              deallocate(outpower) 
-              
-             end if
-           end do
- 
-         end subroutine Transfer_SaveMatterPower
- 
-         end module Transfer
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         module ThermoData
-         use ModelData
-         implicit none
-         private
-         integer,parameter :: nthermo=10000
-         
-         real(dl) tb(nthermo),cs2(nthermo),xe(nthermo)
-         real(dl) dcs2(nthermo)
-         real(dl) dotmu(nthermo), ddotmu(nthermo)
-         real(dl) sdotmu(nthermo),emmu(nthermo)
-         real(dl) demmu(nthermo)
-         real(dl) dddotmu(nthermo),ddddotmu(nthermo)
-         real(dl) tauminn,dlntau,Maxtau
-         real(dl), dimension(:), allocatable :: vis,dvis,ddvis,expmmu,dopac, opac
-     
-         real(dl) :: tight_tau, actual_opt_depth
-          !Times when 1/(opacity*tau) = 0.01, for use switching tight coupling approximation
-         real(dl) :: matter_verydom_tau
-          
-         public thermo,inithermo,vis,opac,expmmu,dvis,dopac,ddvis, tight_tau,&
-                Thermo_OpacityToTime,matter_verydom_tau, ThermoData_Free
-        contains
- 
-         subroutine thermo(tau,cs2b,opacity, dopacity)
-         !Compute unperturbed sound speed squared,
-         !and ionization fraction by interpolating pre-computed tables.
-         !If requested also get time derivative of opacity
-         implicit none
-         real(dl) tau,cs2b,opacity
-         real(dl), intent(out), optional :: dopacity
- 
-         integer i
-         real(dl) d
-         
-         d=log(tau/tauminn)/dlntau+1._dl
-         i=int(d)
-         d=d-i
-         if (i < 1) then
-         !Linear interpolation if out of bounds (should not occur).
-           cs2b=cs2(1)+(d+i-1)*dcs2(1)
-           opacity=dotmu(1)+(d-1)*ddotmu(1)
- !!!
-            stop 'thermo out of bounds'
-         else if (i >= nthermo) then
-           cs2b=cs2(nthermo)+(d+i-nthermo)*dcs2(nthermo)
-           opacity=dotmu(nthermo)+(d-nthermo)*ddotmu(nthermo)
-           if (present(dopacity)) then
-              dopacity = 0
-              stop 'thermo: shouldn''t happen'
-            end if
-         else
-         !Cubic spline interpolation.
-           cs2b=cs2(i)+d*(dcs2(i)+d*(3*(cs2(i+1)-cs2(i))  &
-               -2*dcs2(i)-dcs2(i+1)+d*(dcs2(i)+dcs2(i+1)  &
-               +2*(cs2(i)-cs2(i+1)))))
-           opacity=dotmu(i)+d*(ddotmu(i)+d*(3*(dotmu(i+1)-dotmu(i)) &
-               -2*ddotmu(i)-ddotmu(i+1)+d*(ddotmu(i)+ddotmu(i+1) &
-               +2*(dotmu(i)-dotmu(i+1)))))
- 
-          if (present(dopacity)) then
- !!!
-           dopacity=(ddotmu(i)+d*(dddotmu(i)+d*(3*(ddotmu(i+1)  &
-               -ddotmu(i))-2*dddotmu(i)-dddotmu(i+1)+d*(dddotmu(i) &
-               +dddotmu(i+1)+2*(ddotmu(i)-ddotmu(i+1))))))/(tau*dlntau)
- 
-          end if
-         end if
-         end subroutine thermo
-         
- 
- 
-        function Thermo_OpacityToTime(opacity)
-          real(dl), intent(in) :: opacity
-          integer j
-          real(dl) Thermo_OpacityToTime
-          !Do this the bad slow way for now..
-           !The answer is approximate
-          j =1
-          do while(dotmu(j)> opacity)
-             j=j+1
-          end do
-           
-          Thermo_OpacityToTime = exp((j-1)*dlntau)*tauminn
- 
-        end function Thermo_OpacityToTime
- 
-      subroutine inithermo(taumin,taumax)
- !  Compute and save unperturbed baryon temperature and ionization fraction
- !  as a function of time.  With nthermo=10000, xe(tau) has a relative 
- ! accuracy (numerical integration precision) better than 1.e-5.
-         use constants
-         use precision
-         use ModelParams
-         use MassiveNu
-         real(dl) taumin,taumax
-    
-    
-         real(dl) tau01,adot0,a0,a02,x1,x2,barssc,dtau
-         real(dl) xe0,tau,a,a2
-         real(dl) adot,tg0,ahalf,adothalf,fe,thomc,thomc0,etc,a2t
-         real(dl) dtbdla,vfi,cf1,maxvis, vis
-         integer ncount,i,j1,j2,iv,ns
-         real(dl) spline_data(nthermo)
-         real(dl) last_dotmu
-         real(dl) dtauda  !diff of tau w.CP%r.t a and integration
-         external dtauda
-  
-         real(dl) a_verydom
- 
-      
-         call Recombination_Init(CP%Recomb, CP%omegac, CP%omegab,CP%Omegan, CP%Omegav, CP%h0,CP%tcmb,CP%yhe)
-           !almost all the time spent here
- 
-         Maxtau=taumax
-         tight_tau = 0
-         actual_opt_depth = 0
-         ncount=0
-         thomc0=5.0577d-8*CP%tcmb**4
- 
-         tauminn=0.05d0*taumin
-         dlntau=log(CP%tau0/tauminn)/(nthermo-1)
-         last_dotmu = 0
- 
-         matter_verydom_tau = 0
-         a_verydom = AccuracyBoost*10*(grhog+grhornomass)/(grhoc+grhob)
-         if (CP%Num_Nu_massive /= 0) a_verydom=a_verydom*1.5 
- 
- !  Initial conditions: assume radiation-dominated universe.
-         tau01=tauminn
-         adot0=adotrad
-         a0=adotrad*tauminn
-         a02=a0*a0
- !  Assume that any entropy generation occurs before tauminn.
- !  This gives wrong temperature before pair annihilation, but
- !  the error is harmless.
-         tb(1)=CP%tcmb/a0
-         xe0=1._dl
-         x1=0._dl
-         x2=1._dl
-         xe(1)=xe0+0.25d0*CP%yhe/(1._dl-CP%yhe)*(x1+2*x2)
-         barssc=barssc0*(1._dl-0.75d0*CP%yhe+(1._dl-CP%yhe)*xe(1))
-         cs2(1)=4._dl/3._dl*barssc*tb(1)
-         dotmu(1)=xe(1)*akthom/a02
-         sdotmu(1)=0
-   
-           do i=2,nthermo
-           tau=tauminn*exp((i-1)*dlntau)
-           dtau=tau-tau01
- !  Integrate Friedmann equation using inverse trapezoidal rule.
-       
-           a=a0+adot0*dtau
-           a2=a*a
- 
-           adot=1/dtauda(a)
- 
-           if (matter_verydom_tau ==0 .and. a > a_verydom) then
-              matter_verydom_tau = tau  
-           end if
-           
-           a=a0+2._dl*dtau/(1._dl/adot0+1._dl/adot)         
- !  Baryon temperature evolution: adiabatic except for Thomson cooling.
- !  Use  quadrature solution.
- ! This is redundant as also calculated in REFCAST, but agrees well before reionization
-           tg0=CP%tcmb/a0
-           ahalf=0.5d0*(a0+a)
-           adothalf=0.5d0*(adot0+adot)
- !  fe=number of free electrons divided by total number of free baryon
- !  particles (e+p+H+He).  Evaluate at timstep i-1 for convenience; if
- !  more accuracy is required (unlikely) then this can be iterated with
- !  the solution of the ionization equation.
-           fe=(1._dl-CP%yhe)*xe(i-1)/(1._dl-0.75d0*CP%yhe+(1._dl-CP%yhe)*xe(i-1))
-           thomc=thomc0*fe/adothalf/ahalf**3
-           etc=exp(-thomc*(a-a0))
-           a2t=a0*a0*(tb(i-1)-tg0)*etc-CP%tcmb/thomc*(1._dl-etc)
-           tb(i)=CP%tcmb/a+a2t/(a*a)
-        
- ! If there is re-ionization, smoothly increase xe to the 
- ! requested value.
-           if (CP%Reion%Reionization .and. tau > CP%ReionHist%tau_start) then
-              if(ncount == 0) then
-                 ncount=i-1
-              end if   
- 
-             xe(i) = Reionization_xe(a, tau, xe(ncount))
-             !print *,1/a-1,xe(i)
-             if (CP%AccurateReionization .and. FeedbackLevel > 0) then                         
-                 dotmu(i)=(Recombination_xe(a) - xe(i))*akthom/a2
-                 if (last_dotmu /=0) then
-                  actual_opt_depth = actual_opt_depth - 2._dl*dtau/(1._dl/dotmu(i)+1._dl/last_dotmu)
-                 end if
-                 last_dotmu = dotmu(i) 
-             end if
-            
-           else
-             xe(i)=Recombination_xe(a)
-           end if 
-        
-        
- !  Baryon sound speed squared (over c**2).
-           dtbdla=-2._dl*tb(i)-thomc*adothalf/adot*(a*tb(i)-CP%tcmb)
-           barssc=barssc0*(1._dl-0.75d0*CP%yhe+(1._dl-CP%yhe)*xe(i))
-           cs2(i)=barssc*tb(i)*(1-dtbdla/tb(i)/3._dl)
- ! Calculation of the visibility function
-           dotmu(i)=xe(i)*akthom/a2
- 
-           if (tight_tau==0 .and. 1/(tau*dotmu(i)) > 0.005) tight_tau = tau !0.005
-            !Tight coupling switch time when k/opacity is smaller than 1/(tau*opacity)
-            
-           if (tau < 0.001) then
-              sdotmu(i)=0
-           else
-              sdotmu(i)=sdotmu(i-1)+2._dl*dtau/(1._dl/dotmu(i)+1._dl/dotmu(i-1))
-           end if
- 
-           a0=a
-           tau01=tau
-           adot0=adot
-           end do !i
-                  
-           if (CP%Reion%Reionization .and. (xe(nthermo) < 0.999d0)) then
-              write(*,*)'Warning: xe at redshift zero is < 1'
-              write(*,*) 'Check input parameters an Reionization_xe'
-              write(*,*) 'function in the Reionization module'
-           end if
-    
-         do j1=1,nthermo
-            if (sdotmu(j1) - sdotmu(nthermo)< -69) then
-            emmu(j1)=1.d-30
-            else
-            emmu(j1)=exp(sdotmu(j1)-sdotmu(nthermo))
-            if (.not. CP%AccurateReionization .and. &
-                actual_opt_depth==0 .and. xe(j1) < 1e-3) then
-               actual_opt_depth = -sdotmu(j1)+sdotmu(nthermo) 
-            end if
-           end if
-         end do  
- 
-         if (CP%AccurateReionization .and. FeedbackLevel > 0) then                         
-          write(*,'("Reion opt depth      = ",f7.4)') actual_opt_depth
-         end if
- 
-         iv=0
-         vfi=0._dl
- ! Getting the starting and finishing times for decoupling a+nd time of maximum visibility
-         if (ncount == 0) then
-            cf1=1._dl
-            ns=nthermo
-            else
-               cf1=exp(sdotmu(nthermo)-sdotmu(ncount))
-               ns=ncount
-            end if
-          maxvis = 0
-          do j1=1,ns
-            vis = emmu(j1)*dotmu(j1)
-            tau = tauminn*exp((j1-1)*dlntau)
-            vfi=vfi+vis*cf1*dlntau*tau
-            if ((iv == 0).and.(vfi > 1.0d-7/AccuracyBoost)) then  
-               taurst=9._dl/10._dl*tau
-               iv=1
-            elseif (iv == 1) then 
-                if (vis > maxvis) then
-                 maxvis=vis
-                 tau_maxvis = tau
-                end if
-                if (vfi > 0.995) then 
-                 taurend=tau
-                 iv=2
-                 exit
-                end if
-            end if
-          end do
- 
-            if (iv /= 2) then
-              stop 'inithermo: failed to find end of recombination'
- !              taurend=1.5d0*(tauminn*exp((ncount-1)*dlntau))
-            end if
-           
- 
- ! Calculating the timesteps during recombination.
-            
-     
-            if (CP%WantTensors) then
-               dtaurec=min(dtaurec,taurst/160)/AccuracyBoost 
-            else
-               dtaurec=min(dtaurec,taurst/40)/AccuracyBoost 
-            end if
-  
-            if (CP%Reion%Reionization) taurend=min(taurend,CP%ReionHist%tau_start)
- 
-          if (DebugMsgs) then
-            write (*,*) 'taurst, taurend = ', taurst, taurend
-          end if
-   
-         matter_verydom_tau = max(matter_verydom_tau,taurend)
- 
-         call splini(spline_data,nthermo)
-         call splder(cs2,dcs2,nthermo,spline_data)
-         call splder(dotmu,ddotmu,nthermo,spline_data)
-         call splder(ddotmu,dddotmu,nthermo,spline_data)  
-         call splder(dddotmu,ddddotmu,nthermo,spline_data)
-         call splder(emmu,demmu,nthermo,spline_data)
-    
-         call SetTimeSteps
- 
-         !$OMP PARALLEL DO DEFAULT(SHARED),SCHEDULE(STATIC) 
-         do j2=1,TimeSteps%npoints
-              call DoThermoSpline(j2,TimeSteps%points(j2))
-         end do 
-          !$OMP END PARALLEL DO 
- 
-         end subroutine inithermo        
- 
- 
-         subroutine SetTimeSteps
-         real(dl) dtau0
-         integer nri0, nstep
- 
-          call Ranges_Init(TimeSteps)
- 
-          call Ranges_Add_delta(TimeSteps, taurst, taurend, dtaurec)
- 
-         ! Calculating the timesteps after recombination
-            if (CP%WantTensors) then
-               dtau0=max(taurst/40,Maxtau/2000._dl/AccuracyBoost)
-            else       
-               dtau0=Maxtau/500._dl/AccuracyBoost
-              !Don't need this since adding in Limber on small scales
-               !  if (CP%DoLensing) dtau0=dtau0/2 
-               !  if (CP%AccurateBB) dtau0=dtau0/3 !Need to get C_Phi accurate on small scales
-            end if
-     
-          call Ranges_Add_delta(TimeSteps,taurend, CP%tau0, dtau0)
- 
-          if (CP%Reion%Reionization) then
-            
-               nri0=int(Reionization_timesteps(CP%ReionHist)*AccuracyBoost) 
-                 !Steps while reionization going from zero to maximum
-               call Ranges_Add(TimeSteps,CP%ReionHist%tau_start,CP%ReionHist%tau_complete,nri0) 
- 
-          end if
- 
- !Create arrays out of the region information.
-         call Ranges_GetArray(TimeSteps)
-         nstep = TimeSteps%npoints
- 
-         if (allocated(vis)) then
-            deallocate(vis,dvis,ddvis,expmmu,dopac, opac)
-         end if
-         allocate(vis(nstep),dvis(nstep),ddvis(nstep),expmmu(nstep),dopac(nstep),opac(nstep))
- 
-         if (DebugMsgs .and. FeedbackLevel > 0) write(*,*) 'Set ',nstep, ' time steps'
-     
-         end subroutine SetTimeSteps
- 
- 
-         subroutine ThermoData_Free
-          if (allocated(vis)) then
-            deallocate(vis,dvis,ddvis,expmmu,dopac, opac)
-          end if
-          call Ranges_Free(TimeSteps)
- 
-         end subroutine ThermoData_Free
- 
- !cccccccccccccc
-         subroutine DoThermoSpline(j2,tau)
-         integer j2,i
-         real(dl) d,ddopac,tau
-         
- !     Cubic-spline interpolation.
-            d=log(tau/tauminn)/dlntau+1._dl
-            i=int(d)
-       
-            d=d-i
-            if (i < nthermo) then
-           opac(j2)=dotmu(i)+d*(ddotmu(i)+d*(3._dl*(dotmu(i+1)-dotmu(i)) &
-               -2._dl*ddotmu(i)-ddotmu(i+1)+d*(ddotmu(i)+ddotmu(i+1) &
-               +2._dl*(dotmu(i)-dotmu(i+1)))))
-           dopac(j2)=(ddotmu(i)+d*(dddotmu(i)+d*(3._dl*(ddotmu(i+1)  &
-               -ddotmu(i))-2._dl*dddotmu(i)-dddotmu(i+1)+d*(dddotmu(i) &
-               +dddotmu(i+1)+2._dl*(ddotmu(i)-ddotmu(i+1))))))/(tau &
-               *dlntau)
-           ddopac=(dddotmu(i)+d*(ddddotmu(i)+d*(3._dl*(dddotmu(i+1) &
-               -dddotmu(i))-2._dl*ddddotmu(i)-ddddotmu(i+1)  &
-               +d*(ddddotmu(i)+ddddotmu(i+1)+2._dl*(dddotmu(i) &
-               -dddotmu(i+1)))))-(dlntau**2)*tau*dopac(j2)) &
-               /(tau*dlntau)**2
-           expmmu(j2)=emmu(i)+d*(demmu(i)+d*(3._dl*(emmu(i+1)-emmu(i)) &
-               -2._dl*demmu(i)-demmu(i+1)+d*(demmu(i)+demmu(i+1) &
-               +2._dl*(emmu(i)-emmu(i+1)))))
-  
-           vis(j2)=opac(j2)*expmmu(j2)
-           dvis(j2)=expmmu(j2)*(opac(j2)**2+dopac(j2))
-           ddvis(j2)=expmmu(j2)*(opac(j2)**3+3*opac(j2)*dopac(j2)+ddopac)
-           else
-           opac(j2)=dotmu(nthermo)
-           dopac(j2)=ddotmu(nthermo)
-           ddopac=dddotmu(nthermo)
-           expmmu(j2)=emmu(nthermo)
-           vis(j2)=opac(j2)*expmmu(j2)
-           dvis(j2)=expmmu(j2)*(opac(j2)**2+dopac(j2))
-           ddvis(j2)=expmmu(j2)*(opac(j2)**3+3._dl*opac(j2)*dopac(j2)+ddopac)
- 
-           end if
-         end subroutine DoThermoSpline
- 
-       
-  
-       end module ThermoData
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/params.ini cosmomc_sampler/camb/params.ini
*** cosmomc/camb/params.ini	2008-03-26 15:24:18.000000000 +0100
--- cosmomc_sampler/camb/params.ini	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,188 ****
- #Parameters for CAMB
- 
- #output_root is prefixed to output file names
- output_root = test
- 
- #What to do
- get_scalar_cls = T
- get_vector_cls = F
- get_tensor_cls = F
- get_transfer   = F
- 
- #if do_lensing then scalar_output_file contains additional columns of l^4 C_l^{pp} and l^3 C_l^{pT}
- #where p is the projected potential. Output lensed CMB Cls (without tensors) are in lensed_output_file below.
- do_lensing     = F
- 
- # 0: linear, 1: non-linear matter power (HALOFIT), 2: non-linear CMB lensing (HALOFIT)
- do_nonlinear = 0
- 
- #Maximum multipole and k*eta. 
- #  Note that C_ls near l_max are inaccurate (about 5%), go to 50 more than you need
- #  Lensed power spectra are computed to l_max_scalar-250 where accurate at %-level
- #  For high accuracy lensed spectra set l_max_scalar = (l you need) + 500
- #  To get accurate lensed BB need to have l_max_scalar>2000, k_eta_max_scalar > 10000
- #  Otherwise k_eta_max_scalar=2*l_max_scalar usually suffices
- l_max_scalar      = 2000
- k_eta_max_scalar  = 4000
- 
- #  Tensor settings should be less than or equal to the above
- l_max_tensor      = 1500
- k_eta_max_tensor  = 3000
- 
- #Main cosmological parameters, neutrino masses are assumed degenerate
- # If use_phyical set phyiscal densities in baryone, CDM and neutrinos + Omega_k
- use_physical   = T
- ombh2          = 0.022
- omch2          = 0.12
- omnuh2         = 0
- omk            = 0
- hubble         = 70
- #effective equation of state parameter for dark energy, assumed constant
- w              = -1
- #constant comoving sound speed of the dark energy (1=quintessence)
- cs2_lam        = 1
- 
- #if use_physical = F set parameters as here
- #omega_baryon   = 0.0462
- #omega_cdm      = 0.2538
- #omega_lambda   = 0.7
- #omega_neutrino = 0
- 
- #massless_neutrinos is the effective number (for QED + non-instantaneous decoupling)
- temp_cmb           = 2.726
- helium_fraction    = 0.24
- massless_neutrinos = 3.04
- massive_neutrinos  = 0
- 
- #Neutrino mass splittings
- nu_mass_eigenstates = 1
- #nu_mass_degeneracies = 0 sets nu_mass_degeneracies = massive_neutrinos
- #otherwise should be an array
- #e.g. for 3 neutrinos with 2 non-degenerate eigenstates, nu_mass_degeneracies = 2 1
- nu_mass_degeneracies = 0  
- #Fraction of total omega_nu h^2 accounted for by each eigenstate, eg. 0.5 0.5
- nu_mass_fractions = 1
- 
- #Initial power spectrum, amplitude, spectral index and running. Pivot k in Mpc^{-1}.
- initial_power_num         = 1
- pivot_scalar              = 0.05
- pivot_tensor              = 0.05
- scalar_amp(1)             = 2.3e-9
- scalar_spectral_index(1)  = 1
- scalar_nrun(1)            = 0
- tensor_spectral_index(1)  = 0
- #ratio is that of the initial tens/scal power spectrum amplitudes
- initial_ratio(1)          = 1
- #note vector modes use the scalar settings above
- 
- 
- #Reionization, ignored unless reionization = T, re_redshift measures where x_e=0.5
- reionization         = T
- 
- re_use_optical_depth = T
- re_optical_depth     = 0.09
- #If re_use_optical_depth = F then use following, otherwise ignored
- re_redshift          = 11
- #width of reionization transition. CMBFAST model was similar to re_delta_redshift~0.5.
- re_delta_redshift    = 1.5
- #re_ionization_frac=-1 sets to become fully ionized using YHe to get helium contribution
- #Otherwise x_e varies from 0 to re_ionization_frac
- re_ionization_frac   = -1
- 
- 
- #RECFAST 1.4 recombination parameters
- RECFAST_fudge = 1.14
- RECFAST_fudge_He = 0.86
- RECFAST_Heswitch = 6
- 
- 
- #Initial scalar perturbation mode (adiabatic=1, CDM iso=2, Baryon iso=3, 
- # neutrino density iso =4, neutrino velocity iso = 5) 
- initial_condition   = 1
- #If above is zero, use modes in the following (totally correlated) proportions
- #Note: we assume all modes have the same initial power spectrum
- initial_vector = -1 0 0 0 0
- 
- #For vector modes: 0 for regular (neutrino vorticity mode), 1 for magnetic
- vector_mode = 0
- 
- #Normalization
- COBE_normalize = F
- ##CMB_outputscale scales the output Cls
- #To get MuK^2 set realistic initial amplitude (e.g. scalar_amp(1) = 2.3e-9 above) and
- #otherwise for dimensionless transfer functions set scalar_amp(1)=1 and use
- #CMB_outputscale = 1
- CMB_outputscale = 7.4311e12
- 
- #Transfer function settings, transfer_kmax=0.5 is enough for sigma_8
- #transfer_k_per_logint=0 sets sensible non-even sampling; 
- #transfer_k_per_logint=5 samples fixed spacing in log-k
- #transfer_interp_matterpower =T produces matter power in regular interpolated grid in log k; 
- # use transfer_interp_matterpower =F to output calculated values (e.g. for later interpolation)
- transfer_high_precision = F
- transfer_kmax           = 2
- transfer_k_per_logint   = 0
- transfer_num_redshifts  = 1
- transfer_interp_matterpower = T
- transfer_redshift(1)    = 0
- transfer_filename(1)    = transfer_out.dat
- #Matter power spectrum output against k/h in units of h^{-3} Mpc^3
- transfer_matterpower(1) = matterpower.dat
- 
- 
- #Output files not produced if blank. make camb_fits to use use the FITS setting.
- scalar_output_file = scalCls.dat
- vector_output_file = vecCls.dat
- tensor_output_file = tensCls.dat
- total_output_file  = totCls.dat
- lensed_output_file = lensedCls.dat
- lensed_total_output_file  =lensedtotCls.dat
- FITS_filename      = scalCls.fits
- 
- ##Optional parameters to control the computation speed,accuracy and feedback
- 
- #If feedback_level > 0 print out useful information computed about the model
- feedback_level = 1
- 
- # 1: curved correlation function, 2: flat correlation function, 3: inaccurate harmonic method
- lensing_method = 1
- accurate_BB = F
- 
- 
- #massive_nu_approx: 0 - integrate distribution function
- #                   1 - switch to series in velocity weight once non-relativistic
- #                   2 - use fast approximate scheme (CMB only- accurate for light neutrinos)
- #                   3 - intelligently use the best accurate method
- massive_nu_approx = 3
- 
- #Whether you are bothered about polarization. 
- accurate_polarization   = T
- 
- #Whether you are bothered about percent accuracy on EE from reionization
- accurate_reionization   = T
- 
- #whether or not to include neutrinos in the tensor evolution equations
- do_tensor_neutrinos     = F
- 
- #Whether to turn off small-scale late time radiation hierarchies (save time,v. accurate)
- do_late_rad_truncation   = T
- 
- #Computation parameters
- #if number_of_threads=0 assigned automatically
- number_of_threads       = 0
- 
- #Default scalar accuracy is about 0.3% (except lensed BB). 
- #For 0.1%-level try accuracy_boost=2, l_accuracy_boost=2.
- 
- #Increase accuracy_boost to decrease time steps, use more k values,  etc.
- #Decrease to speed up at cost of worse accuracy. Suggest 0.8 to 3.
- accuracy_boost          = 1
- 
- #Larger to keep more terms in the hierarchy evolution. 
- l_accuracy_boost        = 1
- 
- #Increase to use more C_l values for interpolation.
- #Increasing a bit will improve the polarization accuracy at l up to 200 -
- #interpolation errors may be up to 3%
- #Decrease to speed up non-flat models a bit
- l_sample_boost          = 1
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/plotcls.m cosmomc_sampler/camb/plotcls.m
*** cosmomc/camb/plotcls.m	2005-03-31 00:48:10.000000000 +0200
--- cosmomc_sampler/camb/plotcls.m	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,170 ****
- 
- function plotcls(varargin)
- global l_label
- 
- 
- clf;
- hin=ishold;
- h=false;
- colours = 'krbcmgy';
- l_label = 'l';
- 
- 
- ticks = [2 40 200 600 1200];
- 
- 
- for i=1:nargin
- 
- dats{i}=load(varargin{i});
- x=size(dats{i});
- colnum(i)=x(2);
- end
- 
- lmin=2;
- lmax=1;
- minTE=1e30;minEE=1e30;minTT=1e30;
- maxTE=-1e30;maxEE=-1e30;maxTT=-1e30;
- plotx=2;ploty=2;
- if nargin>1
-  ploty=3;
- end
- 
- for i=1:nargin
- x=dats{i};
- 
- col=colours(i);
- ls=x(:,1);
- 
- TT=x(:,2);
- EE=x(:,3);
- noB = colnum(i)==4 || colnum(i)==6;
- if (noB)
-  TE=x(:,4);
-  BB=0;
- else
-  BB=x(:,4);
-  TE=x(:,5);
- end 
- 
- if i==1    
-  compTT=TT;
-  compEE=EE;
-  compTE=TE;
- end
- 
- minTT = min(minTT,min(TT(:)));
- maxTT = max(maxTT,max(TT(:)));
- maxTE = max(maxTE,max(TE(:)));
- maxEE = max(maxEE,max(EE(:)));
- minTE = min(minTE,min(TE(:)));
- minEE = min(minEE,min(EE(:)));
- 
- lmin=min(lmin,min(ls));
- lmax=max(lmax,max(ls));
- 
- if i==1
-  if (lmax >= 2000) ticks = [ticks 2000];end
-  if (lmax >= 3000) ticks = [ticks 3000];end
- end
- 
- subplot(ploty,plotx,1);
- seth(h);
- loglog(ls,TT,col);
- setaxes(minTT*0.9,maxTT*1.1,lmin,lmax);
- 
- subplot(ploty,plotx,3);
- seth(h);
- plot(sqrt(ls),TT,col);
- setaxes(0,maxTT*1.1,sqrt(lmin),sqrt(lmax));
- set(gca,'XTick',sqrt(ticks));
- set(gca,'XTickLabel',ticks);
- 
- 
- subplot(ploty,plotx,2);
- 
- seth(h);
- e=minEE*0.5;
- t=max(maxEE,maxTE)*2;
- loglog(ls,EE,['-' col]);
- setaxes(e,t, lmin,lmax);
- 
- hold on;
- loglog(ls,TE,['-' col]);
- loglog(ls,-TE,[':' col]);
- 
- if ~noB
-  loglog(ls,BB,['--' col]);
- end
- 
- subplot(ploty,plotx,4);
- seth(h);
- plot(sqrt(ls),TE,['-' col]);
- hold on;
- plot(sqrt(ls),EE,['-' col]);
- setaxes(minTE*1.1,maxTE*1.1,sqrt(lmin),sqrt(lmax));
- 
- set(gca,'XTick',sqrt(ticks));
- set(gca,'XTickLabel',ticks);
- 
- 
- if i>1   
-   subplot(ploty,plotx,5);
-   if i==2
-    seth(hin);
-   else
-    seth(h)
-   end
- 
-   dm = min(size(TT),size(compTT));
-   cmp= (TT(1:dm) - compTT(1:dm)) ./ compTT(1:dm);
-   plot(sqrt(ls(1:dm)),cmp,col);
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
- 
-   ylabel('{\Delta C_l / C_l} (TT)');
-   xlabel(l_label);
-   hold on;
-   subplot(ploty,plotx,6);
-   if i==2
-    seth(hin);
-   else
-    seth(h)
-   end
-   cmp= (EE(1:dm) - compEE(1:dm)) ./ compEE(1:dm);
-   maxcmp = max(cmp);
-   plot(sqrt(ls(1:dm)),cmp,col);
-   hold on;  
-   for j=1:dm
-     cmp= (TE(1:dm) - compTE(1:dm)) ./ sqrt(compEE(1:dm).*compTT(1:dm));
-   end
-   plot(sqrt(ls(1:dm)),cmp,[':' col]);
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
-    
-   ylabel('{{\Delta C_l / C_l}}(EE/TE)');
-   xlabel(l_label);
-   hold on;
- end
- 
- h=true;
- end;
- 
- seth(hin);
- % print -dpsc2 plotcls.ps;
- 
- 
- function seth(h)
- 
- if h
-  hold on
- else
-  hold off
- end
- 
- function setaxes(a,b,c,d)
- global l_label
- 
- set(gca,'YLim',[a,b],'XLim',[c,d]);
- xlabel(l_label);ylabel('l(l+1) C_l / 2\pi');
\ No newline at end of file
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/plotdiffs.m cosmomc_sampler/camb/plotdiffs.m
*** cosmomc/camb/plotdiffs.m	2005-03-31 00:48:10.000000000 +0200
--- cosmomc_sampler/camb/plotdiffs.m	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,130 ****
- %use plotdiffs('scalCls.dat','scalCls2.dat','scalCls3.dat') to plot fractional differences
- 
- function plotdiffs(varargin)
- global l_label
- 
- clf;
- ticks = [2 10 40 100 200 400 700 1000 1500];
- 
- colours = 'krbcmgy';
- l_label = 'l';
- 
- for i=1:nargin
- 
- dats{i}=load(varargin{i});
- x=size(dats{i});
- colnum(i)=x(2);
- end
- 
- lmin=2;
- lmax=1;
- 
- plotx=1;ploty=4;
- 
- for i=1:nargin
- x=dats{i};
- 
- col=colours(i);
- ls=x(:,1);
- 
- TT=x(:,2);
- EE=x(:,3);
- noB = colnum(i)==4 || colnum(i)==6;
- if (noB)
-  ploty=3;
-  TE=x(:,4);
-  BB=0;
- else
-  BB=x(:,4);
-  TE=x(:,5);
- end 
- 
- if i==1    
-  compTT=TT;
-  compEE=EE;
-  compTE=TE;
-  if ~noB
-   compBB=BB;
-  end
- end
- 
- lmin=min(lmin,min(ls));
- if i==1
-  lmax = max(ls);
- end
- 
- if i>1   
- 
-   lmax=min(lmax,max(ls));
-   subplot(ploty,plotx,1);
- 
-   dm = min(size(TT),size(compTT));
-   cmp= (TT(1:dm) - compTT(1:dm)) ./ compTT(1:dm);
- 
-   plot(sqrt(ls(1:dm)),cmp,col);
-   hold on;
-   ylabel('{\Delta C^{TT} / C^{TT}}');
-   xlabel(l_label);
- 
-   if i==2
-    if (lmax >= 2000) ticks = [ticks 2000];end
-    if (lmax >= 3000) ticks = [ticks 3000];end
-   end
- 
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
- 
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
- 
-   subplot(ploty,plotx,2);
- 
-   cmp= (TE(1:dm) - compTE(1:dm)) ./ sqrt(compEE(1:dm).*compTT(1:dm));
- 
-   plot(sqrt(ls(1:dm)),cmp,col);
-   hold on;
- 
-   ylabel('\Delta C^{TE}/(C^{EE} C^{TT})^{1/2}');
-   xlabel(l_label);
- 
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
- 
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
- 
-   subplot(ploty,plotx,3);
- 
-   cmp= (EE(1:dm) - compEE(1:dm)) ./ compEE(1:dm);
-   maxcmp = max(cmp);
- 
-   plot(sqrt(ls(1:dm)),cmp,col);
-   hold on;
-   ylabel('{\Delta C^{EE} / C^{EE}}');
-   xlabel(l_label);
- 
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
- 
-   if ~noB
-   subplot(ploty,plotx,4);
- 
-   cmp= (BB(1:dm) - compBB(1:dm)) ./ compBB(1:dm);
-   maxcmp = max(cmp);
- 
-   plot(sqrt(ls(1:dm)),cmp,col);
-   hold on;
-   ylabel('{\Delta C^{BB} / C^{BB}}');
-   xlabel(l_label);
- 
-   set(gca,'XTick',sqrt(ticks));
-   set(gca,'XTickLabel',ticks);
-   set(gca,'XLim',[sqrt(lmin) sqrt(lmax)]);
-   end
- 
- end
- 
- 
- end;
- 
- %print -dpsc2 plotdiffcls.ps;
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/plotpk.m cosmomc_sampler/camb/plotpk.m
*** cosmomc/camb/plotpk.m	2005-03-31 00:48:10.000000000 +0200
--- cosmomc_sampler/camb/plotpk.m	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,27 ****
- 
- function plotpk(varargin);
- 
- colours = 'krbcmgy';
- mink = 1e-4;
- clf;
- maxk=0;
- 
- for i=1:nargin
- 
- x=load(varargin{i});
- col=colours(i);
- kh=x(:,1);
- sz = size(kh);
- maxk=max(kh(sz(1)),maxk);
- loglog(kh,x(:,2),['-' col]);
- hold on;
- 
- end
- 
- xlim([mink maxk]);
- xlabel('k/[h^{-1} Mpc]');
- ylabel('P_k/(h Mpc^{-1})^3');
- hold off;
- 
- %print -depsc2 pk.eps
- end
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/plotTT.m cosmomc_sampler/camb/plotTT.m
*** cosmomc/camb/plotTT.m	2005-03-31 00:48:10.000000000 +0200
--- cosmomc_sampler/camb/plotTT.m	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,95 ****
- 
- function plotcls(varargin)
- global l_label
- 
- hin=ishold;
- h=false;
- colours = 'krbcmgy';
- l_label = 'l';
- 
- for i=1:nargin
- 
- dats{i}=load(varargin{i});
- x=size(dats{i});
- colnum(i)=x(2);
- end
- 
- lmin=2;
- lmax=1;
- minTE=1e30;minEE=1e30;minTT=1e30;
- maxTE=-1e30;maxEE=-1e30;maxTT=-1e30;
- plotx=1;ploty=1;
- if nargin>1
-  ploty=2;
- end
- 
- for i=1:nargin
- x=dats{i};
- 
- col=colours(i);
- ls=x(:,1);
- 
- 
- TT=x(:,2);
- 
- if i==1    
-  compTT=TT;
- end
- 
- minTT = min(minTT,min(TT(:)));
- maxTT = max(maxTT,max(TT(:)));
- 
- lmin=min(lmin,min(ls));
- lmax=max(lmax,max(ls));
- subplot(ploty,plotx,1);
- seth(h);
- plot(sqrt(ls),TT,col);
- setaxes(minTT*0.9,maxTT*1.1,1,sqrt(lmax));
- ticks = [2 10 40 100 200 400 700 1000 1500];
- set(gca,'XTick',sqrt(ticks));
- set(gca,'XTickLabel',ticks);
- 
- if i>1   
-   subplot(ploty,plotx,2);
-   if i==2
-    seth(hin);
-   else
-    seth(h)
-   end
-   dm = min(size(TT),size(compTT));
-   cmp= (TT(1:dm) - compTT(1:dm)) ./ compTT(1:dm);
- 
-   plot(sqrt(ls),cmp,col);
-   hold on;
-   plot([1 sqrt(lmax)],[0 0],':k');
-   ylabel('{\Delta C_l / C_l} (TT)');
-   xlabel(l_label);
-   set(gca,'XLim',[1 sqrt(lmax)]);
- ticks = [2 10 40 100 200 400 700 1000 1500];
- set(gca,'XTick',sqrt(ticks));
- set(gca,'XTickLabel',ticks);
- 
-   hold on;
- end
- 
- h=true;
- end;
- 
- seth(hin);
- % print -dpsc2 plotcls.ps;
- 
- 
- 
- function seth(h)
- 
- if h
-  hold on
- else
-  hold off
- end
- 
- function setaxes(a,b,c,d)
- global l_label
- 
- set(gca,'YLim',[a,b],'XLim',[c,d]);
- xlabel(l_label);ylabel('l(l+1) C_l / 2\pi');
\ No newline at end of file
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/power_tilt.f90 cosmomc_sampler/camb/power_tilt.f90
*** cosmomc/camb/power_tilt.f90	2008-03-13 15:40:20.000000000 +0100
--- cosmomc_sampler/camb/power_tilt.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,216 ****
- !This module provides the initial power spectra, parameterized as an expansion in ln k
- !
- ! ln P = ln A_s + (n_s -1)*ln(k/k_0) + n_{run}/2 * ln(k/k_0)^2 
- !
- ! so if n_run = 0
- !
- ! P = A_s (k/k_0_scalar)^(n_s-1)
- !
- !for the scalar spectrum, when an(in) is the in'th spectral index. k_0_scalar
- !is a pivot scale, fixed here to 0.05/Mpc (change it below as desired).
- !
- !This module uses the same inputs an(in), ant(in) and rat(in) as CMBFAST, however here
- !rat(in) is used to set the ratio of the initial power spectra, so here
- !
- !** rat(in) is not the Cl quadrupole ratio ***
- !
- !in general models the quadrupole ratio depends in a complicated way on the ratio of the initial
- !power spectra
- 
- !The absolute normalization of the Cls is unimportant here, but the relative ratio
- !of the tensor and scalar Cls generated with this module will be correct for general models
- 
- 
- !The OutputNormalization parameter controls the final output
- !Absolute Cls can be obtained by setting OuputNormalization=outNone, otherwise the overall normalization
- !of the power spectra doesn't matter
- 
- !This version December 2003 - changed default tensor pivot to 0.05 (consistent with CMBFAST 4.5)
- 
-      module InitialPower   
-      use Precision
-      implicit none   
- 
-      private
-     
-       character(LEN=*), parameter :: Power_Name = 'power_tilt'
- 
-       integer, parameter :: nnmax= 5 
-        !Maximum possible number of different power spectra to use
- 
-       Type InitialPowerParams
- 
-        integer nn  !Must have this variable
-       !The actual number of power spectra to use
-   
-       !For the default implementation return power spectra based on spectral indices
-        real(dl) an(nnmax) !scalar spectral indices
-        real(dl) n_run(nnmax) !running of spectral index 
-        real(dl) ant(nnmax) !tensor spectral indices
-        real(dl) rat(nnmax) !ratio of scalar to tensor initial power spectrum amplitudes
-        real(dl) k_0_scalar, k_0_tensor
-        real(dl) ScalarPowerAmp(nnmax)
-  
-       end Type InitialPowerParams
- 
-       real(dl) curv  !Curvature contant, set in InitializePowers     
-       
-       Type(InitialPowerParams) :: P
-   
- !Make things visible as neccessary...
-  
-       public InitialPowerParams, InitialPower_ReadParams, InitializePowers, ScalarPower, TensorPower
-       public nnmax,Power_Descript, Power_Name, SetDefPowerParams
- !      public 
-     contains
-        
-   
-        subroutine SetDefPowerParams(AP)
-         Type (InitialPowerParams) :: AP
- 
-          AP%nn     = 1 !number of initial power spectra
-          AP%an     = 1 !scalar spectral index
-          AP%n_run   = 0 !running of scalar spectral index
-          AP%ant    = 0 !tensor spectra index
-          AP%rat    = 1
-          AP%k_0_scalar = 0.05
-          AP%k_0_tensor = 0.05
-          AP%ScalarPowerAmp = 1
- 
-        end subroutine SetDefPowerParams
- 
-        subroutine InitializePowers(AParamSet,acurv)
-          Type (InitialPowerParams) :: AParamSet
-          !Called before computing final Cls in cmbmain.f90
-          !Could read spectra from disk here, do other processing, etc.
- 
-         real(dl) acurv
- 
-         if (AParamSet%nn > nnmax) then
-            write (*,*) 'To use ',AParamSet%nn,'power spectra you need to increase'
-            write (*,*) 'nnmax in power_tilt.f90, currently ',nnmax
-         end if
-         P = AParamSet
- 
-         curv=acurv         
- 
- !Write implementation specific code here...
- 
-        end subroutine InitializePowers
-        
- 
-       function ScalarPower(k,in)
- 
-        !"in" gives the index of the power to return for this k
-        !ScalarPower = const for scale invariant spectrum
-        !The normalization is defined so that for adiabatic perturbations the gradient of the 3-Ricci 
-        !scalar on co-moving hypersurfaces receives power
-        ! < |D_a R^{(3)}|^2 > = int dk/k 16 k^6/S^6 (1-3K/k^2)^2 ScalarPower(k) 
-        !In other words ScalarPower is the power spectrum of the conserved curvature perturbation given by
-        !-chi = \Phi + 2/3*\Omega^{-1} \frac{H^{-1}\Phi' - \Psi}{1+w}
-        !(w=p/\rho), so < |\chi(x)|^2 > = \int dk/k ScalarPower(k).
-        !Near the end of inflation chi is equal to 3/2 Psi.
-        !Here nu^2 = (k^2 + curv)/|curv| 
- 
-        !This power spectrum is also used for isocurvature modes where 
-        !< |\Delta(x)|^2 > = \int dk/k ScalarPower(k)
-        !For the isocurvture velocity mode ScalarPower is the power in the neutrino heat flux.
- 
-         real(dl) ScalarPower,k, lnrat
-         integer in
- 
-           lnrat = log(k/P%k_0_scalar)
-           ScalarPower=P%ScalarPowerAmp(in)*exp((P%an(in)-1)*lnrat + P%n_run(in)/2*lnrat**2)   
-  
-       end function ScalarPower
- 
-       
-       function TensorPower(k,in)
-       
-        !TensorPower= const for scale invariant spectrum
-        !The normalization is defined so that
-        ! < h_{ij}(x) h^{ij}(x) > = \sum_nu nu /(nu^2-1) (nu^2-4)/nu^2 TensorPower(k)
-        !for a closed model
-        ! < h_{ij}(x) h^{ij}(x) > = int d nu /(nu^2+1) (nu^2+4)/nu^2 TensorPower(k)
-        !for an open model
-        !"in" gives the index of the power spectrum to return 
-        !Here nu^2 = (k^2 + 3*curv)/|curv| 
- 
- 
-         real(dl) TensorPower,k   
-         real(dl), parameter :: PiByTwo=3.14159265d0/2._dl
-    
-         integer in
- 
-         TensorPower=P%rat(in)*P%ScalarPowerAmp(in)*exp(P%ant(in)*log(k/P%k_0_tensor))
-         if (curv < 0) TensorPower=TensorPower*tanh(PiByTwo*sqrt(-k**2/curv-3)) 
- 
-        
-       end function TensorPower
- 
-       !Get parameters describing parameterisation (for FITS file)
-      function Power_Descript(in, Scal, Tens, Keys, Vals)
-          character(LEN=8), intent(out) :: Keys(*)
-          real(dl), intent(out) :: Vals(*)
-          integer, intent(IN) :: in
-          logical, intent(IN) :: Scal, Tens
-          integer num, Power_Descript
-          num=0
-          if (Scal) then
-          num=num+1
-          Keys(num) = 'n_s'
-          Vals(num) = P%an(in)
-          num=num+1
-          Keys(num) = 'n_run'
-          Vals(num) = P%n_run(in)
-          num=num+1
-          Keys(num) = 's_pivot'
-          Vals(num) = P%k_0_scalar
-          end if
-          if (Tens) then
-          num=num+1
-          Keys(num) = 'n_t'
-          Vals(num) = P%ant(in)
-          num=num+1
-          Keys(num) = 't_pivot'
-          Vals(num) = P%k_0_tensor
-          if (Scal) then
-            num=num+1
-            Keys(num) = 'p_ratio'
-            Vals(num) = P%rat(in)
-          end if
-          end if
-          Power_Descript = num
- 
-        end  function Power_Descript
-         
-        subroutine InitialPower_ReadParams(InitPower, Ini, WantTensors)
-           use IniFile
-           Type(InitialPowerParams) :: InitPower
-           Type(TIniFile) :: Ini
-           logical, intent(in) :: WantTensors
-           integer i
-           
-            InitPower%k_0_scalar = Ini_Read_Double_File(Ini,'pivot_scalar',InitPower%k_0_scalar)
-            InitPower%k_0_tensor = Ini_Read_Double_File(Ini,'pivot_tensor',InitPower%k_0_tensor) 
-            InitPower%nn = Ini_Read_Int('initial_power_num')
-            if (InitPower%nn>nnmax) stop 'Too many initial power spectra - increase nnmax in InitialPower'
-            InitPower%rat(:) = 1
-            do i=1, InitPower%nn
- 
-               InitPower%an(i) = Ini_Read_Double_Array_File(Ini,'scalar_spectral_index', i)
-               InitPower%n_run(i) = Ini_Read_Double_Array_File(Ini,'scalar_nrun',i,0._dl) 
-               
-               if (WantTensors) then
-                  InitPower%ant(i) = Ini_Read_Double_Array_File(Ini,'tensor_spectral_index',i)
-                  InitPower%rat(i) = Ini_Read_Double_Array_File(Ini,'initial_ratio',i)
-               end if              
- 
-               InitPower%ScalarPowerAmp(i) = Ini_Read_Double_Array_File(Ini,'scalar_amp',i,1._dl) 
-               !Always need this as may want to set tensor amplitude even if scalars not computed
-            end do
-           
-        end  subroutine InitialPower_ReadParams 
- 
- 
-      end module InitialPower
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/readme.html cosmomc_sampler/camb/readme.html
*** cosmomc/camb/readme.html	2009-08-12 17:13:35.000000000 +0200
--- cosmomc_sampler/camb/readme.html	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,645 ****
- <HTML>
- <HEAD>
- <TITLE>CAMB ReadMe</TITLE>
- </HEAD>
- <BODY BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">
- <BODY>
- <CENTER>
- <A HREF="#compiling">Compiling</A> - <A HREF="#outputs">Outputs</A>- <A HREF="#version">History</A> - <A HREF="#COMPARE">Comparison</A> - <A HREF="#FILES">Source files</A> - <A HREF="#ACCURACY">Accuracy</A> -
-  <A HREF="#adds">Add-ons</A> - <A HREF="#refs">References</A>
- </CENTER>
- <FONT FACE="Arial,Helvetica" SIZE=2>
- <H2>CAMB ReadMe</H2>
- Code for Anisotropies in the Microwave Background by <A
- HREF="http://cosmologist.info/">Antony Lewis</A> and Anthony
- Challinor. <P>
- This version February 2009.
- <P>
- <FONT SIZE=-1>
- Originally based on CMBFAST developed by Uros Seljak and Matias
- Zaldarriaga, itself based on Boltzmann code written by
- Edmund Bertschinger, Chung-Pei Ma and Paul Bode.
- For information on CMBFAST see <A HREF="http://cfa-www.harvard.edu/~mzaldarr/CMBFAST/cmbfast.html">http://cmbfast.org</A>.
- For latest information on this program see <A HREF="http://camb.info">camb.info</A>.
- </FONT>
- <P>
- CAMB is also supplied as part of the <A HREF="http://cosmologist.info/cosmomc/">CosmoMC</A> parameter estimation package. For an extension including perturbed recombination, 21cm, lensing and number count sources see <A HREF="http://camb.info/sources">CAMB sources</A>.
- <P>
- 
- <A NAME="compiling">
- <B>Compiling and running</B>
- </P>
- You will need a Fortran 90 (or higher) compiler - you can get free <A HREF="http://www.intel.com/software/products/compilers/downloads/forlin.htm" TARGET="_blank">Intel Linux</A>, <A HREF="http://g95.sourceforge.net/">G95</A> or <A HREF="http://gcc.gnu.org/wiki/GFortran">GFortran</A> compilers.
- <UL>
- <LI><A HREF="http://camb.info/CAMBsubmit.html">Download</A> CAMB
- <LI>Unzip and untar the file (<B>tar xfv CAMB.tar.gz</B>). All files will be extracted to a
- directory called "CAMB".
- <LI>Run <B>make</B> to compile everything you will need. (you may need to
- edit the supplied Makefile, see below)
- <LI>Run <B>./camb params.ini</B>, where params.ini is a file
-  of parameter values (sample supplied). The params.ini file should be
-  fairly self-explanatory.
- </UL>
- </P>
- <P>
- The Makefile comes set up for Intel machines using ifc. Just comment the relevant parts to compile on different systems. If you have Compaq Visual Fortran you can open the supplied .dsp project file, no need to use the Makefile (currently Intel Visual Fortran is not recommended). To run on multi-processor machines add the -openmp (or equivalent) option to the Makefile's FFLAGS parameter to compile a parallelized (OPENMP) version.
- </P>
- <P>
- You can also edit the Makefile's EQUATIONS and POWERSPECTRUM
-  variables. The POWERSPECTRUM.f90  file contains a module giving the initial
-  power spectrum, the EQUATIONS.f90 file contains the background evolution
-  equations and sets of gauge-dependent perturbation
-  equations. To avoid problems run <B>make clean</B> after changing the
-  Makefile before recompiling.
- </P>
- <P>
- You can produce files in  <A
- HREF="http://heasarc.gsfc.nasa.gov/docs/software/fitsio/fitsio.html">FITS</A>
-  format - to do this you will need to have <A
- HREF="http://www.eso.org/science/healpix/">HEALPIX</A> installed and make
-  some edits to the Makefile - see the Makefile for details. After compiling with <B>make camb_fits</B>,
-  you can then use <B>camb_fits</B> instead of <B>camb</B> - the FITS file
-  produced is given the name specified in params.ini. Note that the FITS file format for polarization changed with HEALPIX 1.2, CAMB uses the new format.
- </P>
- <P>
- All the equations that need to be modified for
- simple non-standard models are in the equations.f90 file.  It should be possible to produce other files
- for extended models (see the sample <A
- HREF="http://camb.info/extra.html">quintessence</A> module). (Note that varying
- constant - e.g. alpha -  models are not quite so simple to plug in).
- <P>
- After modifying any of the source code run <B>make clean</B> before running <B>make</B> to recompile (Visual Fortran will re-compile dependent code automatically).
- Run <B>make all</B> to build a library libcamb.a that you can use when
- linking to other programs. (You will also need to include the module files using -I/cambfolder).
- <P>
- As of November 2004 the supplied sample params.ini file produces results in &mu;K<sup>2</sup> from the given primordial curvature perturbation power (<B>scalar_amp</B>) on 0.05 MPc<sup>-1</sup> scales. To get unnormalized dimensionless results set <B>scalar_amp(1)=1</B> and <B>CMB_outputscale=1</B> (as in previous CAMB versions). To compute lensed C<sub>l</sub>s you must set the normalization to some realistic value (the calculation is non-linear, so normalization matters).
- <P>
- You can <A HREF="http://camb.info/test_suite.tar.gz">download</A> a test suite for comparing accuracy with different parameters and code versions. Just extract the file to your CAMB directory and read the readme.
- 
- <P>
- <A NAME="outputs">
- <H3>Outputs</H3>
- Unlensed scalar angular power spectra are output to <b>output_root</b>_scalCls.dat. The columns are
- <BLOCKQUOTE>
- l C<sub>TT</sub> C<sub>EE</sub> C<sub>TE</sub> [C<sub>&Phi;</sub> C<sub>&Phi;T</sub>]
- </BLOCKQUOTE>
- Here all C<sub>X</sub> are l(l+1)C_l/2pi except for C<sub>&Phi;</sub> and C<sub>&Phi;T</sub> which are C<sub>&Phi;</sub>= l<sup>4</sup> C<sub>l</sub><sup>&Phi</sup>, where  C<sub>l</sub><sup>&Phi</sup> is the (CMB) lensing potential power spectrum, and C<sub>&Phi;T</sub> = l<sup>3</sup> C<sub>l</sub><sup>&Phi;T</sup>. The lensing terms in square brackets are only produced if <b>do_lensing = T</b>. If <b>CMB_outputscale = 7.4311e12</B> ([T<sub>CMB</sub>10<sup>6</sup>]<sup>2</sup>, the default), the units are &mu;K<sup>2</sup>. Note that lensing spectra are also multiplied by CMB_outputscale, so you may want to divide this out of the answer to get a sensible dimensionless spectrum. If requested the lensed power spectrum is output to <b>output_root</b>_lensedCls.dat
- <P>
- Tensor  angular power spectra are output to <b>output_root</b>_tensCls.dat if requested. 
- The columns are
- <BLOCKQUOTE>
- l C<sub>TT</sub> C<sub>EE</sub> C<sub>BB</sub>  C<sub>TE</sub>  
- </BLOCKQUOTE>
- If scalars and tensors are generated, the total spectrum is in <b>output_root</b>_totCls.dat, in the same format as the tensor output file.
- <P>
- If transfer functions are requested the columns in the <b>output_root</b>_transfer_out.dat output file are
- <BLOCKQUOTE>
- k/h Delta_CDM/k<sup>2</sup> Delta_b/k<sup>2</sup> Delta_g/k<sup>2</sup> Delata_r/k<sup>2</sup> Delta_nu/k<sup>2</sup> Delta_tot/k<sup>2</sup>
- </BLOCKQUOTE>
- where all quantities are in the synchronous gauge and evaluated at the requested redshift, given a unit primordial curvature perturbation on superhorizon scales (for adiabatic modes, chi_0=-1). Here subscripts refer to CDM, baryon, photon, massless neutrino, massive neutrinos, and total (massive) respectively. <b>output_root</b>_matterpower.dat contains the conventionally normalized matter power spectrum (for baryons+cdm+massive neutrinos), in h/Mpc units.
- 
- <P>
- <A NAME="version">
- <H3>Version History</H3>
- 
- <B>February 2009</B><BR>
- Fixed serious bug in the calculation of lensed non-flat models (introduced in the Feb 2008 version).
- <P>
- 
- <B>November 2008</B><BR>
- Fixed proton mass error (and hence incorrect baryon evolution on pressure-damping scales; note CAMB is not as accurate as <A HREF="http://camb.info/sources/">CAMB sources</A> anyway due to use of adiabatic pressure).
- 
- <P>
- <B>September 2008</B><BR>
- Restructured recombination module to allow use of different models. RECFAST default implementation updated to version 1.4.2 (+fixes, tiny change to results). Misc minor changes.
- </P>
- <B>June 2008</B><BR>
- Fixed significant bug affecting very closed models (introduced Feb 2008; slightly closed models were fine).
- <P>
- <B>March 2008</B><BR>
- <I>(26th March, fixed pivot parameters in sample .ini)</I><BR>
- New reionization history model: new input parameter <B>re_delta_redshift</B> (does not change optical depth), and option to set <B>re_ionization_frac=-1</B> to automatically set the reionization fraction from input Y<sub>He</sub> assuming Helium is singly reionized at the same time as hydrogen (hence mapping of redshift to optical depth different to before at 10% level; see the <A HREF="http://cosmologist.info/notes/CAMB.pdf">notes</A>).  Reionization history now specified in (replaceable) module in reionization.f90; default includes tiny effect of He double reionization at z~3.5. Some internal reorganization.
- Added <B>pivot_scalar</B> and <B>pivot_tensor</B> input parameters for initial power spectrum. <b>output</b> subroutine (equations.f90) re-arranged to separated ISW source terms.
- <P>
- <B>February 2008</B><BR>
- Updated RECFAST to version 1.4 (~0.5% effect at high <I>l</I>; new RECFAST_fudge_He,RECFAST_Heswitch parameters, removed Dubrovich modifications). <B>lensed_total_output_file</b> parameter to get lensed scalar plus tensor power spectrum. Calculates CosmoMC's theta parameter for each model (code in modules.f90). Modules routine <B>MatterPowerData_Load</B> to read in matter power (for splining from pre-computed file); <B>MatterPowerData_k</B> function now extrapolates low-k out of range. <B>transfer_interp_matterpower</B> parameter to switch between interpolated regular grid in log k or array at actual computed values (better for later re-interpolation). Added camb.vfproj Intel Visual Fortran project file. Simplifying internal changes from <A HREF="http://camb.info/sources">CAMB sources</A>, e.g. use of Ranges module for setting time steps and k sampling values; also now switches to log k source spacing at very high l to speed up calculation where spectra smooth. More diagnostics and options in the  <A HREF="http://camb.info/test_suite.tar.gz">test suite</A>.
- <P>
- <B>November 2006</B><BR>
- Updated RECFAST to version 1.3 (0.1% effect on C<sub>l</sub>). Tweak to get &lt;0.3% error in matter power spectrum around the peak when <B>transfer_high_precision = T</B>.
- <P>
- <B>September 2006</B><BR>
- Fixed problem generating combinations of scalars and tensors in camb.f90 (since August version).
- <P>
- <B>August 2006</B><BR>
- Speeded calculation of lensed spectra and lensing power spectrum by using Limber approximation on small scales (no loss of accuracy). Fixed missing f_K in source term for non-flat lensing potential. Minor changes to default parameters and compatibility tweaks. Can <A HREF="http://camb.info/test_suite.tar.gz">download</A> test suite for comparing accuracy and code versions.
- <P>
- <B>July 2006</B><BR>
- Fixed bug setting default neutrino degeneracy if none specified and initialization of nu_mass_eigenstates for programmatic access. Other minor fixes.
- <P>
- <B>June 2006</B><BR>
- Added support for arbitrary neutrino mass splittings. New option to set <B>transfer_k_per_logint=0</B> to get automatic accurate k-sampling of the matter power spectrum. Fixed Transfer_GetMatterPower at large scales for non-flat models. New setting value <B>massive_nu_approx=3</B> to use whatever method is good to get fast accurate results. Other internal changes.
- <P>
- 
- <B>March 2006</B><BR>
- Fixed bug lensing scalar spectrum when generated at the same time as tensors. New (hard coded) parameter <B>lmin</B> in modules.f90 - set to 1 if you want to generate temperature and lensing potential l=1 (Newtonian Gauge) C<sub>l</sub>.
- <P>
- <B>April 2005</B><BR>
- Added <B>do_nonlinear</B> option to apply non-linear corrections from HALOFIT (<A HREF="http://arxiv.org/abs/astro-ph/0207664">astro-ph/0207664</A>). <B>do_nonlinear = 1</B> applies just to the matter power spectra, <B>do_nonlinear=2</B> applies corrections to the lensed CMB power spectra (important for BB). HALOFIT should only be used for standard adiabatic &Lambda;CDM models with power law initial power spectra.
- New <B>recombination</B> option (1 does RECFAST as before, 2 uses modified version from <a href="http://arxiv.org/abs/astro-ph/0501672">astro-ph/0501672</a>). New option <B>do_late_rad_trunction</B> to turn off the small scale radiation hierarchies after matter domination (see <A HREF="http://cosmocoffee.info/discuss/astro-ph/0503277">astro-ph/0503277</A> and the <A HREF="http://cosmologist.info/notes/CAMB.pdf">notes</A>) - saves some time. New <B>output_root</B> option to prefix output file names and generate output_root_params.ini file of input parameters for the run.
- <P>
- <B>November 2004</B><BR>
- Default lensing routine (<B>lensing_method=1</B>) changed to use new full-sky correlation function method (<A HREF="http://arxiv.org/abs/astro-ph/0502425">astro-ph/0502425</A>) in preference to the harmonic method of <A HREF="http://arxiv.org/abs/astro-ph/0001303">astro-ph/0001303</A> (<B>lensing_method=3</B>; inaccurate at l>1000 at ~1.5% level by l=2000). The lensed result is now significantly faster and more accurate.
- Also added flat-sky method (<B>lensing_method=2</B>) of <A HREF="http://arxiv.org/abs/astro-ph/9505109">astro-ph/9505109</A> and <A HREF="http://arxiv.org/abs/astro-ph/9803150">astro-ph/9803150</A> as in CMBFAST (accurate to 0.4%). New <B>accurate_BB</B> parameter to get lensed BB accurately (within assumptions of linearity and given k_max, l_max, etc.). Note lensed_output_file no longer contains any tensor contribution. Various changes for better accuracy and compiler compatibility, including same accuracy with massive neutrinos as with massless.
- <P>
- <B>August 2004</B><BR>
- Fixed effect of reionization on the lensed C<sub>l</sub> (0.5% on small scale TT).
- </P>
- <B>June 2004</B><BR>
- <P>
- Fixed serious problem with tensor mode polarized C<sub>l</sub> from reionization (significantly underestimated power).
- Changed default tensor pivot scale to 0.05 Mpc<sup>-1</sup> (same as for scalars). Flat Bessel functions no longer cached to disk (faster to compute than read in many cases; prevents problems in uses with MPI). New <B>accurate_reionization</B> flag for accurate calculation of large scale scalar EE around the first dip (also outputs computed optical depth due to reionization). Option to output vector mode spectra from regular vorticity mode (<A HREF="http://arxiv.org/abs/astro-ph/0403583">astro-ph/0403583</A>) or magnetic field (<A HREF="http://arxiv.org/abs/astro-ph/0406096">astro-ph/0406096</A>).
- </P>
- <B>December 2003</B><BR>
- <I>Fix - 17 Dec:</I> corrected problem with significantly non-flat models (e.g. &Omega;<sub>K</sub>=-0.1, H<sub>0</sub>=40)
- <P>
- Improved accuracy of non-flat calculation, and allowed for very nearly flat models (&Omega;<sub>K</sub> ~ 1e-5). Non-flat code should be as accurate as the flat (0.5%) on most scales. Added run-time parameters <B>do_tensor_neutrinos</B> (to include the neutrino evolution in the tensor equations) and <B>cs2_lam</B> (constant sound speed of the dark energy) instead of having to modify the code. Fixed fatal bug in tensor neutrino setup introduced some time this year. Added parameter <B>CMB_outputscale</B> to scale output Cls by a constant (see comments in params.ini for getting microK^2 output).
- </P>
- 
- <B>July 2003</B><BR>
- <P>
- Fixed instability in bessels.f90 which gave problem for very nearly flat closed models with abnormal Helium fractions (and possibly other models). Dark energy equations in equations.f90 changed to use simpler general fluid equations for the perturbations (see <A HREF="http://arxiv.org/abs/astro-ph/0307104">astro-ph/0307104</A>). inidriver.F90 now reads in scalar amplitude even if computing tensors only (so combination with the initial ratio sets correct tensor amplitude).
- </P>
- 
- <B>May 2003</B><BR>
- <P>
- Fixed bug in equations.f90 giving errors with non-flat models. Fixed bug in inidriver.F90 setting H<sub>0</sub> with <B>use_physical=F</B>. Fixed camb.f90 file in download - missing routines for getting C<sub>l</sub> transfer functions.
- </P>
- <B>April 2003</B><BR>
- <P>
- Some major restructuring, including new functions to return the CMB transfer functions (see camb.f90). The tight coupling code has been re-written, adding quadrupole terms and accounting for the time variation of the opacity numerically. The code should be more accurate and faster, especially on small scales. Minor fixes to RECFAST to match version in CMBFAST (0.01% effect on C<sub>l</sub>s), and bug fix in output routine (0.3%). Includes constant w dark energy and running spectral index parameters by default (rather than with an add-on). New <B>use_physical</B> parameter to allow alternative model specification by Om_b h^2, Om_b h^2 and Om_k. Polarization .fits files now compatible with HEALPIX 1.2.
- </P>
- 
- <B>November 2002</B>
- <P>
- Minor changes for greater compiler compatibility, in particular with Visual Fortran. Makefile includes suggested options for a variety of compilers.
- </P>
- 
- <B>September 2002</B>
- <P>
- Added support for neutrino isocurvature initial conditions, and
- totally correlated mixed initial conditions (assuming the same power
- spectrum for each mode) - new <B>initial_vector</B> parameter in
- params.ini. Partially correlated mixed initial conditions can be
- computed by combining results from different runs with totally
- correlated initial conditions.
- </P>
- 
- <B>July 2002</B>
- <P>
- Changes for compatibility with <A
- HREF="http://cosmologist.info/cosmomc/">CosmoMC</A>. New option to output matter power spectrum.
- Changed default pivot point for tensor initial power spectrum to
- 0.002 MPc<sup>-1</sup> (power_tilt.f90), added pivot point and normalization to
- initial power parameters. Minor enhancements to inifile.f90. Utility
- routines Re_OpticalDepthAtZ and Transfer_GetMatterPower added to
- modules.f90.
- </P>
- 
- <B>March 2002</B>
- <P>
- Massive neutrino support improved. Background evolution is much
- faster, and only ever needs to be computed once for all neutrino
- masses. Output transfer function files now include columns for the
- massive neutrino and total perturbations. Sigma_8 is now computed
- including CDM, baryons and massive neutrinos.  Fixed problem computing matter
- power spectrum in massive neutrino models. New parameter
- <B>massive_nu_approx</B> to control
- how the massive neutrinos are evolved - option for new approximate fast scheme
- that is quite accurate for the CMB. New <B>feedback_level</B> parameter
- that can be used to get useful information about the model being
- calculated.
- <BR>
- Fixed rare problem computing closed models, and bug in computation of
- closed transfer functions. The names of the massive neutrino
- subroutines have been changed because the argument that is passed has changed.
- </P>
- 
- <B>February 2002</B>
- <P>
- Fixed FITS file output to start at l=0 rather than l=2 to be consistent
- with HEALPIX.
- </P>
- <B>January 2002</B>
- <P>
- The code is now fully internally parallelized and lensing is
- supported. Can now use about 16 processors with good efficiency -
- just compile with the OpenMP -mp compiler flag. The lensing power
- spectrum is computed explicitly and then used to computed the lensed
- CMB power spectra using the full-sky results of  <A
- HREF="http://arxiv.org/abs/astro-ph/0001303">astro-ph/0001303</A> (many
- thanks for Gayoung Chon for work on the lensed power spectrum
- code). To generate the lensed power spectra set do_lensing=T in
- params.ini and the output will be in the lensed_output_file. The lensing power spectrum l<sup>4</sup> C<sub>l</sub><sup>&phi;&phi;</sup> is also output as the 5th
- column of the scalar_output_file, followed by the cross-correlation
- with the temperature l<sup>3</sup> C<sub>l</sub><sup>&phi;T</sup>.
- 
- </P>
- 
- <B>October 2001</B><P>
- Fixed bug in RECFAST - corrects C_l errors at 1-2% level. Background
- evolution is now determined from routines in gauge_inv.f90 (and
- gauge_sync.f90) - you now only need to edit these files to add
- additional matter components, use extended theories, etc. RECFAST now
- consistent with massive neutrinos.
- Added Makefile for better compilation, and added option to create FITS
- format power spectrum files. Changed driver.f90 to driver.F90, and new
- file writefits.f90. Some minor changes to ease use with a
- wider range of compilers (e.g. NaG F95 for Linux).
- <P>
- <B>May 2001</B><P>
- Fixed the neutrino ratio factor in the normalization of the scalar
- power spectrum to be consistent with the power spectrum as defined
- since the January 2001 version. Changes to gauge_inv.f90 and gauge_sync.f90.
- <P>
- <B>April 2001</B><P>
- New <A
- HREF="http://camb.info/examples.html">example
- code</A>. These samples show how you can call CAMB from other programs
- via a subroutine. There are also improved InitialPower
- modules for parameterizing the initial power spectrum to obtain
- meaningful tensor/scalar ratios for general models and for
- parameterizing in terms of slow-roll inflation parameters.<P>
- 
- Fixed a floating error arising when both tensor and scalar spectra are generated but
- with ratio zero.
- <P>
- 
- <B>February 2001</B><P>
- Fixed bug in recfast.f90 introduced in August 2000 update (caused
- erroneous blip in ionization history).<P>
- 
- 
- <B>January 2001</B><P>
- New file power.f90 added to separate out the InitialPower module for
- easily modifying the initial power spectrum. The InitialPower module now has
- additional parameters to control the normalization of the output Cls,
- allowing absolute computations using correctly normalized initial
- power spectra (set the UseScalTensRatio parameter to false to compute the
- tensor/scalar ratio correctly from the initial power spectra in
- general models). The InitialPower module is now commented to fully
- explain the definition of the power spectra that should be returned by the TensorPower and
- ScalarPower routines. <P>
- The transfer functions are now output in terms of k rather than beta
- (nu*K) in non-flat models,
- and the way to compute the matter power spectrum from the transfer
- functions via d2norm is documented. The variables used to propagate
- the tensor modes in gauge_inv.f90 have been changed to be equivalent
- to the metric variables, improving stability when DoTensorNeutrinos=true.
- <P>
- <B>September 2000</B><P>
- Now uses an accurate approximation to propagate massive neutrino
- perturbations once no longer highly relativistic, speeding up
- computation by about a factor of two (gauge_inv routine only). All massive
- neutrino code is now
- re-organized into a module called MassiveNu in modules.f90. The massive
- neutrino equations are described in  <A
- HREF="http://arxiv.org/abs/astro-ph/0203507">astro-ph/0203507</A>
-  <P>
- 
- <B>August 2000</B><P>
- Minor changes to recfast.f90 and modules.f90 to prevent floating
- point errors on some systems. (Thanks for Louise Griffiths)<P>
- 
- <B>July 2000</B><P>
- Fixes inaccurate computation of the tensor quadrupole in flat
- models, pointed out in <A
- HREF="http://arxiv.org/abs/astro-ph/0006392">astro-ph/0006392</A> . The only code change is to subroutine TensSourceSumIntJl in cmbmain.f90.<P>
- 
- <B>February 2000</B><P>
- Massive neutrinos are now supported. The treatment is essentially the
- same as CMBFAST. However gauge_inv now includes neutrino anisotropic
- stress in the tensor computation by default, accounting for massive neutrinos
- when appropriate. You can revert to the old default by changing the
- "DoTensorNeutrinos" parameter in gauge_inv.  <P>
- This version also fixes the tight coupling switch over to give
- accurate results with gauge_sync. This fixes errors introduced in
- CMBFAST 3.0/CAMB Nov 99.
- <P>
- <B>November 1999</B><P>
- Adds support for RECFAST recombination
- and fixes various bugs that were in CMBFAST 2.4.1 but fixed in CMBFAST
- 3.0. RECFAST is an option via the fifth line in the input file as in
- CMBFAST. Using it does not slow things down significantly and corrects
- errors at around the 2% level.
- 
- <A NAME="COMPARE">
- <H3>Comparison with CMBFAST</H3>
- This code was originally developed from CMBFAST 2.4.1 to support closed models
- and gauge invariant variables. After releasing this code CMBFAST 3.2
- was released which also supports closed models. These codes were
- developed independently and so are somewhat different, and both codes
- have developed independently since then.
- <P>
- The main differences in the non-flat computation lie in how we perform the integral of the source
- functions with the hyperspherical Bessel functions. We use
- Kosowsky's WKB approximation or the recursion relation to evaluate the Bessel
- functions at the starting point of ranges of integration, and then
- integrate the differential equation. CMBFAST
- integrates up the differential equation from a pre-calculated starting point. Unlike
- CMBFAST 3.2 our ranges of integration continue into the Chi > pi/2
- region for closed models. We avoid problems with stability of the
- integration (contamination with the irregular solution) by cutting off
- the integration when the errors become important (where the values in the
- dissipative tail are becoming small). This leads to very small errors,
- and allows for a much simpler scheme than that used in CMBFAST 3.2 where
- the symmetry of the Bessel functions is used to extend to the Chi> Pi/2 region.
- <P>
- From the user's point of view the main point is that this code is
- rather faster than CMBFAST in many cases. Assuming same recombination history CAMB agrees with the CMBFAST 4.5 high precision TT calculation to < 1% at low l, and about 0.3% at l>100 in concordance flat models. If CAMB is run with high precision options the agreement is nearly 0.1% at high l. The polarized spectra also agree well except around the first dip in the EE spectrum with reionization (see CAMB's accurate_reionization parameter).
- <P>
- Note that as of March 2008 CAMB's reionization parameterization is slightly different to CMBFAST. CMBFAST 4.5.1 also uses an old version of RECFAST.
- <P>
- CMBFAST 3.2 introduced an include file for adjusting the
- l-sampling. In CAMB this is done automatically depending on the model,
- so there is no need to modify the l-sampling by hand.
- <P>
- CMBFAST uses the flat sky and Limber approximation and works from the transfer
- functions to work out the lensing potential, CAMB uses the full result (agreement is excellent). CAMB uses a full-sky correlation function method rather than the flat sky approx (about max 0.4% effect on EE).
- <P>
- CMBFAST 4 uses a "k-splitting" to allow rapid computation of grids of
- models to reasonable accuracy. If you need to generate a large number
- of models and accuracy is not vital using CMBFAST 4 would probably
- save you some time and effort. CMBFAST 4 also supports some extended models not supported by CAMB, e.g. 5-D models.
- <P>
- CAMB is in Fortran 90 and is more modularized, so using different initial power spectra, modified equations, etc. is often just a case of modifying one or two files and re-compiling.
- <P>
- Note that the conventions for the polarization power spectra output by CAMB agree with those of CMBFAST. This sign convention for the cross-correlation C_l^TE spectrum differs from the definitions in <A
- HREF="http://arxiv.org/abs/astro-ph/9911481">astro-ph/9911481</A>. As from CMBFAST 4.2 the initial power spectrum normalization conventions also agree.
- <P>
- 
- <A NAME="FILES">
- <H3>The source files</H3>
- <P>
- <BLOCKQUOTE>
- <B>camb.f90</B>
- <P>
- Main wrapper routines for running CAMB in your programs. Add "use
- camb" to your programs and call CAMB_GetResults to generate output
- from a set of model parameters (specified in the CAMBparams type -
- defined at the top of modules.f90). You can call
- CAMB_ValidateParams(P) to check that the parameter set is valid, use
- CAMB_GetAge to compute the age of a model in gigayears, and
- CAMB_GetCls to retrieve the computed Cls. The results can also be
- accessed directly using the arrays in the ModelData module (defined in modules.f90).<P>
- Sample programs tester.f90 and sigma8.f90 are supplied showing how to
- use CAMB from your own programs. You can also use CAMB_GetTransfers to access the C_l transfer functions directly without incorporating the initial power spectrum.
- </P>
- <B>cmbmain.f90</B>
- <P>
- The main subroutine that does integrations, etc. Encompasses CMBFAST's
- cmbflat and cmbopen.
- <P>
- <B>equations.f90</B>
- <P>
- Files containing background and perturbation evolution equations. The
- perturbations equations used are derived in the covariant approach,
- fixing to the CDM (zero acceleration) frame, which are essentially
- equivalent to the synchronous gauge equations.
- <P>
-    The file defines a module called &quot;GaugeInterface&quot; which provides
-    the necessary perturbation calculation routines for
-    &quot;cmbmain&quot;.
- <P>
-    The subroutine dtauda(a) returns dt/da and is used wherever the
-    background evolution is needed. It
-    can be modified for different backgrounds. You may
-    also need to change the GetOmegak routine if you add additional
-    components, and can edit the init_background routine to do
-    additional initialization.
-     <P>
-    outtransf writes out the matter transfer functions.
- <P>
-    The "output" subroutine computes the scalar sources at a given time for a
-    given wavenumber. These are the temperature, E polarization and (if
-    doing lensing) the lensing source. By editing the equation for the
-    lensing source it should be straightforward to compute power
-    spectra for other matter tracers, e.g. for cross-correlation with
-    the CMB. The lensing power spectrum is automatically computed if
-    <B>DoLensing=T</B>.
- 
- <P>
- <B> power_tilt.f90</B>
- <P>
- This file defines a module called InitialPower that returns the
- initial power spectra. Change this file to use your own initial power
- spectrum, change how the spectra are parameterized, or to change how
- the Cls are normalized. Comments in the code explain this further.
- <P>
- 
- <P>
- <B> reionization.f90</B>
- <P>
- This file defines a module called Reionization that parameterizes the reionization history and supplies a function <B>Reionization_xe</B> that gives x<sub>e</sub> as a function of redshift. Optical depth input parameters are mapped into z<sub>re</sub> (defined as where x<sub>e</sub> is half its maximum (ex second He reionization)) using a binary search. See the CAMB <A HREF="http://cosmologist.info/notes/CAMB.pdf">notes</A> for discussion. This module should be easily modifiable for alternative reionization models.
- <P>
- <B>halofit.f90</B><P>
- Implements the NonLinear module, to calculate non linear scalings of the matter power spectrum as a function of redshift. Uses HALOFIT (<A HREF="http://arxiv.org/abs/astro-ph/0207664">astro-ph/0207664</A>, code thanks to <A HREF="http://www.astro.upenn.edu/~res">Robert Smith</A>. Note this is only reliable at the several percent level for standard &Lambda;CDM models with power law initial power spectra. This module can be replaced to use a different non-linear fitting method.
- 
- 
- <P>
- 
-  <B> inidriver.F90</B>
- <P>
-     Reads in parameters from a file of name/value pairs and calls CAMB. Modify
-     this file to generate grids of models, change the parameterization, etc.
- 
- <P>
-  <B> modules.f90</B>
- <P>
-    Various modules used by the other parts of the program, Module
-    &quot;ModelParams&quot; contains most of the model parameters. Boolean vars
-    flat, open and closed determine the model type.
- <P>
- 
-  <B>bessels.f90</B>
- <P>
-    Module to calculate spherical and hyper-spherical Bessel
-    functions. Hyper-spherical functions generated by use of
-    either the recursion relation or Kosowsky's WKB approximation. Based on
-    Arthur Kosowsky's &quot;hyperjl.c&quot;.
- <P>
- 
- <B>lensing.f90</B>
- <P>
-   Lensing module for computing the lensed CMB power spectra from the
-   unlensed spectra and a lensing power spectrum. See <A HREF="http://arxiv.org/abs/astro-ph/0502425">astro-ph/0502425</A>.
- </P>
- 
-  <B> subroutines.f90</B>
- <P>
-    Various subroutines for interpolation, and modified Runge-Kutta
-    dverk for parallelized evolution.
- <P>
- <B> writefits.f90</B>
- <P>
-  Subroutine WriteFitsCls that uses HEALPIX routines to output power spectrum
-  in FITS format.
-  <P>
- <B>recfast.f90</B>
- <P>
-  RECFAST integrator for Cosmic Recombination of Hydrogen and Helium
-  by Douglas Scott (with minor modifications for CMBFAST and the
-  CAMB). See <A
-  HREF="http://www.astro.ubc.ca/people/scott/recfast.html">RECFAST</A>
-  for the original code. This module implements the RECOMBINATION module required by CAMB, and could be replaced by other models.
- </BLOCKQUOTE>
- <P>
- <A NAME="ACCURACY">
- <H3>Accuracy</H3>
- <P>
- <BLOCKQUOTE>
- Scalar errors should rarely exceed 0.3% for min(2500, l well into the damping tail) at default accuracy setting. See also <A HREF="#COMPARE">comparison</A> with CMBFAST. Accuracy of course assumes the model is correct, and is dependent on RECFAST being the correct ionization history; there are currently uncertainties in hydrogen recombination that may give errors around 1% at high l. Lensed C_l TT, TE and EE are accurate at the same level if l_max and k_max are set large enough (to within the approximation that the lensing potential is linear, or the accuracy of the the HALOFIT non-linear model).
- <P>
-  Extreme models (e.g. scale &gt; 4, h&gt;1) may give errors of 5% or more.
- <P>
-  Tensor errors around 2% or more on small scales (e.g. due to l-interpolation). Low l accuracy somewhat worse than scalars (typically < 1%).
- <P>
-  Hierarchy truncation errors up to 5% at high l (&gt;1500) in some
-    closed models
- <P>
-  You can improve or check accuracy (or increase speed) by changing
-    global accuracy parameters at the bottom of the params.ini input file. Convergence and stability can be checked using the <A HREF="http://camb.info/test_suite.tar.gz">test suite</A>.
- <P>
- </BLOCKQUOTE>
- 
- 
- 
- <A NAME="adds">
- <H3>Add-ons, extensions, external sites</H3>
- <UL>
- <LI><A HREF="http://background.uchicago.edu/camb_rpc/">Reionization principal components</a>
- <LI><A HREF="http://camb.info/ppf/">Parameterized Post-Friedmann Dark Energy</A>
- <LI><A HREF="http://camb.info/sources">CAMB sources</A> get linear 21cm, lensing and number counts; 3rd order perturbation theory P(k); perturbed recombination
- <LI><A HREF="http://camb.info/extra.html">Quintessence</A> module
- <LI><A HREF="http://lambda.gsfc.nasa.gov/toolbox/tb_camb_form.cfm">CAMB online</A> (note may not be latest version)
- <LI><A HREF="http://astronomy.sussex.ac.uk/~sleach/inflation/camb_inflation.html">Inflationary parameterization</A> of initial power by Samuel Leach.
- </UL>
- 
- <A NAME="refs">
- <H3>REFERENCES</H3>
- <P>
- Some notes and relevant Maple derivations are given <A HREF="http://camb.info/theory.html">here</A> (see also the Appendix of <A HREF="http://arxiv.org/abs/astro-ph/0406096">astro-ph/0406096</A>). There is a  <A HREF="http://cosmologist.info/cosmomc/cosmomc.bib">BibTex</A> file of references (including <A HREF="http://cosmologist.info/cosmomc">CosmoMC</A>).
- </P>
- <P>
- Efficient computation of CMB anisotropies in closed FRW Models<BR>
- Antony Lewis, Anthony Challinor and Anthony Lasenby <A
- HREF="http://arxiv.org/abs/astro-ph/9911177">astro-ph/9911177</A> Ap. J. 538:473-476, 2000.
- <P>
- Geometric Algebra and
- Covariant Methods in Physics and Cosmology, Chapters 6&7<BR>
- PhD thesis, Antony Lewis 2000.  <A
- HREF="http://antonylewis.com/thesis.ps.gz">PostScript</A>.
- <P>
- <B>Covariant theory</B>
- <P>
-  Cosmic Microwave Background Anisotropies in the CDM model: A
-  Covariant and Gauge-Invariant Approach<BR>
-  Anthony Challinor and Anthony Lasenby, <A HREF="http://arxiv.org/abs/astro-ph/9804301">astro-ph/9804301</A>
-  Ap. J. 513:1 1-22, 1999
- <P>Evolution of cosmological dark matter perturbations<BR>
- Antony Lewis and Anthony Challinor <A
- HREF="http://arxiv.org/abs/astro-ph/0203507">astro-ph/0203507</A>
- Phys. Rev. D66, 023531 (2002)
- 
- <P>
-  Microwave background anisotropies from gravitational waves: the 1+3
-  covariant approach <BR>
-  Anthony Challinor, <A HREF="http://arxiv.org/abs/astro-ph/9906474">astro-ph/9906474</A>
- <P>
- Microwave background polarization in cosmological models<BR>
- Anthony Challinor, <A
- HREF="http://arxiv.org/abs/astro-ph/9911481">astro-ph/9911481</A>
- <P>
- CMB anisotropies from primordial inhomogeneous magnetic fields<BR>
- Antony Lewis, <A
- HREF="http://arxiv.org/abs/astro-ph/0406096">astro-ph/0406096</A><BR>
- (The appendix contains general derivations of the multipole equations and C<SUB>l</SUB> as used in CAMB)
- <P>
- 
- <B>Initial conditions</B>
- <P>
-  The General Primordial Cosmic Perturbation <BR>
-  Martin Bucher, Kavilan Moodley and Neil Turok, <A HREF="http://arxiv.org/abs/astro-ph/9904231">astro-ph/9904231</A>
-  (These results extended to the non-flat case; see the <A HREF="http://camb.info/theory.html">theory page</A>)
- 
- <P>
- Observable primordial vector modes<BR>
- Antony Lewis, <A HREF="http://arxiv.org/abs/astro-ph/0403583">astro-ph/0403583</A>
- <P>
- <B>HALOFIT</B>
- <P>
- Stable clustering, the halo model and nonlinear cosmological power spectra<BR>
- Smith, R. E. and others,  <A HREF="http://arxiv.org/abs/astro-ph/0207664">astro-ph/0207664</A>
- <P>
- <B>RECOMBINATION</B>
- <P>
- A new calculation of the recombination epoch.<BR>
- Seager, S., Sasselov, D. & Scott, D., 1999, ApJ, 523, L1, <A HREF="http://arxiv.org/abs/astro-ph/9909275">astro-ph/9909275</A>.
- <P>
- How well do we understand cosmological recombination?<BR>
- Wong, Wan Yan and Moss, Adam and Scott, Douglas, <A HREF="http://cosmocoffee.info/discuss/0711.1357">arXiv:0711.1357</A>.
- <P>
- <B>Weak lensing of the CMB</B>
- <P>
- <BLOCKQUOTE>
- <B>lensing_method=1</B><BR>
- Lensed CMB power spectra from all-sky correlation functions<BR>
- A. Challinor and A. Lewis. <A HREF="http://arxiv.org/abs/astro-ph/0502425">astro-ph/0502425</A>. (For Maple derivations see the <A HREF="http://camb.info/theory.html">theory page</A>.)<BR>
- Also: Weak Lensing of the CMB, <A HREF="http://arxiv.org/abs/astro-ph/0601594">astro-ph/0601594</A>.
- 
- 
- <P>
- <B>lensing_method=2</B><BR>
- Gravitational lensing effect on cosmic microwave background
-                   anisotropies: A Power spectrum approach<BR>
- Uros Seljak. <A HREF="http://arxiv.org/abs/astro-ph/9505109">astro-ph/9505109</A>
- <P>
- Gravitational Lensing Effect on Cosmic Microwave Background
-                   Polarization<BR>
- Uros Seljak and Matias Zaldarriaga. <A HREF="http://arxiv.org/abs/astro-ph/9803150">astro-ph/9803150</A>
- <P>
- <B>lensing_method=3</B><BR>
- Weak Lensing of the CMB: A Harmonic Approach<BR>
- Wayne Hu. <A HREF="http://arxiv.org/abs/astro-ph/0001303">astro-ph/0001303</A><BR>
- See also <A HREF="http://arxiv.org/abs/astro-ph/0301064">astro-ph/0301064</A>, <A HREF="http://arxiv.org/abs/astro-ph/0301031">astro-ph/0301031</A>
- </P>
- </BLOCKQUOTE>
- 
- <B>Synchronous gauge theory and non-flat models</B>
- <P>
-  Complete treatment of CMB anisotropies in a FRW universe<BR>
-  Wayne Hu, Uros Seljak and Matias Zaldarriaga.
-  Phys. Rev. D57:6, 3290-3301, 1998. <A HREF="http://arxiv.org/abs/astro-ph/9709066">astro-ph/9709066</A>.
- <P>
- 
- <P>
- <B>WKB approx to hyperspherical Bessel functions</B>
- <P>
-  Efficient Computation of Hyperspherical Bessel Functions<BR>
-  Arthur Kosowsky, <A HREF="http://arxiv.org/abs/astro-ph/9805173">astro-ph/9805173</A>
- <P>
- 
- 
- <B>CMBFAST and the line of sight approach</B>
- <P>
-  A line of sight integration approach to Cosmic Microwave Background
-  Anisotropies<BR>
-  Uros Seljak and Matias Zaldarriaga, <A HREF="http://arxiv.org/abs/astro-ph/9603033">astro-ph/9603033</A>
-  Ap.J. 469:2 437-444, 1996
- <P>
- CMBFAST for spatially closed universes<BR>
- Uros Seljak and Matias Zaldariaga,  <A HREF="http://arxiv.org/abs/astro-ph/9911219">astro-ph/9911219</A>
- <P>
- See also the references on the CMBFAST <A HREF="http://cfa-www.harvard.edu/~mzaldarr/CMBFAST/cmbfast.html">home page</A>.
- </FONT>
- </BODY>
- </HTML>
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/recfast.f90 cosmomc_sampler/camb/recfast.f90
*** cosmomc/camb/recfast.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/recfast.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1252 ****
- !Recombination module for CAMB, using RECFAST
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !C Integrator for Cosmic Recombination of Hydrogen and Helium,
- !C developed by Douglas Scott (dscott@astro.ubc.ca)
- !C based on calculations in the paper Seager, Sasselov & Scott
- !C (ApJ, 523, L1, 1999).
- !and "fudge" updates in Wong, Moss & Scott (2008).
- !C
- !C Permission to use, copy, modify and distribute without fee or royalty at
- !C any tier, this software and its documentation, for any purpose and without
- !C fee or royalty is hereby granted, provided that you agree to comply with
- !C the following copyright notice and statements, including the disclaimer,
- !C and that the same appear on ALL copies of the software and documentation,
- !C including modifications that you make for internal use or for distribution:
- !C
- !C Copyright 1999-2008 by University of British Columbia.  All rights reserved.
- !C
- !C THIS SOFTWARE IS PROVIDED "AS IS", AND U.B.C. MAKES NO 
- !C REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.  
- !C BY WAY OF EXAMPLE, BUT NOT LIMITATION,
- !c U.B.C. MAKES NO REPRESENTATIONS OR WARRANTIES OF 
- !C MERCHANTABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE OR THAT 
- !C THE USE OF THE LICENSED SOFTWARE OR DOCUMENTATION WILL NOT INFRINGE 
- !C ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS.   
- !C
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !
- !CN     Name:        RECFAST
- !CV     Version: 1.4.2
- !C 
- !CP     Purpose:  Calculate ionised fraction as a function of redshift.
- !CP            Solves for H and He simultaneously, and includes
- !CP           H "fudge factor" for low z effect, as well as
- !CP           HeI fudge factor.
- !C
- !CD     Description: Solves for ionisation history since recombination
- !CD     using the equations in Seager, Sasselov & Scott (ApJ, 1999).
- !CD     The Cosmological model can be flat or open.
- !CD     The matter temperature is also followed.
- !CD     The values for \alpha_B for H are from Hummer (1994).
- !CD     The singlet HeI coefficient is a fit from the full code.
- !CD     Care is taken to use the most accurate constants.
- !C            
- !CA     Arguments:
- !CA     Name, Description
- !CA     real(dl) throughout
- !CA
- !CA     z is redshift - W is sqrt(1+z), like conformal time
- !CA     x is total ionised fraction, relative to H
- !CA     x_H is ionized fraction of H - y(1) in R-K routine
- !CA     x_He is ionized fraction of He - y(2) in R-K routine
- !CA       (note that x_He=n_He+/n_He here and not n_He+/n_H)
- !CA     Tmat is matter temperature - y(3) in R-K routine
- !CA     f's are the derivatives of the Y's
- !CA     alphaB is case B recombination rate
- !CA     alpHe is the singlet only HeII recombination rate
- !CA     a_PPB is Pequignot, Petitjean & Boisson fitting parameter for Hydrogen
- !CA     b_PPB is Pequignot, Petitjean & Boisson fitting parameter for Hydrogen
- !CA     c_PPB is Pequignot, Petitjean & Boisson fitting parameter for Hydrogen
- !CA     d_PPB is Pequignot, Petitjean & Boisson fitting parameter for Hydrogen
- !CA     a_VF is Verner and Ferland type fitting parameter for Helium
- !CA     b_VF is Verner and Ferland type fitting parameter for Helium
- !CA     T_0 is Verner and Ferland type fitting parameter for Helium
- !CA     T_1 is Verner and Ferland type fitting parameter for Helium
- !CA     Tnow is the observed CMB temperature today
- !CA     Yp is the primordial helium abundace
- !CA     fHe is He/H number ratio = Yp/4(1-Yp)
- !CA     Trad and Tmat are radiation and matter temperatures
- !CA	    epsilon is the approximate difference (=Trad-Tmat) at high z
- !CA     OmegaB is Omega in baryons today
- !CA     H is Hubble constant in units of 100 km/s/Mpc
- !CA     HO is Hubble constant in SI units
- !CA     bigH is 100 km/s/Mpc in SI units
- !CA	    Hz is the value of H at the specific z (in ION)
- !CA     G is grvitational constant
- !CA     n is number density of hydrogen
- !CA     Nnow is number density today
- !CA     x0 is initial ionized fraction
- !CA     x_H0 is initial ionized fraction of Hydrogen
- !CA     x_He0 is initial ionized fraction of Helium
- !CA     rhs is dummy for calculating x0
- !CA     zinitial and zfinal are starting and ending redshifts
- !CA     zeq is the redshift of matter-radiation equality
- !CA     zstart and zend are for each pass to the integrator
- !CA     C,k_B,h_P: speed of light, Boltzmann's and Planck's constants
- !CA     m_e,m_H: electron mass and mass of H atom in SI
- !CA     not4: ratio of 4He atomic mass to 1H atomic mass
- !CA     sigma: Thomson cross-section
- !CA     a_rad: radiation constant for u=aT^4
- !CA     Lambda: 2s-1s two photon rate for Hydrogen
- !CA     Lambda_He: 2s-1s two photon rate for Helium
- !CA     DeltaB: energy of first excited state from continuum = 3.4eV
- !CA     DeltaB_He: energy of first excited state from cont. for He = 3.4eV
- !CA     L_H_ion: level for H ionization in m^-1
- !CA     L_H_alpha: level for H Ly alpha in m^-1
- !CA     L_He1_ion: level for HeI ionization
- !CA     L_He2_ion: level for HeII ionization
- !CA     L_He_2s: level for HeI 2s
- !CA     L_He_2p: level for HeI 2p (21P1-11S0) in m^-1
- !CA     Lalpha: Ly alpha wavelength in SI
- !CA     Lalpha_He: Helium I 2p-1s wavelength in SI
- !CA     mu_H,mu_T: mass per H atom and mass per particle
- !CA     H_frac: follow Tmat when t_Compton / t_Hubble > H_frac
- !CA     CDB=DeltaB/k_B                     Constants derived from B1,B2,R
- !CA     CDB_He=DeltaB_He/k_B  n=2-infinity for He in Kelvin
- !CA     CB1=CDB*4.         Lalpha and sigma_Th, calculated
- !CA     CB1_He1: CB1 for HeI ionization potential
- !CA     CB1_He2: CB1 for HeII ionization potential
- !CA     CR=2*Pi*(m_e/h_P)*(k_B/h_P)  once and passed in a common block
- !CA     CK=Lalpha**3/(8.*Pi)
- !CA     CK_He=Lalpha_He**3/(8.*Pi)
- !CA     CL=C*h_P/(k_B*Lalpha)
- !CA     CL_He=C*h_P/(k_B*Lalpha_He)
- !CA     CT=(8./3.)*(sigma/(m_e*C))*a
- !CA     Bfact=exp((E_2p-E_2s)/kT)    Extra Boltzmann factor
- !CA b_He= "fudge factor" for HeI, to approximate higher z behaviour
- !CA Heswitch=integer for modifying HeI recombination
- !CA Parameters and quantities to describe the extra triplet states
- !CA  and also the continuum opacity of H, with a fitting function
- !CA  suggested by KIV, astro-ph/0703438
- !CA a_trip: used to fit HeI triplet recombination rate
- !CA b_trip: used to fit HeI triplet recombination rate
- !CA L_He_2Pt: level for 23P012-11S0 in m^-1
- !CA L_He_2St: level for 23S1-11S0 in m^-1
- !CA L_He2St_ion: level for 23S1-continuum in m^-1
- !CA A2P_s: Einstein A coefficient for He 21P1-11S0
- !CA A2P_t: Einstein A coefficient for He 23P1-11S0    
- !CA sigma_He_2Ps: H ionization x-section at HeI 21P1-11S0 freq. in m^2
- !CA sigma_He_2Pt: H ionization x-section at HeI 23P1-11S0 freq. in m^2
- !CA CL_PSt = h_P*C*(L_He_2Pt - L_He_2st)/k_B
- !CA CfHe_t: triplet statistical correction
- 
- !CA     tol: tolerance for the integrator
- !CA     cw(24),w(3,9): work space for DVERK
- !CA     Ndim: number of d.e.'s to solve (integer)
- !CA     Nz: number of output redshitf (integer)
- !CA     I: loop index (integer)
- !CA     ind,nw: work-space for DVERK (integer)
- !C
- !CF     File & device access:
- !CF     Unit /I,IO,O  /Name (if known)
- !C
- !CM     Modules called:
- !CM     DVERK (numerical integrator)
- !CM     GET_INIT (initial values for ionization fractions)
- !CM     ION (ionization and Temp derivatives)
- !C
- !CC     Comments:
- !CC     none
- !C
- !CH     History:
- !CH     CREATED            (simplest version) 19th March 1989
- !CH     RECREATED    11th January 1995
- !CH               includes variable Cosmology
- !CH               uses DVERK integrator
- !CH               initial conditions are Saha
- !CH     TESTED              a bunch, well, OK, not really
- !CH     MODIFIED     January 1995 (include Hummer's 1994 alpha table)
- !CH               January 1995 (include new value for 2s-1s rate)
- !CH               January 1995 (expand comments)
- !CH               March 1995 (add Saha for Helium)
- !CH               August 1997 (add HeII alpha table)
- !CH               July 1998 (include OmegaT correction and H fudge factor)
- !CH               Nov 1998 (change Trad to Tmat in Rup)
- !CH               Jan 1999 (tidied up for public consumption)
- !CH               Sept 1999 (switch to formula for alpha's, fix glitch)
- !CH                  Sept 1999 modified to CMBFAST by US & MZ          
- !CH                     Nov 1999 modified for F90 and CAMB (AML)
- !CH                     Aug 2000 modified to prevent overflow erorr in He_Boltz (AML)
- !CH                     Feb 2001 corrected fix of Aug 2000 (AML)
- !CH                     Oct 2001 fixed error in hubble parameter, now uses global function (AML)
- !                       March 2003 fixed bugs reported by savita gahlaut
- !                       March 2005 added option for corrections from astro-ph/0501672.
- !                                  thanks to V.K.Dubrovich, S.I.Grachev
- !                       June 2006 defined RECFAST_fudge as free parameter (AML)
- !                       October 2006 (included new value for G)
- !                       October 2006 (improved m_He/m_H to be "not4")
- !                       October 2006 (fixed error, x for x_H in part of f(1))
- !CH              January 2008 (improved HeI recombination effects,
- !CH                       including HeI rec. fudge factor)
- !                Feb 2008   Recfast 1.4 changes above added (AML)
- !                           removed Dubrovich option (wrong anyway)
- !CH   			 Sept 2008 (added extra term to make transition, smoother for Tmat evolution)
- !                Sept 2008 Recfast 1.4.2 changes above added (AML) 
- !                          General recombination module structure, fix to make He x_e smooth also in recfast (AML)
- 
- !!      ===============================================================
- 
-        module RECDATA
-         use constants
-         implicit none
-          
- 
-         real(dl) Lambda,DeltaB,DeltaB_He,Lalpha,mu_H,mu_T,H_frac
-         real(dl) Lambda_He,Lalpha_He,Bfact,CK_He,CL_He
-         real(dl) L_H_ion,L_H_alpha,L_He1_ion,L_He2_ion,L_He_2s,L_He_2p
-         real(dl) CB1,CDB,CR,CK,CL,CT,CB1_He1,CB1_He2,CDB_He,fu
-         real(dl) A2P_s,A2P_t,sigma_He_2Ps,sigma_He_2Pt
-         real(dl)  L_He_2Pt,L_He_2St,L_He2St_ion
- 
- 
-         real(dl), parameter :: bigH=100.0D3/Mpc !Ho in s-1
-         real(dl), parameter :: sigma = sigma_thomson
-         real(dl), parameter :: not4  = mass_ratio_He_H    !mass He/H atom
- 
-         real(dl) Tnow,HO
-         integer :: n_eq = 3
- 
- !The following only used for approximations where small effect
-        real(dl) OmegaK, OmegaT, z_eq
- 
- 
- !Fundamental constants in SI units
- !      ("not4" pointed out by Gary Steigman)
- 
-         data    Lambda      /8.2245809d0/
-         data    Lambda_He   /51.3d0/    !new value from Dalgarno
-         data    L_H_ion     /1.096787737D7/ !level for H ion. (in m^-1)
-         data    L_H_alpha   /8.225916453D6/ !averaged over 2 levels
-         data    L_He1_ion   /1.98310772D7/  !from Drake (1993)
-         data    L_He2_ion   /4.389088863D7/ !from JPhysChemRefData (1987)
-         data    L_He_2s     /1.66277434D7/  !from Drake (1993)
-         data    L_He_2p     /1.71134891D7/  !from Drake (1993)
- !   2 photon rates and atomic levels in SI units
- 
-         data    A2P_s       /1.798287D9/    !Morton, Wu & Drake (2006)
-         data    A2P_t       /177.58D0/      !Lach & Pachuski (2001)
-         data    L_He_2Pt    /1.690871466D7/ !Drake & Morton (2007)
-         data    L_He_2St    /1.5985597526D7/ !Drake & Morton (2007)
-         data    L_He2St_ion /3.8454693845D6/ !Drake & Morton (2007)
-         data    sigma_He_2Ps    /1.436289D-22/  !Hummer & Storey (1998)
-         data    sigma_He_2Pt    /1.484872D-22/  !Hummer & Storey (1998)
- !    Atomic data for HeI 
- 
- 
-        end module RECDATA
- 
- 
-         module Recombination
-         use constants
-         use AMLUtils
-         implicit none
-         private
- 
-         real(dl), parameter ::  zinitial = 1e4_dl !highest redshift
-         real(dl), parameter ::  zfinal=0._dl
-         integer,  parameter :: Nz=10000
-         real(dl), parameter :: delta_z = (zinitial-zfinal)/Nz
- 
-         integer, parameter :: RECFAST_Heswitch_default = 6
-         real(dl), parameter :: RECFAST_fudge_default = 1.14_dl
-         real(dl), parameter :: RECFAST_fudge_He_default = 0.86_dl !Helium fudge parameter
-  
- 
-         type RecombinationParams
- 
-           real(dl) :: RECFAST_fudge 
-           real(dl) :: RECFAST_fudge_He 
-           integer  :: RECFAST_Heswitch 
-          !0) no change from old Recfast'
-          !1) full expression for escape probability for singlet'
-          !'   1P-1S transition'
-          !2) also including effect of contiuum opacity of H on HeI'
-          !'   singlet (based in fitting formula suggested by'
-          !'   Kholupenko, Ivanchik & Varshalovich, 2007)'
-          !3) only including recombination through the triplets'
-          !4) including 3 and the effect of the contiuum '
-          !'   (although this is probably negligible)' 
-          !5) including only 1, 2 and 3'
-          !6) including all of 1 to 4'
-    
-         end  type RecombinationParams
- 
-         character(LEN=*), parameter :: Recombination_Name = 'Recfast_1.4'
-       
-         real(dl) zrec(Nz),xrec(Nz),dxrec(Nz), Tsrec(Nz) ,dTsrec(Nz), tmrec(Nz),dtmrec(Nz)
- 
-         real(dl), parameter :: Do21cm_mina = 1/(1+900.) !at which to start evolving Delta_TM
-         logical, parameter :: evolve_Ts = .false. !local equilibrium is very accurate
-         real(dl), parameter :: Do21cm_minev = 1/(1+400.) !at which to evolve T_s
-        
-  
-         real(dl), parameter :: B01 = 3*B10
-         real(dl) :: NNow, fHe 
-                
- 
-         logical :: Do21cm = .false.
-         logical :: doTmatTspin = .false.
- 
-         real(dl) :: recombination_saha_z !Redshift at which saha OK
-         real(dl) :: recombination_saha_tau !set externally
- 
- 
-         public RecombinationParams, Recombination_xe, Recombination_tm,Recombination_ts ,Recombination_init,   &
-                Recombination_ReadParams, Recombination_SetDefParams, Recombination_Validate, Recombination_Name, &
-                kappa_HH_21cm,kappa_eH_21cm,kappa_pH_21cm, &
-                Do21cm, doTmatTspin, Do21cm_mina, dDeltaxe_dtau, &
-                recombination_saha_tau, recombination_saha_z
-  
-        contains
- 
- 
- 
-          subroutine Recombination_ReadParams(R, Ini)
-           use IniFile
-           Type(RecombinationParams) :: R
-           Type(TIniFile) :: Ini
- 
- 
-              R%RECFAST_fudge = Ini_Read_Double_File(Ini,'RECFAST_fudge',RECFAST_fudge_default)
-              R%RECFAST_fudge_He = Ini_Read_Double_File(Ini,'RECFAST_fudge_He',RECFAST_fudge_He_default)
-              R%RECFAST_Heswitch = Ini_Read_Int_File(Ini, 'RECFAST_Heswitch',RECFAST_Heswitch_default)
- 
-         
-          end subroutine Recombination_ReadParams 
- 
-         subroutine Recombination_SetDefParams(R)
-          type (RecombinationParams) ::R
- 
-       
-           R%RECFAST_fudge = RECFAST_fudge_default
-           R%RECFAST_fudge_He = RECFAST_fudge_He_default !Helium fudge parameter
-           R%RECFAST_Heswitch = RECFAST_Heswitch_default
-    
-         end subroutine Recombination_SetDefParams
- 
- 
-         subroutine Recombination_Validate(R, OK)
-           Type(RecombinationParams),intent(in) :: R
-           logical, intent(inout) :: OK
-  
-               if (R%RECFAST_Heswitch<0 .or. R%RECFAST_Heswitch > 6) then
-                      OK = .false.
-                      write(*,*) 'RECFAST_Heswitch unknown'
-                end if
-              
-          end subroutine Recombination_Validate
- 
- 
-         function Recombination_tm(a)
-         use RECDATA, only : Tnow
-         real(dl) zst,a,z,az,bz,Recombination_tm
-         integer ilo,ihi
-         
-         if (.not. doTmatTspin) stop 'RECFAST: Recombination_tm not stored'
-         z=1/a-1
-         if (z >= zrec(1)) then
-             Recombination_tm=Tnow/a
-         else
-          if (z <=zrec(nz)) then
-           Recombination_tm=Tmrec(nz)
-          else
-           zst=(zinitial-z)/delta_z
-           ihi= int(zst)
-           ilo = ihi+1
-           az=zst - int(zst)
-           bz=1-az     
-           Recombination_tm=az*Tmrec(ilo)+bz*Tmrec(ihi)+ &
-            ((az**3-az)*dTmrec(ilo)+(bz**3-bz)*dTmrec(ihi))/6._dl
-          endif
-         endif
- 
-         end function Recombination_tm
- 
- 
-         function Recombination_ts(a)
-         !zrec(1) is zinitial-delta_z
-         real(dl), intent(in) :: a
-         real(dl) zst,z,az,bz,Recombination_ts
-         integer ilo,ihi
-         
-         z=1/a-1
-         if (z.ge.zrec(1)) then
-           Recombination_ts=tsrec(1)
-         else
-          if (z.le.zrec(nz)) then
-           Recombination_ts=tsrec(nz)
-          else
-           zst=(zinitial-z)/delta_z
-           ihi= int(zst)
-           ilo = ihi+1
-           az=zst - int(zst)
-           bz=1-az     
- 
-           Recombination_ts=az*tsrec(ilo)+bz*tsrec(ihi)+ &
-            ((az**3-az)*dtsrec(ilo)+(bz**3-bz)*dtsrec(ihi))/6._dl
-          endif
-         endif
- 
-         end function Recombination_ts
- 
- 
-         function Recombination_xe(a)
-         real(dl), intent(in) :: a
-         real(dl) zst,z,az,bz,Recombination_xe
-         integer ilo,ihi
-         
-         z=1/a-1
-         if (z.ge.zrec(1)) then
-           Recombination_xe=xrec(1)
-         else
-          if (z.le.zrec(nz)) then
-           Recombination_xe=xrec(nz)
-          else
-           zst=(zinitial-z)/delta_z
-           ihi= int(zst)
-           ilo = ihi+1
-           az=zst - int(zst)
-           bz=1-az     
-           Recombination_xe=az*xrec(ilo)+bz*xrec(ihi)+ &
-            ((az**3-az)*dxrec(ilo)+(bz**3-bz)*dxrec(ihi))/6._dl
-          endif
-         endif
- 
-         end function Recombination_xe
- 
- 
- 
-         subroutine Recombination_init(Recomb, OmegaC, OmegaB, Omegan, Omegav, h0inp,tcmb,yp)
-         !Would love to pass structure as arguments, but F90 would give circular reference...
-         !hence mess passing parameters explcitly and non-generally
-         !Note recfast only uses OmegaB, h0inp, tcmb and yp - others used only for Tmat approximation where effect small
-         use RECDATA
-         use AMLUtils
-         implicit none
-         Type (RecombinationParams) :: Recomb
-  
-         real(dl), save :: last_OmB =0, Last_YHe=0, Last_H0=0, Last_dtauda=0, last_fudge, last_fudgeHe 
- 
-         real(dl) Trad,Tmat,Tspin,d0hi,d0lo
-         integer I
- 
-         real(dl) OmegaB,OmegaC, Omegan, Omegav, H
-         real(dl) z,n,x,x0,rhs,x_H,x_He,x_H0,x_He0,h0inp
-         real(dl) zstart,zend,tcmb
-         real(dl) cw(24)
-         real(dl), dimension(:,:), allocatable :: w
-         real(dl) y(4)
-         real(dl) yp
-         real(dl) C10, tau_21Ts
-         real(dl) fnu
-         integer ind,nw
- 
- !       --- Parameter statements
-         real(dl), parameter :: tol=1.D-5                !Tolerance for R-K
- 
-         real(dl) dtauda
-         external dtauda
- 
- !       ===============================================================
- 
-         if (Last_OmB==OmegaB .and. Last_H0 == h0inp .and. yp == Last_YHe .and. & 
-              dtauda(0.2352375823_dl) == Last_dtauda .and. last_fudge == Recomb%RECFAST_fudge &
-               .and. last_fudgeHe==Recomb%RECFAST_fudge_He) return
-            !This takes up most of the single thread time, so cache if at all possible
-            !For example if called with different reionization, or tensor rather than scalar
-         
-         Last_dtauda =  dtauda(0.2352375823_dl) !Just get it at a random scale factor
-         Last_OmB = OmegaB
-         Last_H0 = h0inp
-         Last_YHe=yp
-         last_fudge = Recomb%RECFAST_FUDGE
-         last_fudgeHe = Recomb%RECFAST_FUDGE_He
- 
-         if (Do21cm) doTmatTspin = .true.
- 
- 
- !       write(*,*)'recfast version 1.0'
- !       write(*,*)'Using Hummer''s case B recombination rates for H'
- !       write(*,*)' with fudge factor = 1.14'
- !       write(*,*)'and tabulated HeII singlet recombination rates'
- !       write(*,*)
- 
-         n_eq = 3
-         if (Evolve_Ts) n_eq=4
-         allocate(w(n_eq,9))
- 
-         recombination_saha_z=0.d0
- 
-         Tnow=tcmb
- !       These are easy to inquire as input, but let's use simple values
-         z = zinitial
- !       will output every 1 in z, but this is easily changed also
- 
-  !Not general, but only for approx 
-         OmegaT=OmegaC+OmegaB            !total dark matter + baryons
- 	    OmegaK=1.d0-OmegaT-OmegaV	    !curvature
- 	
-   
- !       convert the Hubble constant units
-         H = H0inp/100._dl
-         HO = H*bigH
- 
- 
- !       sort out the helium abundance parameters
-         mu_H = 1.d0/(1.d0-Yp)           !Mass per H atom
-         mu_T = not4/(not4-(not4-1.d0)*Yp)   !Mass per atom
-         fHe = Yp/(not4*(1.d0-Yp))       !n_He_tot / n_H_tot
- 
- 
-         Nnow = 3._dl*HO*HO*OmegaB/(8._dl*Pi*G*mu_H*m_H)
- 
-         n = Nnow * (1._dl+z)**3
- 	    fnu = (21.d0/8.d0)*(4.d0/11.d0)**(4.d0/3.d0)
- !	(this is explictly for 3 massless neutrinos - change if N_nu.ne.3; but only used for approximation so not critical)
- 	    z_eq = (3.d0*(HO*C)**2/(8.d0*Pi*G*a_rad*(1.d0+fnu)*Tnow**4))*(OmegaB+OmegaC)
- 	    z_eq = z_eq - 1.d0
- 
-       
- !       Set up some constants so they don't have to be calculated later
-         Lalpha = 1.d0/L_H_alpha
-         Lalpha_He = 1.d0/L_He_2p
-         DeltaB = h_P*C*(L_H_ion-L_H_alpha)
-         CDB = DeltaB/k_B
-         DeltaB_He = h_P*C*(L_He1_ion-L_He_2s)   !2s, not 2p
-         CDB_He = DeltaB_He/k_B
-         CB1 = h_P*C*L_H_ion/k_B
-         CB1_He1 = h_P*C*L_He1_ion/k_B   !ionization for HeI
-         CB1_He2 = h_P*C*L_He2_ion/k_B   !ionization for HeII
-         CR = 2.d0*Pi*(m_e/h_P)*(k_B/h_P)
-         CK = Lalpha**3/(8.d0*Pi)
-         CK_He = Lalpha_He**3/(8.d0*Pi)
-         CL = C*h_P/(k_B*Lalpha)
-         CL_He = C*h_P/(k_B/L_He_2s) !comes from det.bal. of 2s-1s
-         CT = Compton_CT / MPC_in_sec
- 
-         Bfact = h_P*C*(L_He_2p-L_He_2s)/k_B
- 
-         
- !       Matter departs from radiation when t(Th) > H_frac * t(H)
- !       choose some safely small number
-         H_frac = 1D-3
- 
- !       Fudge factor to approximate for low z out of equilibrium effect
-         fu=Recomb%RECFAST_fudge
- 
- !       Set initial matter temperature
-         y(3) = Tnow*(1._dl+z)            !Initial rad. & mat. temperature
-         Tmat = y(3)
-         y(4) = Tmat
-         Tspin = Tmat
- 
-         call get_init(z,x_H0,x_He0,x0)
-     
-         y(1) = x_H0
-         y(2) = x_He0
- 
- !       OK that's the initial conditions, now start writing output file
- 
- 
- !       Set up work-space stuff for DVERK
-         ind  = 1
-         nw   = n_eq
-         do i = 1,24
-           cw(i) = 0._dl
-         end do
- 
-         do i = 1,Nz
- !       calculate the start and end redshift for the interval at each z
- !       or just at each z
-           zstart = zinitial  - real(i-1,dl)*delta_z
-           zend   = zinitial  - real(i,dl)*delta_z
- 
- ! Use Saha to get x_e, using the equation for x_e for ionized helium
- ! and for neutral helium.
- ! Everything ionized above z=8000.  First ionization over by z=5000.
- ! Assume He all singly ionized down to z=3500, then use He Saha until
- ! He is 99% singly ionized, and *then* switch to joint H/He recombination.
- 
-           z = zend
-         
-           if (zend > 8000._dl) then
- 
-             x_H0 = 1._dl
-             x_He0 = 1._dl
-             x0 = 1._dl+2._dl*fHe
-             y(1) = x_H0
-             y(2) = x_He0
-             y(3) = Tnow*(1._dl+z)
-             y(4) = y(3)
- 
-           else if(z > 5000._dl)then
- 
-             x_H0 = 1._dl
-             x_He0 = 1._dl
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1_He2/(Tnow*(1._dl+z)) ) / Nnow
-             rhs = rhs*1._dl            !ratio of g's is 1 for He++ <-> He+
-             x0 = 0.5d0 * ( sqrt( (rhs-1._dl-fHe)**2 &
-                 + 4._dl*(1._dl+2._dl*fHe)*rhs) - (rhs-1._dl-fHe) )
-             y(1) = x_H0
-             y(2) = x_He0
-             y(3) = Tnow*(1._dl+z)
-             y(4) = y(3)
- 
-           else if(z > 3500._dl)then
- 
-             x_H0 = 1._dl
-             x_He0 = 1._dl
-             x0 = x_H0 + fHe*x_He0
-             y(1) = x_H0
-             y(2) = x_He0
-             y(3) = Tnow*(1._dl+z)
-             y(4) = y(3)
- 
-           else if(y(2) > 0.99)then
- 
-             x_H0 = 1._dl
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1_He1/(Tnow*(1._dl+z)) ) / Nnow
-             rhs = rhs*4._dl            !ratio of g's is 4 for He+ <-> He0
-             x_He0 = 0.5d0 * ( sqrt( (rhs-1._dl)**2 &
-                 + 4._dl*(1._dl+fHe)*rhs )- (rhs-1._dl))
-             x0 = x_He0
-             x_He0 = (x0 - 1._dl)/fHe
-             y(1) = x_H0
-             y(2) = x_He0
-             y(3) = Tnow*(1._dl+z)
-             y(4) = y(3)
- 
-           else if (y(1) > 0.99d0) then
- 
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1/(Tnow*(1._dl+z)) ) / Nnow
-             x_H0 = 0.5d0 * (sqrt( rhs**2+4._dl*rhs ) - rhs )
- 
-             call DVERK(Recomb,3,ION,zstart,y,zend,tol,ind,cw,nw,w)
-             y(1) = x_H0
-             x0 = y(1) + fHe*y(2)
-             y(4)=y(3)
-           else
-             
-             call DVERK(Recomb,nw,ION,zstart,y,zend,tol,ind,cw,nw,w)
-           
-             x0 = y(1) + fHe*y(2)
-           
-           end if
-           
-           Trad = Tnow * (1._dl+zend)
-           Tmat = y(3)
-           x_H = y(1)
-           x_He = y(2)
-           x = x0
- 
-           zrec(i)=zend
-           xrec(i)=x
- 
-     
-           if (doTmatTspin) then
-               if (Evolve_Ts .and. zend< 1/Do21cm_minev-1 ) then
-                Tspin = y(4)
-               else 
-                C10 = Nnow * (1._dl+zend)**3*(kappa_HH_21cm(Tmat,.false.)*(1-x_H) + kappa_eH_21cm(Tmat,.false.)*x)
-                tau_21Ts = line21_const*NNow*(1+zend)*dtauda(1/(1+zend))/1000
-         
-                Tspin = Trad*( C10/Trad + A10/T_21cm)/(C10/Tmat + A10/T_21cm) + &
-                      tau_21Ts/2*A10*( 1/(C10*T_21cm/Tmat+A10) -  1/(C10*T_21cm/Trad+A10) )
-           
-                y(4) = Tspin
-               end if
- 
-               tsrec(i) = Tspin
-               tmrec(i) = Tmat
-            
-           end if   
- 
- !          write (*,'(5E15.5)') zend, Trad, Tmat, Tspin, x
-      
-         end do
-         
-         d0hi=1.0d40
-         d0lo=1.0d40
-         call spline(zrec,xrec,nz,d0lo,d0hi,dxrec)
-         if (doTmatTspin) then
-          call spline(zrec,tsrec,nz,d0lo,d0hi,dtsrec)
-          call spline(zrec,tmrec,nz,d0lo,d0hi,dtmrec)
-         end if
-         deallocate(w)
-         
-         end subroutine Recombination_init
- 
- !       ===============================================================
-         subroutine GET_INIT(z,x_H0,x_He0,x0)
- 
- !       Set up the initial conditions so it will work for general,
- !       but not pathological choices of zstart
- !       Initial ionization fraction using Saha for relevant species
-         use RECDATA
-         implicit none
-   
-         
-         real(dl) z,x0,rhs,x_H0,x_He0
-   
- 
-         if(z > 8000._dl)then
- 
-             x_H0 = 1._dl
-             x_He0 = 1._dl
-             x0 = 1._dl+2._dl*fHe
- 
-         else if(z > 3500._dl)then
- 
-             x_H0 = 1._dl
-             x_He0 = 1._dl
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1_He2/(Tnow*(1._dl+z)) ) / Nnow
-         rhs = rhs*1._dl    !ratio of g's is 1 for He++ <-> He+
-         x0 = 0.5d0 * ( sqrt( (rhs-1._dl-fHe)**2 &
-                 + 4._dl*(1._dl+2._dl*fHe)*rhs) - (rhs-1._dl-fHe) )
- 
-         else if(z > 2000._dl)then
- 
-         x_H0 = 1._dl
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1_He1/(Tnow*(1._dl+z)) ) / Nnow
-         rhs = rhs*4._dl    !ratio of g's is 4 for He+ <-> He0
-             x_He0 = 0.5d0  * ( sqrt( (rhs-1._dl)**2 + 4._dl*(1._dl+fHe)*rhs )- (rhs-1._dl))
-             x0 = x_He0
-             x_He0 = (x0 - 1._dl)/fHe
- 
-         else
- 
-             rhs = exp( 1.5d0 * log(CR*Tnow/(1._dl+z)) &
-                 - CB1/(Tnow*(1._dl+z)) ) / Nnow
-             x_H0 = 0.5d0 * (sqrt( rhs**2+4._dl*rhs ) - rhs )
-             x_He0 = 0._dl
-             x0 = x_H0
- 
-         end if
- 
-         
-         end subroutine GET_INIT
- 
- 
- 
-         subroutine ION(Recomb,Ndim,z,Y,f)
-         use RECDATA
-         implicit none
- 
-         integer Ndim
-         Type (RecombinationParams) :: Recomb
- 
-         real(dl) z,x,n,n_He,Trad,Tmat,Tspin,x_H,x_He, Hz
-         real(dl) y(Ndim),f(Ndim)
-         real(dl) Rup,Rdown,K,K_He,Rup_He,Rdown_He,He_Boltz
-         real(dl) timeTh,timeH
-         real(dl) a_VF,b_VF,T_0,T_1,sq_0,sq_1,a_PPB,b_PPB,c_PPB,d_PPB
-         real(dl) tauHe_s,pHe_s
-         real(dl) a_trip,b_trip,Rdown_trip,Rup_trip
-         real(dl) Doppler,gamma_2Ps,pb,qb,AHcon
-         real(dl) tauHe_t,pHe_t,CL_PSt,CfHe_t,gamma_2Pt
-         real(dl) epsilon
-         integer Heflag
-         real(dl) dtauda
-         real(dl) C10, dHdz
-         external dtauda
- 
- !       the Pequignot, Petitjean & Boisson fitting parameters for Hydrogen    
-         a_PPB = 4.309d0
-         b_PPB = -0.6166d0
-         c_PPB = 0.6703d0
-         d_PPB = 0.5300d0
- !       the Verner and Ferland type fitting parameters for Helium
- !       fixed to match those in the SSS papers, and now correct
-         a_VF = 10.d0**(-16.744d0)
-         b_VF = 0.711d0
-         T_0 = 10.d0**(0.477121d0)   !3K
-         T_1 = 10.d0**(5.114d0)
- !      fitting parameters for HeI triplets
- !      (matches Hummer's table with <1% error for 10^2.8 < T/K < 10^4)
- 
-         a_trip = 10.d0**(-16.306d0)
-         b_trip = 0.761D0
- 
-        
-         x_H = y(1)
-         x_He = y(2)
-         x = x_H + fHe * x_He
-         Tmat = y(3)
- !        Tspin = y(4)
- 
-         n = Nnow * (1._dl+z)**3
-         n_He = fHe * Nnow * (1._dl+z)**3
-         Trad = Tnow * (1._dl+z)
- 
-         Hz = 1/dtauda(1/(1._dl+z))*(1._dl+z)**2/MPC_in_sec       
-      
- 
- !       Get the radiative rates using PPQ fit, identical to Hummer's table
-         
-         Rdown=1.d-19*a_PPB*(Tmat/1.d4)**b_PPB &
-                 /(1._dl+c_PPB*(Tmat/1.d4)**d_PPB)
-         Rup = Rdown * (CR*Tmat)**(1.5d0)*exp(-CDB/Tmat)
-       
- !       calculate He using a fit to a Verner & Ferland type formula
-         sq_0 = sqrt(Tmat/T_0)
-         sq_1 = sqrt(Tmat/T_1)
- !       typo here corrected by Wayne Hu and Savita Gahlaut
-         Rdown_He = a_VF/(sq_0*(1.d0+sq_0)**(1.d0-b_VF))
-         Rdown_He = Rdown_He/(1.d0+sq_1)**(1.d0+b_VF)
-         Rup_He = Rdown_He*(CR*Tmat)**(1.5d0)*exp(-CDB_He/Tmat)
-         Rup_He = 4.d0*Rup_He    !statistical weights factor for HeI
- !       Avoid overflow (pointed out by Jacques Roland)
-         if((Bfact/Tmat) > 680.d0)then
-           He_Boltz = exp(680.d0)
-         else
-           He_Boltz = exp(Bfact/Tmat)
-         end if
-         K = CK/Hz              !Peebles coefficient K=lambda_a^3/8piH
-         
-  !  add the HeI part, using same T_0 and T_1 values
-     Rdown_trip = a_trip/(sq_0*(1.d0+sq_0)**(1.0-b_trip))
-     Rdown_trip = Rdown_trip/((1.d0+sq_1)**(1.d0+b_trip))
-     Rup_trip = Rdown_trip*dexp(-h_P*C*L_He2St_ion/(k_B*Tmat))
-     Rup_trip = Rup_trip*((CR*Tmat)**(1.5d0))*(4.d0/3.d0)
- !   last factor here is the statistical weight
- 
- !       try to avoid "NaN" when x_He gets too small
-     if ((x_He.lt.5.d-9) .or. (x_He.gt.0.98d0)) then 
-       Heflag = 0
-     else
-       Heflag = Recomb%RECFAST_Heswitch
-     end if
-     if (Heflag.eq.0)then        !use Peebles coeff. for He
-       K_He = CK_He/Hz
-     else    !for Heflag>0       !use Sobolev escape probability
-       tauHe_s = A2P_s*CK_He*3.d0*n_He*(1.d0-x_He)/Hz
-       pHe_s = (1.d0 - dexp(-tauHe_s))/tauHe_s
-       K_He = 1.d0/(A2P_s*pHe_s*3.d0*n_He*(1.d0-x_He))
- !      if (((Heflag.eq.2) .or. (Heflag.ge.5)) .and. x_H < 0.99999d0) then 
-       if (((Heflag.eq.2) .or. (Heflag.ge.5)) .and. x_H < 0.9999999d0) then
-        !AL changed July 08 to get smoother Helium
- 
- !   use fitting formula for continuum opacity of H
- !   first get the Doppler width parameter
-         Doppler = 2.D0*k_B*Tmat/(m_H*not4*C*C)
-         Doppler = C*L_He_2p*dsqrt(Doppler)
-         gamma_2Ps = 3.d0*A2P_s*fHe*(1.d0-x_He)*C*C &
-             /(dsqrt(Pi)*sigma_He_2Ps*8.d0*Pi*Doppler*(1.d0-x_H)) &
-             /((C*L_He_2p)**2.d0)
-         pb = 0.36d0  !value from KIV (2007)
-         qb = Recomb%RECFAST_fudge_He
- !   calculate AHcon, the value of A*p_(con,H) for H continuum opacity
-         AHcon = A2P_s/(1.d0+pb*(gamma_2Ps**qb))
-         K_He=1.d0/((A2P_s*pHe_s+AHcon)*3.d0*n_He*(1.d0-x_He))
-       end if
-       if (Heflag.ge.3) then     !include triplet effects
-         tauHe_t = A2P_t*n_He*(1.d0-x_He)*3.d0
-         tauHe_t = tauHe_t /(8.d0*Pi*Hz*L_He_2Pt**(3.d0))
-         pHe_t = (1.d0 - dexp(-tauHe_t))/tauHe_t
-         CL_PSt = h_P*C*(L_He_2Pt - L_He_2st)/k_B
-     	if ((Heflag.eq.3) .or. (Heflag.eq.5).or.(x_H.gt.0.99999d0)) then !Recfast 1.4.2 (?)
- !        if ((Heflag.eq.3) .or. (Heflag.eq.5) .or. x_H >= 0.9999999d0) then    !no H cont. effect
-             CfHe_t = A2P_t*pHe_t*dexp(-CL_PSt/Tmat)
-             CfHe_t = CfHe_t/(Rup_trip+CfHe_t)   !"C" factor for triplets
-         else                  !include H cont. effect
-             Doppler = 2.d0*k_B*Tmat/(m_H*not4*C*C)
-             Doppler = C*L_He_2Pt*dsqrt(Doppler)
-             gamma_2Pt = 3.d0*A2P_t*fHe*(1.d0-x_He)*C*C &
-             /(dsqrt(Pi)*sigma_He_2Pt*8.d0*Pi*Doppler*(1.d0-x_H)) &
-             /((C*L_He_2Pt)**2.d0)
-     !   use the fitting parameters from KIV (2007) in this case
-             pb = 0.66d0
-             qb = 0.9d0
-             AHcon = A2P_t/(1.d0+pb*gamma_2Pt**qb)/3.d0
-             CfHe_t = (A2P_t*pHe_t+AHcon)*dexp(-CL_PSt/Tmat)
-             CfHe_t = CfHe_t/(Rup_trip+CfHe_t)   !"C" factor for triplets
-         end if
-       end if
-     end if
-         
-         
- !       Estimates of Thomson scattering time and Hubble time
-         timeTh=(1._dl/(CT*Trad**4))*(1._dl+x+fHe)/x       !Thomson time
-         timeH=2./(3.*HO*(1._dl+z)**1.5)      !Hubble time
- 
- !       calculate the derivatives
- !       turn on H only for x_H<0.99, and use Saha derivative for 0.98<x_H<0.99
- !       (clunky, but seems to work)
-         if (x_H > 0.99) then   !don't change at all
-                 f(1) = 0._dl
- !!        else if (x_H > 0.98_dl) then
-       else if (x_H.gt.0.985d0) then     !use Saha rate for Hydrogen
-             f(1) = (x*x_H*n*Rdown - Rup*(1.d0-x_H)*dexp(-CL/Tmat)) /(Hz*(1.d0+z))
-             recombination_saha_z = z  
- !AL: following commented as not used
- !   for interest, calculate the correction factor compared to Saha
- !   (without the fudge)
- !       factor=(1.d0 + K*Lambda*n*(1.d0-x_H))
- !       /(Hz*(1.d0+z)*(1.d0+K*Lambda*n*(1.d0-x)
- !       +K*Rup*n*(1.d0-x)))       
-       else !use full rate for H
- 
-         f(1) = ((x*x_H*n*Rdown - Rup*(1.d0-x_H)*exp(-CL/Tmat)) &
-                 *(1.d0 + K*Lambda*n*(1.d0-x_H))) &
-                 /(Hz*(1.d0+z)*(1.d0/fu+K*Lambda*n*(1.d0-x_H)/fu &
-                 +K*Rup*n*(1.d0-x_H)))
- 
-       end if
-    
- !       turn off the He once it is small
-       if (x_He < 1.e-15) then 
-                 f(2)=0.d0
-       else
- 
-         f(2) = ((x*x_He*n*Rdown_He &
-             - Rup_He*(1-x_He)*exp(-CL_He/Tmat)) &
-                 *(1 + K_He*Lambda_He*n_He*(1.d0-x_He)*He_Boltz)) &
-                 /(Hz*(1+z) &
-                 * (1 + K_He*(Lambda_He+Rup_He)*n_He*(1.d0-x_He)*He_Boltz))
-                 
- !   Modification to HeI recombination including channel via triplets
-           if (Heflag.ge.3) then
-             f(2) = f(2)+ (x*x_He*n*Rdown_trip & 
-              - (1.d0-x_He)*3.d0*Rup_trip*dexp(-h_P*C*L_He_2st/(k_B*Tmat))) &
-              *CfHe_t/(Hz*(1.d0+z))
-           end if
- 
-         end if
- 
-         if (timeTh < H_frac*timeH) then
- !                f(3)=Tmat/(1._dl+z)      !Tmat follows Trad
- !	additional term to smooth transition to Tmat evolution,
- !	(suggested by Adam Moss)
-       	 dHdz = (HO**2/2.d0/Hz)*(4.d0*(1.d0+z)**3/(1.d0+z_eq)*OmegaT &
- 	 	 + 3.d0*OmegaT*(1.d0+z)**2 + 2.d0*OmegaK*(1.d0+z) )
- 
- 		epsilon = Hz*(1.d0+x+fHe)/(CT*Trad**3*x)
- 		f(3) = Tnow &
- 		+ epsilon*((1.d0+fHe)/(1.d0+fHe+x))*((f(1)+fHe*f(2))/x) &
- 		- epsilon* dHdz/Hz + 3.0d0*epsilon/(1.d0+z) 
-                 
-         else
-                 f(3)= CT * (Trad**4) * x / (1._dl+x+fHe) &
-                         * (Tmat-Trad) / (Hz*(1._dl+z)) + 2._dl*Tmat/(1._dl+z)    
-         end if
- 
-          ! print *, z, f(3)*(1+z)/Tmat
-          
-         if (Do21cm .and. evolve_Ts) then
- 
-     !       follow the matter temperature once it has a chance of diverging
-             if (timeTh < H_frac*timeH) then
-                 f(4) = Tnow !spin follows Trad and Tmat
-             else
-                 if (z< 1/Do21cm_minev-1) then
-        
-                  Tspin = y(4) 
-                  C10 = n*(kappa_HH_21cm(Tmat,.false.)*(1-x_H) + kappa_eH_21cm(Tmat,.false.)*x)
-        
-                  f(4) = 4*Tspin/Hz/(1+z)*( (Tspin/Tmat-1._dl)*C10 + Trad/T_21cm*(Tspin/Trad-1._dl)*A10) - f(1)*Tspin/(1-x_H)
-                 else
-                  f(4)=f(3)
-                 end if
-             end if
-       
-         end if
- 
-         end subroutine ION
- 
- 
- 
-         function dDeltaxe_dtau(a, Delta_xe,Delta_nH, Delta_Tm, hdot, kvb)
-         !d x_e/d tau assuming Helium all neutral and temperature perturbations negligible
-         !it is not accurate for x_e of order 1
-         use RECDATA
-         implicit none
-         real(dl) dDeltaxe_dtau
-         real(dl), intent(in):: a, Delta_xe,Delta_nH, Delta_Tm, hdot, kvb
-         real(dl) Delta_Tg
-         real(dl) xedot,z,x,n,n_He,Trad,Tmat,x_H,Hz, C_r, dlnC_r
-         real(dl) Rup,Rdown,K
-         real(dl) a_PPB,b_PPB,c_PPB,d_PPB
-         real(dl) delta_alpha, delta_beta, delta_K, clh
-         real(dl) dtauda
-         external dtauda
- 
-        
-         Delta_tg =Delta_Tm
-         x_H = min(1._dl,Recombination_xe(a))
- 
- !       the Pequignot, Petitjean & Boisson fitting parameters for Hydrogen    
-         a_PPB = 4.309d0
-         b_PPB = -0.6166d0
-         c_PPB = 0.6703d0
-         d_PPB = 0.5300d0
-  
-         z=1/a-1
- 
-         x = x_H 
- 
-         n = Nnow /a**3
-         n_He = fHe * n
-         Trad = Tnow /a
-         clh = 1/dtauda(a)/a !conformal time
-         Hz = clh/a/MPC_in_sec !normal time in seconds
- 
-         Tmat = Recombination_tm(a)
- 
- !       Get the radiative rates using PPQ fit, identical to Hummer's table
-         
-         Rdown=1.d-19*a_PPB*(Tmat/1.d4)**b_PPB &
-                 /(1._dl+c_PPB*(Tmat/1.d4)**d_PPB)   !alpha
-         Rup = Rdown * (CR*Tmat)**(1.5d0)*exp(-CDB/Tmat)
-       
-         K = CK/Hz              !Peebles coefficient K=lambda_a^3/8piH
- 
- 
-         Rdown = Rdown*fu
-         Rup = Rup*fu
-         C_r =  a*(1.d0 + K*Lambda*n*(1.d0-x_H)) /( 1.d0+K*(Lambda+Rup)*n*(1.d0-x_H) )*MPC_in_sec
-  
-         xedot = -(x*x_H*n*Rdown - Rup*(1.d0-x_H)*exp(-CL/Tmat))*C_r
-                
-         delta_alpha = (b_PPB + c_PPB*(Tmat/1d4)**d_PPB*(b_PPB-d_PPB))/(1+c_PPB*(Tmat/1d4)**d_PPB)*Delta_Tg
-         delta_beta = delta_alpha + (3./2 + CDB/Tmat)*delta_Tg !(Rup = beta)
-         delta_K = - hdot/clh - kvb/clh/3
- 
- 
-         dlnC_r = -Rup*K*n*( (Delta_nH+Delta_K + Delta_beta*(1+K*Lambda*n*(1-x_H)))*(1-x_H) - x_H*Delta_xe) &
-           / ( 1.d0+K*(Lambda+Rup)*n*(1.d0-x_H) ) /(1.d0 + K*Lambda*n*(1.d0-x_H)) 
-              
-         dDeltaxe_dtau= xedot/x_H*(dlnC_r +Delta_alpha - Delta_xe) &
-          - C_r*( (2*Delta_xe + Delta_nH)*x_H*n*Rdown + (Delta_xe - (3./2+ CB1/Tmat)*(1/x_H-1)*Delta_Tg)*Rup*exp(-CL/Tmat))
-         
-  
- !Approximate form valid at late times
- !        dDeltaxe_dtau= xedot/x_H*(Delta_alpha + Delta_xe + Delta_nH)
- 
- 
-         end function dDeltaxe_dtau
- 
- !  ===============================================================
- 
- 
-           function polevl(x,coef,N)
-           implicit none
-           integer N
-           real(dl) polevl
-           real(dl) x,ans
-           real(dl) coef(N+1)
- 
-           integer i
- 
-           ans=coef(1)
-           do i=2,N+1
-              ans=ans*x+coef(i)
-           end do
-           polevl=ans
-       
-           end function polevl
- 
- 
-           function derivpolevl(x,coef,N)
-           implicit none
-           integer N
-           real(dl) derivpolevl
-           real(dl) x,ans
-           real(dl) coef(N+1)
-           integer i
- 
-           ans=coef(1)*N
-           do i=2,N
-              ans=ans*x+coef(i)*(N-i+1)
-           end do
-           derivpolevl=ans
-       
-           end function derivpolevl
- 
- 
-         function kappa_HH_21cm(T, deriv)
-         !Polynomail fit to Hydrogen-Hydrogen collision rate as function of Tmatter, from astro-ph/0608032
-         !if deriv return d log kappa / d log T
-          real(dl), intent(in) :: T
-          logical, intent(in) :: deriv
-  !        real(dl), dimension(8), parameter :: fit = &
-  !         (/ 0.00120402_dl, -0.0322247_dl,0.339581_dl, -1.75094_dl,4.3528_dl,-4.03562_dl, 1.26899_dl, -29.6113_dl /)
-          integer, parameter :: n_table = 27
-          integer, dimension(n_table), parameter :: Temps = &
-           (/ 1, 2, 4, 6,8,10,15,20,25,30,40,50,60,70,80,90,100,200,300,500,700,1000,2000,3000,5000,7000,10000/) 
-          real, dimension(n_table), parameter :: rates = &
-           (/ 1.38e-13, 1.43e-13,2.71e-13, 6.60e-13,1.47e-12,2.88e-12,9.10e-12,1.78e-11,2.73e-11,&
-            3.67e-11,5.38e-11,6.86e-11,8.14e-11,9.25e-11, &
-            1.02e-10,1.11e-10,1.19e-10,1.75e-10,2.09e-10,2.56e-10,2.91e-10,3.31e-10,4.27e-10,&
-            4.97e-10,6.03e-10,6.87e-10,7.87e-10/) 
-           
-          real(dl) kappa_HH_21cm, logT, logRate
-          real(dl), save, dimension(:), allocatable :: logRates, logTemps, ddlogRates
-          integer xlo, xhi
-          real(dl) :: a0, b0, ho
- 
-          if (.not. allocated(logRates)) then
- 
-              allocate(logRates(n_table),logTemps(n_table),ddlogRates(n_table))
-              logRates = log(real(rates,dl)*0.01**3)
-              logTemps = log(real(Temps,dl))
-              call spline(logTemps,logRates,n_table,1d30,1d30,ddlogRates)
-          end if
- 
-          if (T<=Temps(1)) then
-              if (deriv) then
-               kappa_HH_21cm = 0
-              else
-               kappa_HH_21cm = rates(1)*0.01**3
-              end if
-             return
-          elseif (T >=Temps(n_table)) then
-              if (deriv) then
-               kappa_HH_21cm = 0
-              else
-               kappa_HH_21cm = rates(n_table)*0.01**3
-              end if
-              return
-          end if
-          
-          logT = log(T)
-          xlo=0
-          do xhi=2, n_table
-           if (logT < logTemps(xhi)) then
-             xlo = xhi-1
-             exit
-           end  if
-          end do
-          xhi = xlo+1
-  
-          ho=logTemps(xhi)-logTemps(xlo) 
-          a0=(logTemps(xhi)-logT)/ho
-          b0=1-a0
-  
-          if (deriv) then
-           kappa_HH_21cm  = (logRates(xhi) - logRates(xlo))/ho + &
-               ( ddlogRates(xhi)*(3*b0**2-1) - ddlogRates(xlo)*(3*a0**2-1))*ho/6
- !          kappa_HH_21cm = derivpolevl(logT,fit,7)     
-          else
-           logRate = a0*logRates(xlo)+ b0*logRates(xhi)+ ((a0**3-a0)* ddlogRates(xlo) +(b0**3-b0)*ddlogRates(xhi))*ho**2/6
-           kappa_HH_21cm = exp(logRate)
- !          kappa_HH_21cm = exp(polevl(logT,fit,7))*0.01**3          
-   
-          end if
- 
-         end function kappa_HH_21cm
- 
- 
-         function kappa_eH_21cm(T, deriv)
-         !Polynomail fit to electron-Hydrogen collision rate as function of Tmatter; from astro-ph/0608032
-         !if deriv return d log kappa / d log T
-         ! from astro-ph/0608032
-         !    1 2.39e-10
-         !    2 3.37e-10
-         !    5 5.3e-10
-         !    10 7.46e-10
-         !    20 1.05e-9
-         !    50 1.63e-9
-         !    100 2.26e-9
-         !    200 3.11e-9
-         !    500 4.59e-9
-         !    1000 5.92e-9
-         !    2000 7.15e-9
-         !    5000 8.17e-9
-         !    10000 8.37e-9
-         !    15000 8.29e-9
-         !    20000 8.11e-9
-          real(dl), intent(in) :: T
-          logical, intent(in) :: deriv
-          real(dl), dimension(6), parameter :: fit = &
-           (/5.86236d-005,  -0.00171375_dl, 0.0137303_dl, -0.0435277_dl, 0.540905_dl,-22.1596_dl /)
-        
-          real(dl) kappa_eH_21cm, logT
- 
-          logT = log(T)
-          if (deriv) then
-           kappa_eH_21cm = derivpolevl(logT,fit,5)      
-          else
-           kappa_eH_21cm = exp(polevl(logT,fit,5))*0.01**3          
-          end if
- 
-         end function kappa_eH_21cm
- 
- 
- 
- 
-         function kappa_pH_21cm(T, deriv) ! from astro-ph/0702487
-         !Not actually used
-         !Polynomail fit to proton-Hydrogen collision rate as function of Tmatter
-         !if deriv return d log kappa / d log T
-          real(dl), intent(in) :: T
-          logical, intent(in) :: deriv
-          integer, parameter :: n_table = 17
-          integer, dimension(n_table), parameter :: Temps = &
-           (/ 1, 2, 5, 10,20,50,100,200,500,1000,2000,3000,5000,7000,10000,15000,20000/) 
-          real, dimension(n_table), parameter :: rates = &
-           (/ 0.4028, 0.4517,0.4301,0.3699,0.3172,0.3047, 0.3379, 0.4043, 0.5471, 0.7051, 0.9167, 1.070, &
-               1.301, 1.48,1.695,1.975,2.201/) 
-           
-          real(dl) kappa_pH_21cm, logT, logRate
-          real(dl), save, dimension(:), allocatable :: logRates, logTemps, ddlogRates
-          integer xlo, xhi
-          real(dl) :: a0, b0, ho
-          real(dl):: factor = 0.01**3*1e-9
- 
-          if (.not. allocated(logRates)) then
- 
-              allocate(logRates(n_table),logTemps(n_table),ddlogRates(n_table))
-              logRates = log(real(rates,dl)*factor)
-              logTemps = log(real(Temps,dl))
-              call spline(logTemps,logRates,n_table,1d30,1d30,ddlogRates)
-          end if
- 
-          if (T<=Temps(1)) then
-              if (deriv) then
-               kappa_pH_21cm = 0
-              else
-               kappa_pH_21cm = rates(1)*factor
-              end if
-             return
-          elseif (T >=Temps(n_table)) then
-              if (deriv) then
-               kappa_pH_21cm = 0
-              else
-               kappa_pH_21cm = rates(n_table)*factor
-              end if
-              return
-          end if
-          
-          logT = log(T)
-          xlo=0
-          do xhi=2, n_table
-           if (logT < logTemps(xhi)) then
-             xlo = xhi-1
-             exit
-           end  if
-          end do
-          xhi = xlo+1
-  
-          ho=logTemps(xhi)-logTemps(xlo) 
-          a0=(logTemps(xhi)-logT)/ho
-          b0=1-a0
-  
-          if (deriv) then
-           kappa_pH_21cm  = (logRates(xhi) - logRates(xlo))/ho + &
-            ( ddlogRates(xhi)*(3*b0**2-1) - ddlogRates(xlo)*(3*a0**2-1))*ho/6
-          else
-           logRate = a0*logRates(xlo)+ b0*logRates(xhi)+ ((a0**3-a0)* ddlogRates(xlo) +(b0**3-b0)*ddlogRates(xhi))*ho**2/6
-           kappa_pH_21cm = exp(logRate)
-          end if
- 
-         end function kappa_pH_21cm
- 
- 
-         end module Recombination
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/reionization.f90 cosmomc_sampler/camb/reionization.f90
*** cosmomc/camb/reionization.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/reionization.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,363 ****
- 
- module Reionization
-  use Precision
-  use AMLutils
-  implicit none  
- 
- !This module puts smooth tanh reionization of specified mid-point (z_{re}) and width
- !The tanh function is in the variable (1+z)**Rionization_zexp
- 
- !Rionization_zexp=1.5 has the property that for the same z_{re} 
- !the optical depth agrees with infinitely sharp model for matter domination 
- !So tau and zre can be mapped into each other easily (for any symmetric window)
- !However for generality the module maps tau into z_{re} using a binary search
- !so could be easily modified for other monatonic parameterizations.
- 
- !AL March 2008
- !AL July 2008 - added trap for setting optical depth without use_optical_depth
- 
- !See CAMB notes for further discussion: http://cosmologist.info/notes/CAMB.pdf
- 
-        character(LEN=*), parameter :: Reionization_Name = 'CAMB_reionization'
- 
-        real(dl), parameter :: Reionization_DefFraction = -1._dl 
-         !if -1 set from YHe assuming Hydrogen and first ionization of Helium follow each other
-        
-        real(dl) :: Reionization_AccuracyBoost = 1._dl
-        real(dl) :: Rionization_zexp = 1.5_dl
- 
-        logical :: include_helium_fullreion = .true.
-        real(dl) :: helium_fullreion_redshift  = 3.5_dl
-        real(dl) :: helium_fullreion_deltaredshift  = 0.5
-        real(dl) :: helium_fullreion_redshiftstart  = 5._dl
-        
-        
-        type ReionizationParams
-              logical    :: Reionization
-              logical    :: use_optical_depth
-              real(dl)   :: redshift, delta_redshift, fraction
-              real(dl)   :: optical_depth
-         end type ReionizationParams
-   
-         type ReionizationHistory
- !These two are used by main code to bound region where xe changing 
-           real(dl) :: tau_start, tau_complete
- !This is set from main code          
-           real(dl) :: akthom, fHe
- 
- !The rest are internal to this module.
-           real(dl) :: WindowVarMid, WindowVarDelta
- 
-         end type ReionizationHistory
- 
-       real(dl), parameter :: Reionization_maxz = 40._dl
-       real(dl), private, parameter :: Reionization_tol = 1d-5
- 
-       real(dl), private, external :: dtauda, rombint,rombint2
- 
-     Type(ReionizationParams), private, pointer ::  ThisReion
-     Type(ReionizationHistory), private, pointer :: ThisReionHist
- 
- contains
- 
-  
-  function Reionization_xe(a, tau, xe_recomb)
-  !a and time tau and redundant, both provided for convenience
-  !xe_recomb is xe(tau_start) from recombination (typically very small, ~2e-4)
-  !xe should map smoothly onto xe_recomb
-   real(dl), intent(in) :: a
-   real(dl), intent(in), optional :: tau, xe_recomb
-   real(dl) Reionization_xe
-   real(dl) tgh, xod
-   real(dl) xstart
-   
-         if (present(xe_recomb)) then
-         xstart = xe_recomb
-         else
-         xstart = 0._dl
-         end if
-         
-         xod = (ThisReionHist%WindowVarMid - 1._dl/a**Rionization_zexp)/ThisReionHist%WindowVarDelta
-         if (xod > 100) then
-             tgh=1.d0
-         else
-             tgh=tanh(xod)
-         end if
-         Reionization_xe =(ThisReion%fraction-xstart)*(tgh+1._dl)/2._dl+xstart
-      
-         if (include_helium_fullreion .and. a > (1/(1+ helium_fullreion_redshiftstart))) then
-         
-          !Effect of Helium becoming fully ionized at z <~ 3.5 is very small so details not important
-           xod = (1+helium_fullreion_redshift - 1._dl/a)/helium_fullreion_deltaredshift
-           if (xod > 100) then
-              tgh=1.d0
-           else
-              tgh=tanh(xod)
-           end if
-       
-         Reionization_xe =  Reionization_xe + ThisReionHist%fHe*(tgh+1._dl)/2._dl
-   
-        end if
-       
-  end function Reionization_xe  
-  
-  function Reionization_timesteps(ReionHist)
-  !minimum number of time steps to use between tau_start and tau_complete
-  !Scaled by AccuracyBoost later
-  !steps may be set smaller than this anyway
-   Type(ReionizationHistory) :: ReionHist
-   integer Reionization_timesteps
-   
-   Reionization_timesteps = 50 
-   
-  end  function Reionization_timesteps
-  
-  subroutine Reionization_ReadParams(Reion, Ini)
-   use IniFile
-   Type(ReionizationParams) :: Reion
-   Type(TIniFile) :: Ini
- 
-    Reion%Reionization = Ini_Read_Logical_File(Ini,'reionization')
-    if (Reion%Reionization) then
-    
-     Reion%use_optical_depth = Ini_Read_Logical_File(Ini,'re_use_optical_depth') 
-   
-     if (Reion%use_optical_depth) then
-               Reion%optical_depth = Ini_Read_Double_File(Ini,'re_optical_depth')
-     else 
-               Reion%redshift = Ini_Read_Double_File(Ini,'re_redshift')
-     end if 
- 
-     Reion%delta_redshift = Ini_Read_Double_File(Ini,'re_delta_redshift', 0.5_dl) !default similar to CMBFAST original
-     Reion%fraction = Ini_Read_Double_File(Ini,'re_ionization_frac',Reionization_DefFraction)
-   
-   end if
- 
-  end subroutine Reionization_ReadParams 
- 
-  subroutine Reionization_SetParamsForZre(Reion,ReionHist)
-   Type(ReionizationParams), target :: Reion
-   Type(ReionizationHistory), target :: ReionHist 
-      
-        ReionHist%WindowVarMid = (1._dl+Reion%redshift)**Rionization_zexp
-        ReionHist%WindowVarDelta = &
-          Rionization_zexp*(1._dl+Reion%redshift)**(Rionization_zexp-1._dl)*Reion%delta_redshift
-  
-  end subroutine Reionization_SetParamsForZre
- 
-  subroutine Reionization_Init(Reion, ReionHist, Yhe, akthom, tau0, FeedbackLevel)
-   use constants
-   Type(ReionizationParams), target :: Reion
-   Type(ReionizationHistory), target :: ReionHist
-   real(dl), intent(in) :: akthom, tau0, Yhe 
-   integer, intent(in) :: FeedbackLevel
-   real(dl) astart
- 
-      ReionHist%akthom = akthom  
-      ReionHist%fHe =  YHe/(mass_ratio_He_H*(1.d0-YHe))
-  
-      ReionHist%tau_start=tau0
-      ReionHist%tau_complete=tau0
-       
-      ThisReion => Reion
-      ThisReionHist => ReionHist
- 
-      if (Reion%Reionization) then
-  
-             if (Reion%optical_depth /= 0._dl .and. .not. Reion%use_optical_depth) &
-              write (*,*) 'WARNING: You seem to have set the optical depth, but use_optical_depth = F'
-     
- 
-            if (Reion%use_optical_depth.and.Reion%optical_depth<0.001 &
-                 .or. .not.Reion%use_optical_depth .and. Reion%Redshift<0.001) then
-                Reion%Reionization = .false.
-            end if
-           
-       end if   
-      
-      if (Reion%Reionization) then
-            
-         if (Reion%fraction==Reionization_DefFraction) &
-                  Reion%fraction = 1._dl + ReionHist%fHe  !H + singly ionized He
-           
-        if (Reion%use_optical_depth) then
-         call Reionization_SetFromOptDepth(Reion,ReionHist)
-         if (FeedbackLevel > 0) write(*,'("Reion redshift       =  ",f6.3)') Reion%redshift
-        end if
- 
-        call Reionization_SetParamsForZre(ThisReion,ThisReionHist)
-        
-       !this is a check, agrees very well in default parameterization
-        if (FeedbackLevel > 1) write(*,'("Integrated opt depth = ",f7.4)') &
-             Reionization_GetOptDepth(Reion, ReionHist) 
- 
-       !Get relevant times       
-        astart=1.d0/(1.d0+Reion%redshift + Reion%delta_redshift*8)
-        ReionHist%tau_start = max(0.05_dl, rombint(dtauda,0._dl,astart,1d-3))
-           !Time when a very small reionization fraction (assuming tanh fitting)
- 
-        ReionHist%tau_complete = min(tau0, &
-           ReionHist%tau_start+ rombint(dtauda,astart,1.d0/(1.d0+max(0.d0,Reion%redshift-Reion%delta_redshift*8)),1d-3))
- 
-     end if   
-        
-  end subroutine Reionization_Init
-  
-  
-  subroutine Reionization_SetDefParams(Reion)
-   Type(ReionizationParams) :: Reion
-  
-        Reion%Reionization = .true.
-        Reion%use_optical_depth = .false.
-        Reion%optical_depth = 0._dl
-        Reion%redshift = 10
-        Reion%fraction = Reionization_DefFraction
-        Reion%delta_redshift = 0.5_dl
- 
-  end subroutine Reionization_SetDefParams
- 
-  subroutine Reionization_Validate(Reion, OK)
-   Type(ReionizationParams),intent(in) :: Reion
-   logical, intent(inout) :: OK
-  
-       if (Reion%Reionization) then
-         if (Reion%use_optical_depth) then
-             if (Reion%optical_depth<0 .or. Reion%optical_depth > 0.9  .or. &
-                include_helium_fullreion .and. Reion%optical_depth<0.01) then
-              OK = .false.
-              write(*,*) 'Optical depth is strange. You have:', Reion%optical_depth 
-             end if
-         else
-             if (Reion%redshift < 0 .or. Reion%Redshift +Reion%delta_redshift*3 > Reionization_maxz .or. &
-               include_helium_fullreion .and. Reion%redshift < helium_fullreion_redshift) then
-                 OK = .false.
-                 write(*,*) 'Reionization redshift strange. You have: ',Reion%Redshift
-             end if
-         end if
-         if (Reion%fraction/= Reionization_DefFraction .and. (Reion%fraction < 0 .or. Reion%fraction > 1.5)) then
-                 OK = .false.
-                 write(*,*) 'Reionization fraction strange. You have: ',Reion%fraction
-         end if
-         if (Reion%delta_redshift > 3 .or. Reion%delta_redshift<0.1 ) then
-         !Very narrow windows likely to cause problems in interpolation etc.
-         !Very broad likely to conflic with quasar data at z=6
-                 OK = .false.
-                 write(*,*) 'Reionization delta_redshift is strange. You have: ',Reion%delta_redshift
-         end if
- 
- 
-       end if
-              
-   end  subroutine Reionization_Validate
- 
- 
-  function Reionization_doptdepth_dz(z)
-    real(dl) :: Reionization_doptdepth_dz
-    real(dl), intent(in) :: z
-    real(dl) a
-    
-    a = 1._dl/(1._dl+z)
-    
-    Reionization_doptdepth_dz = Reionization_xe(a)*ThisReionHist%akthom*dtauda(a)
- 
-  end function Reionization_doptdepth_dz
- 
- function Reionization_GetOptDepth(Reion, ReionHist) 
-  Type(ReionizationParams), target :: Reion
-  Type(ReionizationHistory), target :: ReionHist
-  real(dl) Reionization_GetOptDepth      
-   
-   ThisReion => Reion
-   ThisReionHist => ReionHist
-   Reionization_GetOptDepth = rombint2(Reionization_doptdepth_dz,0.d0,Reionization_maxz,&
-          Reionization_tol, 20, nint(Reionization_maxz/Reion%delta_redshift*5))
- 
- end function Reionization_GetOptDepth
- 
-  subroutine Reionization_zreFromOptDepth(Reion, ReionHist)
-  !General routine to find zre parameter given optical depth
-  !Not used for Rionization_zexp = 1.5
-   Type(ReionizationParams) :: Reion
-   Type(ReionizationHistory) :: ReionHist
-   real(dl) try_b, try_t
-   real(dl) tau
-   integer i
-   
-   try_b = 0
-   try_t = Reionization_maxz
-   i=0
-   do 
-        i=i+1  
-        Reion%redshift = (try_t + try_b)/2
-        call Reionization_SetParamsForZre(Reion,ReionHist)
-        tau = Reionization_GetOptDepth(Reion, ReionHist)
-        
-        if (tau > Reion%optical_depth) then
-                   try_t = Reion%redshift
-           else
-                   try_b = Reion%redshift
-        end if
-        if (abs(try_b - try_t) < 2e-3/Reionization_AccuracyBoost) exit
-        if (i>100) call mpiStop('Reionization_zreFromOptDepth: failed to converge')        
-   end do
-   
-   
-    if (abs(tau - Reion%optical_depth) > 0.002) then
-     write (*,*) 'Reionization_zreFromOptDepth: Did not converge to optical depth'
-     write (*,*) 'tau =',tau, 'optical_depth = ', Reion%optical_depth
-     write (*,*) try_t, try_b
-     call mpiStop()
-   end if
-     
-  end subroutine Reionization_zreFromOptDepth 
- 
- 
-  
-  subroutine Reionization_SetFromOptDepth(Reion, ReionHist)
-   Type(ReionizationParams) :: Reion
-   Type(ReionizationHistory) :: ReionHist
-    
- ! This subroutine calculates the redshift of reionization
- 
- ! This implementation is approximate but quite accurate and fast
- 
-       real(dl) dz, optd
-       real(dl) z, tmp, tmpHe
-       integer na
-       
-       Reion%redshift = 0
- 
-       if (Reion%Reionization .and. Reion%optical_depth /= 0) then
- 
-            !Do binary search to find zre from z
-            !This is general method
-            call Reionization_zreFromOptDepth(Reion, ReionHist)
- 
-         if (.false.) then
-           !Use equivalence with sharp for special case
-             optd=0
-             na=1
-             dz=1._dl/2000/Reionization_AccuracyBoost
-             tmp = dz*Reion%fraction*ThisReionHist%akthom
-             tmpHe = dz*(Reion%fraction+ReionHist%fHe)*ThisReionHist%akthom
-             z=0
-             do while (optd < Reion%optical_depth)
-                 z=na*dz
-                 if (include_helium_fullreion .and. z < helium_fullreion_redshift) then
-                 optd=optd+ tmpHe*dtauda(1._dl/(1._dl+z))
-                 else
-                 optd=optd+tmp*dtauda(1._dl/(1._dl+z))
-                 end if
-                 na=na+1
-             end do
-          end if
-       else
-          Reion%Reionization = .false.
-       end if
-  
-  end  subroutine Reionization_SetFromOptDepth 
- 
- 
- 
- end module Reionization
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/sigma8.f90 cosmomc_sampler/camb/sigma8.f90
*** cosmomc/camb/sigma8.f90	2006-05-29 21:12:48.000000000 +0200
--- cosmomc_sampler/camb/sigma8.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,47 ****
-      !Simple test program to print out sigma_8 as a function of the CDM density
-      program GetSigma8
-         use CAMB
-         implicit none
-         integer i
-     
-         type(CAMBparams)  P !defined in ModelParams in modules.f90
- 
-         call CAMB_SetDefParams(P)
- 
-         P%WantTransfer= .true.
- 
-         P%WantCls = .false.
- 
-         P%omegab  = .045
-         P%omegac  = 0.155
-         P%omegav  = 0.8
-         P%omegan  = 0.0
-         P%H0      = 65
-        
-         P%InitPower%ScalarPowerAmp = 2e-9
-         P%InitPower%nn     = 1 !number of initial power spectra
-         P%InitPower%an(1)  = 1 !scalar spectral index
-         P%InitPower%ant(1) = 0 !Not used here
-         P%InitPower%rat(1) = 1 !ditto
- 
-         !these settings seem good enough for sigma8 to a percent or so
-         P%Transfer%high_precision=.false.
-         P%Transfer%kmax=0.5
-         P%Transfer%k_per_logint=3
-         P%Transfer%num_redshifts=1
-         P%Transfer%redshifts(1)=0
- 
-         do i=1,10
-          P%Omegav=P%Omegav-0.05
-          P%Omegac=P%Omegac+0.05
-         call CAMB_GetResults(P) 
- 
-         !Results are in the Transfer module in modules.f90
-              
-         write (*,*) 'Omc = ',real(P%Omegac),'OmLam=',real(P%Omegav) &
-            , 'sigma_8 = ', real(MT%sigma_8(1,1))
-         end do
- 
-         end program GetSigma8
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/subroutines.f90 cosmomc_sampler/camb/subroutines.f90
*** cosmomc/camb/subroutines.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/subroutines.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1133 ****
- !General numerical routines and global accuracy. Includes modified dverk for CAMB.
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- 
-         subroutine splder(y,dy,n, g)
-         use Precision
- !  Splder fits a cubic spline to y and returns the first derivatives at
- !  the grid points in dy.  Dy is equivalent to a 4th-order Pade
- !  difference formula for dy/di.
-         implicit none
-         integer, intent(in) :: n
-         real(dl), intent(in) :: y(n),g(n)
-         real(dl), intent(out) :: dy(n)
-         integer :: n1, i
-         real(dl), allocatable, dimension(:) :: f
- 
-         allocate(f(n))
-         n1=n-1
- !  Quartic fit to dy/di at boundaries, assuming d3y/di3=0.
-         f(1)=(-10._dl*y(1)+15._dl*y(2)-6._dl*y(3)+y(4))/6._dl
-         f(n)=(10._dl*y(n)-15._dl*y(n1)+6._dl*y(n-2)-y(n-3))/6._dl
- !  Solve the tridiagonal system
- !  dy(i-1)+4*dy(i)+dy(i+1)=3*(y(i+1)-y(i-1)), i=2,3,...,n1,
- !  with dy(1)=f(1), dy(n)=f(n).
-         do i=2,n1
-           f(i)=g(i)*(3._dl*(y(i+1)-y(i-1))-f(i-1))
-         end do
-         dy(n)=f(n)
-         do i=n1,1,-1
-           dy(i)=f(i)-g(i)*dy(i+1)
-         end do
-         deallocate(f)
-         end subroutine splder
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         subroutine splini(g,n)
-         use Precision
- !  Splini must be called before splder to initialize array g in common.
-         implicit none
-         integer, intent(in) :: n
-         real(dl), intent(out):: g(n)
-         integer :: i
- 
-         g(1)=0._dl
-         do i=2,n
-           g(i)=1/(4._dl-g(i-1))
-         end do
-         end subroutine splini
- 
- 
-  !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         function rombint2(f,a,b,tol, maxit, minsteps)
-         use precision
- !  Rombint returns the integral from a to b of using Romberg integration.
- !  The method converges provided that f(x) is continuous in (a,b).
- !  f must be real(dl) and must be declared external in the calling
- !  routine.  tol indicates the desired relative accuracy in the integral.
- 
- ! Modified by AL to specify max iterations and minimum number of steps
- ! (min steps useful to stop wrong results on periodic or sharp functions)
-         implicit none
-         integer, parameter :: MAXITER=20,MAXJ=5
-         dimension g(MAXJ+1)
-         real(dl) f
-         external f
-         real(dl) :: rombint2
-         real(dl), intent(in) :: a,b,tol
-         integer, intent(in):: maxit,minsteps
-      
-         integer :: nint, i, k, jmax, j
-         real(dl) :: h, gmax, error, g, g0, g1, fourj
-       
-         h=0.5d0*(b-a)
-         gmax=h*(f(a)+f(b))
-         g(1)=gmax
-         nint=1
-         error=1.0d20
-         i=0
-         do
-           i=i+1
-           if (i > maxit.or.(i > 5.and.abs(error) < tol) .and. nint > minsteps) exit
- !  Calculate next trapezoidal rule approximation to integral.
-           g0=0._dl
-           do k=1,nint
-             g0=g0+f(a+(k+k-1)*h)
-           end do
-           g0=0.5d0*g(1)+h*g0
-           h=0.5d0*h
-           nint=nint+nint
-           jmax=min(i,MAXJ)
-           fourj=1._dl
-           do j=1,jmax
- !  Use Richardson extrapolation.
-             fourj=4._dl*fourj
-             g1=g0+(g0-g(j))/(fourj-1._dl)
-             g(j)=g0
-             g0=g1
-           end do  
-           if (abs(g0).gt.tol) then
-             error=1._dl-gmax/g0
-           else
-             error=gmax
-           end if
-           gmax=g0
-           g(jmax+1)=g0
-         end do
-   
-         rombint2=g0
-         if (i > maxit .and. abs(error) > tol)  then
-           write(*,*) 'Warning: Rombint failed to converge; '
-           write (*,*)'integral, error, tol:', rombint2,error, tol
-         end if
-         
-         end function rombint2
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         function rombint(f,a,b,tol)
-         use Precision
- !  Rombint returns the integral from a to b of using Romberg integration.
- !  The method converges provided that f(x) is continuous in (a,b).
- !  f must be real(dl) and must be declared external in the calling
- !  routine.  tol indicates the desired relative accuracy in the integral.
- !
-         implicit none
-         integer, parameter :: MAXITER=20
-         integer, parameter :: MAXJ=5
-         dimension g(MAXJ+1)
-         real(dl) f
-         external f
-         real(dl) :: rombint
-         real(dl), intent(in) :: a,b,tol
-         integer :: nint, i, k, jmax, j
-         real(dl) :: h, gmax, error, g, g0, g1, fourj
- !
- 
-         h=0.5d0*(b-a)
-         gmax=h*(f(a)+f(b))
-         g(1)=gmax
-         nint=1
-         error=1.0d20
-         i=0
- 10        i=i+1
-           if (i.gt.MAXITER.or.(i.gt.5.and.abs(error).lt.tol)) &
-             go to 40
- !  Calculate next trapezoidal rule approximation to integral.
-           g0=0._dl
-             do 20 k=1,nint
-             g0=g0+f(a+(k+k-1)*h)
- 20        continue
-           g0=0.5d0*g(1)+h*g0
-           h=0.5d0*h
-           nint=nint+nint
-           jmax=min(i,MAXJ)
-           fourj=1._dl
-             do 30 j=1,jmax
- !  Use Richardson extrapolation.
-             fourj=4._dl*fourj
-             g1=g0+(g0-g(j))/(fourj-1._dl)
-             g(j)=g0
-             g0=g1
- 30        continue
-           if (abs(g0).gt.tol) then
-             error=1._dl-gmax/g0
-           else
-             error=gmax
-           end if
-           gmax=g0
-           g(jmax+1)=g0
-         go to 10
- 40      rombint=g0
-         if (i.gt.MAXITER.and.abs(error).gt.tol)  then
-           write(*,*) 'Warning: Rombint failed to converge; '
-           write (*,*)'integral, error, tol:', rombint,error, tol
-         end if
-         
-         end function rombint
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-         function rombint_obj(obj,f,a,b,tol, maxit)
-         use Precision
- !  Rombint returns the integral from a to b of using Romberg integration.
- !  The method converges provided that f(x) is continuous in (a,b).
- !  f must be real(dl) and must be declared external in the calling
- !  routine.  tol indicates the desired relative accuracy in the integral.
- !
-         implicit none
-         integer, intent(in), optional :: maxit
-         integer :: MAXITER=20
-         integer, parameter :: MAXJ=5
-         dimension g(MAXJ+1)
-         real obj !dummy
-         real(dl) f
-         external f
-         real(dl) :: rombint_obj
-         real(dl), intent(in) :: a,b,tol
-         integer :: nint, i, k, jmax, j
-         real(dl) :: h, gmax, error, g, g0, g1, fourj
- !
- 
-         if (present(maxit)) then
-             MaxIter = maxit
-         end if
-         h=0.5d0*(b-a)
-         gmax=h*(f(obj,a)+f(obj,b))
-         g(1)=gmax
-         nint=1
-         error=1.0d20
-         i=0
- 10        i=i+1
-           if (i.gt.MAXITER.or.(i.gt.5.and.abs(error).lt.tol)) &
-             go to 40
- !  Calculate next trapezoidal rule approximation to integral.
-           g0=0._dl
-             do 20 k=1,nint
-             g0=g0+f(obj,a+(k+k-1)*h)
- 20        continue
-           g0=0.5d0*g(1)+h*g0
-           h=0.5d0*h
-           nint=nint+nint
-           jmax=min(i,MAXJ)
-           fourj=1._dl
-             do 30 j=1,jmax
- !  Use Richardson extrapolation.
-             fourj=4._dl*fourj
-             g1=g0+(g0-g(j))/(fourj-1._dl)
-             g(j)=g0
-             g0=g1
- 30        continue
-           if (abs(g0).gt.tol) then
-             error=1._dl-gmax/g0
-           else
-             error=gmax
-           end if
-           gmax=g0
-           g(jmax+1)=g0
-         go to 10
- 40      rombint_obj=g0
-         if (i.gt.MAXITER.and.abs(error).gt.tol)  then
-           write(*,*) 'Warning: Rombint failed to converge; '
-           write (*,*)'integral, error, tol:', rombint_obj,error, tol
-         end if
-         
-         end function rombint_obj
- 
- 
- !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- ! calculates array of second derivatives used by cubic spline
- ! interpolation. y2 is array of second derivatives, yp1 and ypn are first
- ! derivatives at end points.
- 
- 
-       SUBROUTINE spline(x,y,n,yp1,ypn,y2)
-       use Precision
-       implicit none
-       INTEGER, intent(in) :: n
-       real(dl), intent(in) :: x(n), y(n), yp1, ypn
-       real(dl), intent(out) :: y2(n)
-       INTEGER i,k
-       real(dl) p,qn,sig,un
-       real(dl), dimension(:), allocatable :: u
- 
-        
-       Allocate(u(1:n))
-       if (yp1.gt..99d30) then
-         y2(1)=0._dl
-         u(1)=0._dl
-       else
-         y2(1)=-0.5d0
-         u(1)=(3._dl/(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
-       endif
-       
-       do i=2,n-1
-         sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
-         p=sig*y2(i-1)+2._dl 
-    
-         y2(i)=(sig-1._dl)/p
-       
-          u(i)=(6._dl*((y(i+1)-y(i))/(x(i+ &
-          1)-x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig* &
-          u(i-1))/p
-       end do
-       if (ypn.gt..99d30) then
-         qn=0._dl
-         un=0._dl
-       else
-         qn=0.5d0
-         un=(3._dl/(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
-       endif
-       y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1._dl)
-       do k=n-1,1,-1
-         y2(k)=y2(k)*y2(k+1)+u(k)
-       end do
- 
-       Deallocate(u)
-   
- !  (C) Copr. 1986-92 Numerical Recipes Software =$j*m,).
-       END SUBROUTINE spline
- 
- 
-      SUBROUTINE spline_deriv(x,y,y2,y1,n)
-      !Get derivative y1 given array of x, y and y''
-       use Precision
-       implicit none
-       INTEGER, intent(in) :: n
-       real(dl), intent(in) :: x(n), y(n), y2(n)
-       real(dl), intent(out) :: y1(n)
-       INTEGER i
-       real(dl) dx
-    
- 
-       do i=1, n-1
-            
-          dx = (x(i+1) - x(i))
-          y1(i) = (y(i+1) - y(i))/dx - dx*(2*y2(i) + y2(i+1))/6
-       end do
-        dx = x(n) - x(n-1)
-        y1(n) = (y(n) - y(n-1))/dx + dx* ( y2(i-1)  + 2*y2(i) )/6
- 
-       END SUBROUTINE spline_deriv
- 
-       subroutine spline_integrate(x,y,y2,yint,n)
-        !Cumulative integral of cubic spline
-        use Precision
-        integer, intent(in) :: n
-        real(dl), intent(in) :: x(n), y(n), y2(n)
-        real(dl), intent(out) :: yint(n)
-        real(dl) dx
-        integer i
- 
-        yint(1) = 0
-        do i=2, n
-            
-          dx = (x(i) - x(i-1))
-          yint(i) = yint(i-1) + dx*( (y(i)+y(i-1))/2 - dx**2/24*(y2(i)+y2(i-1))) 
-           
-        end do
-        
-       end subroutine spline_integrate
- 
- 
- 
- !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
- !  this is not the splint given in numerical recipes
- 
- 
-         subroutine splint(y,z,n)
-         use Precision
- !  Splint integrates a cubic spline, providing the output value
- !  z = integral from 1 to n of s(i)di, where s(i) is the spline fit
- !  to y(i).
- !
-         implicit none
-         integer, intent(in) :: n
-         real(dl), intent(in) :: y(n)
-         real(dl), intent(out) :: z
- 
-         integer :: n1
-         real(dl) :: dy1, dyn
- !
-         n1=n-1
- !  Cubic fit to dy/di at boundaries.
- !       dy1=(-11._dl*y(1)+18._dl*y(2)-9._dl*y(3)+2._dl*y(4))/6._dl
-         dy1=0._dl
-         dyn=(11._dl*y(n)-18._dl*y(n1)+9._dl*y(n-2)-2._dl*y(n-3))/6._dl
- !
-         z=0.5d0*(y(1)+y(n))+(dy1-dyn)/12._dl
-         z= z + sum(y(2:n1))
-         end subroutine splint
- 
- 
- !This version is modified to pass an object parameter to the function on each call
- !Fortunately Fortran doesn't do type checking on functions, so we can pretend the
- !passed object parameter (EV) is any type we like. In reality it is just a pointer.
- 
-       subroutine dverk (EV,n, fcn, x, y, xend, tol, ind, c, nw, w)
-       use Precision
-       use AMLUtils
-       integer n, ind, nw, k
-       real(dl) x, y(n), xend, tol, c(*), w(nw,9), temp
-       real EV !It isn't, but as long as it maintains it as a pointer we are OK
- !
- !***********************************************************************
- !                                                                      *
- ! note added 11/14/85.                                                 *
- !                                                                      *
- ! if you discover any errors in this subroutine, please contact        *
- !                                                                      *
- !        kenneth r. jackson                                            *
- !        department of computer science                                *
- !        university of toronto                                         *
- !        toronto, ontario,                                             *
- !        canada   m5s 1a4                                              *
- !                                                                      *
- !        phone: 416-978-7075                                           *
- !                                                                      *
- !        electronic mail:                                              *
- !        uucp:   {cornell,decvax,ihnp4,linus,uw-beaver}!utcsri!krj     *
- !        csnet:  krj@toronto                                           *
- !        arpa:   krj.toronto@csnet-relay                               *
- !        bitnet: krj%toronto@csnet-relay.arpa                          *
- !                                                                      *
- ! dverk is written in fortran 66.                                      *
- !                                                                      *
- ! the constants dwarf and rreb -- c(10) and c(11), respectively -- are *
- ! set for a  vax  in  double  precision.  they  should  be  reset,  as *
- ! described below, if this program is run on another machine.          *
- !                                                                      *
- ! the c array is declared in this subroutine to have one element only, *
- ! although  more  elements  are  referenced  in this subroutine.  this *
- ! causes some compilers to issue warning messages.  there is,  though, *
- ! no  error  provided  c is declared sufficiently large in the calling *
- ! program, as described below.                                         *
- !                                                                      *
- ! the following external statement  for  fcn  was  added  to  avoid  a *
- ! warning  message  from  the  unix  f77 compiler.  the original dverk *
- ! comments and code follow it.                                         *
- !                                                                      *
- !***********************************************************************
- !
-       external fcn
- !
- !***********************************************************************
- !                                                                      *
- !     purpose - this is a runge-kutta  subroutine  based  on  verner's *
- ! fifth and sixth order pair of formulas for finding approximations to *
- ! the solution of  a  system  of  first  order  ordinary  differential *
- ! equations  with  initial  conditions. it attempts to keep the global *
- ! error proportional to  a  tolerance  specified  by  the  user.  (the *
- ! proportionality  depends  on the kind of error control that is used, *
- ! as well as the differential equation and the range of integration.)  *
- !                                                                      *
- !     various options are available to the user,  including  different *
- ! kinds  of  error control, restrictions on step sizes, and interrupts *
- ! which permit the user to examine the state of the  calculation  (and *
- ! perhaps make modifications) during intermediate stages.              *
- !                                                                      *
- !     the program is efficient for non-stiff systems.  however, a good *
- ! variable-order-adams  method  will probably be more efficient if the *
- ! function evaluations are very costly.  such a method would  also  be *
- ! more suitable if one wanted to obtain a large number of intermediate *
- ! solution values by interpolation, as might be the case  for  example *
- ! with graphical output.                                               *
- !                                                                      *
- !                                    hull-enright-jackson   1/10/76    *
- !                                                                      *
- !***********************************************************************
- !                                                                      *
- !     use - the user must specify each of the following                *
- !                                                                      *
- !     n  number of equations                                           *
- !                                                                      *
- !   fcn  name of subroutine for evaluating functions - the  subroutine *
- !           itself must also be provided by the user - it should be of *
- !           the following form                                         *
- !              subroutine fcn(n, x, y, yprime)                         *
- !              integer n                                               *
- !              real(dl) x, y(n), yprime(n)                     *
- !                      *** etc ***                                     *
- !           and it should evaluate yprime, given n, x and y            *
- !                                                                      *
- !     x  independent variable - initial value supplied by user         *
- !                                                                      *
- !     y  dependent variable - initial values of components y(1), y(2), *
- !           ..., y(n) supplied by user                                 *
- !                                                                      *
- !  xend  value of x to which integration is to be carried out - it may *
- !           be less than the initial value of x                        *
- !                                                                      *
- !   tol  tolerance - the subroutine attempts to control a norm of  the *
- !           local  error  in  such  a  way  that  the  global error is *
- !           proportional to tol. in some problems there will be enough *
- !           damping  of  errors, as well as some cancellation, so that *
- !           the global error will be less than tol. alternatively, the *
- !           control   can   be  viewed  as  attempting  to  provide  a *
- !           calculated value of y at xend which is the exact  solution *
- !           to  the  problem y' = f(x,y) + e(x) where the norm of e(x) *
- !           is proportional to tol.  (the norm  is  a  max  norm  with *
- !           weights  that  depend on the error control strategy chosen *
- !           by the user.  the default weight for the k-th component is *
- !           1/max(1,abs(y(k))),  which therefore provides a mixture of *
- !           absolute and relative error control.)                      *
- !                                                                      *
- !   ind  indicator - on initial entry ind must be set equal to  either *
- !           1  or  2. if the user does not wish to use any options, he *
- !           should set ind to 1 - all that remains for the user to  do *
- !           then  is  to  declare c and w, and to specify nw. the user *
- !           may also  select  various  options  on  initial  entry  by *
- !           setting ind = 2 and initializing the first 9 components of *
- !           c as described in the next section.  he may also  re-enter *
- !           the  subroutine  with ind = 3 as mentioned again below. in *
- !           any event, the subroutine returns with ind equal to        *
- !              3 after a normal return                                 *
- !              4, 5, or 6 after an interrupt (see options c(8), c(9))  *
- !              -1, -2, or -3 after an error condition (see below)      *
- !                                                                      *
- !     c  communications vector - the dimension must be greater than or *
- !           equal to 24, unless option c(1) = 4 or 5 is used, in which *
- !           case the dimension must be greater than or equal to n+30   *
- !                                                                      *
- !    nw  first dimension of workspace w -  must  be  greater  than  or *
- !           equal to n                                                 *
- !                                                                      *
- !     w  workspace matrix - first dimension must be nw and second must *
- !           be greater than or equal to 9                              *
- !                                                                      *
- !     the subroutine  will  normally  return  with  ind  =  3,  having *
- ! replaced the initial values of x and y with, respectively, the value *
- ! of xend and an approximation to y at xend.  the  subroutine  can  be *
- ! called  repeatedly  with new values of xend without having to change *
- ! any other argument.  however, changes in tol, or any of the  options *
- ! described below, may also be made on such a re-entry if desired.     *
- !                                                                      *
- !     three error returns are also possible, in which  case  x  and  y *
- ! will be the most recently accepted values -                          *
- !     with ind = -3 the subroutine was unable  to  satisfy  the  error *
- !        requirement  with a particular step-size that is less than or *
- !        equal to hmin, which may mean that tol is too small           *
- !     with ind = -2 the value of hmin  is  greater  than  hmax,  which *
- !        probably  means  that the requested tol (which is used in the *
- !        calculation of hmin) is too small                             *
- !     with ind = -1 the allowed maximum number of fcn evaluations  has *
- !        been  exceeded,  but  this  can only occur if option c(7), as *
- !        described in the next section, has been used                  *
- !                                                                      *
- !     there are several circumstances that will cause the calculations *
- ! to  be  terminated,  along with output of information that will help *
- ! the user determine the cause of  the  trouble.  these  circumstances *
- ! involve  entry with illegal or inconsistent values of the arguments, *
- ! such as attempting a normal  re-entry  without  first  changing  the *
- ! value of xend, or attempting to re-enter with ind less than zero.    *
- !                                                                      *
- !***********************************************************************
- !                                                                      *
- !     options - if the subroutine is entered with ind = 1, the first 9 *
- ! components of the communications vector are initialized to zero, and *
- ! the subroutine uses only default values  for  each  option.  if  the *
- ! subroutine  is  entered  with ind = 2, the user must specify each of *
- ! these 9 components - normally he would first set them all  to  zero, *
- ! and  then  make  non-zero  those  that  correspond to the particular *
- ! options he wishes to select. in any event, options may be changed on *
- ! re-entry  to  the  subroutine  -  but if the user changes any of the *
- ! options, or tol, in the course of a calculation he should be careful *
- ! about  how  such changes affect the subroutine - it may be better to *
- ! restart with ind = 1 or 2. (components 10 to 24 of c are used by the *
- ! program  -  the information is available to the user, but should not *
- ! normally be changed by him.)                                         *
- !                                                                      *
- !  c(1)  error control indicator - the norm of the local error is  the *
- !           max  norm  of  the  weighted  error  estimate  vector, the *
- !           weights being determined according to the value of c(1) -  *
- !              if c(1)=1 the weights are 1 (absolute error control)    *
- !              if c(1)=2 the weights are 1/abs(y(k))  (relative  error *
- !                 control)                                             *
- !              if c(1)=3 the  weights  are  1/max(abs(c(2)),abs(y(k))) *
- !                 (relative  error  control,  unless abs(y(k)) is less *
- !                 than the floor value, abs(c(2)) )                    *
- !              if c(1)=4 the weights are 1/max(abs(c(k+30)),abs(y(k))) *
- !                 (here individual floor values are used)              *
- !              if c(1)=5 the weights are 1/abs(c(k+30))                *
- !              for all other values of c(1), including  c(1) = 0,  the *
- !                 default  values  of  the  weights  are  taken  to be *
- !                 1/max(1,abs(y(k))), as mentioned earlier             *
- !           (in the two cases c(1) = 4 or 5 the user must declare  the *
- !           dimension of c to be at least n+30 and must initialize the *
- !           components c(31), c(32), ..., c(n+30).)                    *
- !                                                                      *
- !  c(2)  floor value - used when the indicator c(1) has the value 3    *
- !                                                                      *
- !  c(3)  hmin specification - if not zero, the subroutine chooses hmin *
- !           to be abs(c(3)) - otherwise it uses the default value      *
- !              10*max(dwarf,rreb*max(weighted norm y/tol,abs(x))),     *
- !           where dwarf is a very small positive  machine  number  and *
- !           rreb is the relative roundoff error bound                  *
- !                                                                      *
- !  c(4)  hstart specification - if not zero, the subroutine  will  use *
- !           an  initial  hmag equal to abs(c(4)), except of course for *
- !           the restrictions imposed by hmin and hmax  -  otherwise it *
- !           uses the default value of hmax*(tol)**(1/6)                *
- !                                                                      *
- !  c(5)  scale specification - this is intended to be a measure of the *
- !           scale of the problem - larger values of scale tend to make *
- !           the method more reliable, first  by  possibly  restricting *
- !           hmax  (as  described  below) and second, by tightening the *
- !           acceptance requirement - if c(5) is zero, a default  value *
- !           of  1  is  used.  for  linear  homogeneous  problems  with *
- !           constant coefficients, an appropriate value for scale is a *
- !           norm  of  the  associated  matrix.  for other problems, an *
- !           approximation to  an  average  value  of  a  norm  of  the *
- !           jacobian along the trajectory may be appropriate           *
- !                                                                      *
- !  c(6)  hmax specification - four cases are possible                  *
- !           if c(6).ne.0 and c(5).ne.0, hmax is taken to be            *
- !              min(abs(c(6)),2/abs(c(5)))                              *
- !           if c(6).ne.0 and c(5).eq.0, hmax is taken to be  abs(c(6)) *
- !           if c(6).eq.0 and c(5).ne.0, hmax is taken to be            *
- !              2/abs(c(5))                                             *
- !           if c(6).eq.0 and c(5).eq.0, hmax is given a default  value *
- !              of 2                                                    *
- !                                                                      *
- !  c(7)  maximum number of function evaluations  -  if  not  zero,  an *
- !           error  return with ind = -1 will be caused when the number *
- !           of function evaluations exceeds abs(c(7))                  *
- !                                                                      *
- !  c(8)  interrupt number  1  -  if  not  zero,  the  subroutine  will *
- !           interrupt   the  calculations  after  it  has  chosen  its *
- !           preliminary value of hmag, and just before choosing htrial *
- !           and  xtrial  in  preparation for taking a step (htrial may *
- !           differ from hmag in sign, and may  require  adjustment  if *
- !           xend  is  near) - the subroutine returns with ind = 4, and *
- !           will resume calculation at the point  of  interruption  if *
- !           re-entered with ind = 4                                    *
- !                                                                      *
- !  c(9)  interrupt number  2  -  if  not  zero,  the  subroutine  will *
- !           interrupt   the  calculations  immediately  after  it  has *
- !           decided whether or not to accept the result  of  the  most *
- !           recent  trial step, with ind = 5 if it plans to accept, or *
- !           ind = 6 if it plans to reject -  y(*)  is  the  previously *
- !           accepted  result, while w(*,9) is the newly computed trial *
- !           value, and w(*,2) is the unweighted error estimate vector. *
- !           the  subroutine  will  resume calculations at the point of *
- !           interruption on re-entry with ind = 5 or 6. (the user  may *
- !           change ind in this case if he wishes, for example to force *
- !           acceptance of a step that would otherwise be rejected,  or *
- !           vice versa. he can also restart with ind = 1 or 2.)        *
- !                                                                      *
- !***********************************************************************
- !                                                                      *
- !  summary of the components of the communications vector              *
- !                                                                      *
- !     prescribed at the option       determined by the program         *
- !           of the user                                                *
- !                                                                      *
- !                                    c(10) rreb(rel roundoff err bnd)  *
- !     c(1) error control indicator   c(11) dwarf (very small mach no)  *
- !     c(2) floor value               c(12) weighted norm y             *
- !     c(3) hmin specification        c(13) hmin                        *
- !     c(4) hstart specification      c(14) hmag                        *
- !     c(5) scale specification       c(15) scale                       *
- !     c(6) hmax specification        c(16) hmax                        *
- !     c(7) max no of fcn evals       c(17) xtrial                      *
- !     c(8) interrupt no 1            c(18) htrial                      *
- !     c(9) interrupt no 2            c(19) est                         *
- !                                    c(20) previous xend               *
- !                                    c(21) flag for xend               *
- !                                    c(22) no of successful steps      *
- !                                    c(23) no of successive failures   *
- !                                    c(24) no of fcn evals             *
- !                                                                      *
- !  if c(1) = 4 or 5, c(31), c(32), ... c(n+30) are floor values        *
- !                                                                      *
- !***********************************************************************
- !                                                                      *
- !  an overview of the program                                          *
- !                                                                      *
- !     begin initialization, parameter checking, interrupt re-entries   *
- !  ......abort if ind out of range 1 to 6                              *
- !  .     cases - initial entry, normal re-entry, interrupt re-entries  *
- !  .     case 1 - initial entry (ind .eq. 1 or 2)                      *
- !  v........abort if n.gt.nw or tol.le.0                               *
- !  .        if initial entry without options (ind .eq. 1)              *
- !  .           set c(1) to c(9) equal to zero                          *
- !  .        else initial entry with options (ind .eq. 2)               *
- !  .           make c(1) to c(9) non-negative                          *
- !  .           make floor values non-negative if they are to be used   *
- !  .        end if                                                     *
- !  .        initialize rreb, dwarf, prev xend, flag, counts            *
- !  .     case 2 - normal re-entry (ind .eq. 3)                         *
- !  .........abort if xend reached, and either x changed or xend not    *
- !  .        re-initialize flag                                         *
- !  .     case 3 - re-entry following an interrupt (ind .eq. 4 to 6)    *
- !  v        transfer control to the appropriate re-entry point.......  *
- !  .     end cases                                                  .  *
- !  .  end initialization, etc.                                      .  *
- !  .                                                                v  *
- !  .  loop through the following 4 stages, once for each trial step .  *
- !  .     stage 1 - prepare                                          .  *
- !***********error return (with ind=-1) if no of fcn evals too great .  *
- !  .        calc slope (adding 1 to no of fcn evals) if ind .ne. 6  .  *
- !  .        calc hmin, scale, hmax                                  .  *
- !***********error return (with ind=-2) if hmin .gt. hmax            .  *
- !  .        calc preliminary hmag                                   .  *
- !***********interrupt no 1 (with ind=4) if requested.......re-entry.v  *
- !  .        calc hmag, xtrial and htrial                            .  *
- !  .     end stage 1                                                .  *
- !  v     stage 2 - calc ytrial (adding 7 to no of fcn evals)        .  *
- !  .     stage 3 - calc the error estimate                          .  *
- !  .     stage 4 - make decisions                                   .  *
- !  .        set ind=5 if step acceptable, else set ind=6            .  *
- !***********interrupt no 2 if requested....................re-entry.v  *
- !  .        if step accepted (ind .eq. 5)                              *
- !  .           update x, y from xtrial, ytrial                         *
- !  .           add 1 to no of successful steps                         *
- !  .           set no of successive failures to zero                   *
- !**************return(with ind=3, xend saved, flag set) if x .eq. xend *
- !  .        else step not accepted (ind .eq. 6)                        *
- !  .           add 1 to no of successive failures                      *
- !**************error return (with ind=-3) if hmag .le. hmin            *
- !  .        end if                                                     *
- !  .     end stage 4                                                   *
- !  .  end loop                                                         *
- !  .                                                                   *
- !  begin abort action                                                  *
- !     output appropriate  message  about  stopping  the  calculations, *
- !        along with values of ind, n, nw, tol, hmin,  hmax,  x,  xend, *
- !        previous xend,  no of  successful  steps,  no  of  successive *
- !        failures, no of fcn evals, and the components of y            *
- !     stop                                                             *
- !  end abort action                                                    *
- !                                                                      *
- !***********************************************************************
- !
- !     ******************************************************************
- !     * begin initialization, parameter checking, interrupt re-entries *
- !     ******************************************************************
- !
- !  ......abort if ind out of range 1 to 6
-          if (ind.lt.1 .or. ind.gt.6) go to 500
- !
- !        cases - initial entry, normal re-entry, interrupt re-entries
- !         go to (5, 5, 45, 1111, 2222, 2222), ind
-          if (ind==3) goto 45
-          if (ind==4) goto 1111
-          if (ind==5 .or. ind==6) goto 2222
- 
- !        case 1 - initial entry (ind .eq. 1 or 2)
- !  .........abort if n.gt.nw or tol.le.0
-             if (n.gt.nw .or. tol.le.0._dl) go to 500
-             if (ind.eq. 2) go to 15
- !              initial entry without options (ind .eq. 1)
- !              set c(1) to c(9) equal to 0
-                do k = 1, 9
-                   c(k) = 0._dl
-                end do
-                go to 35
-    15       continue
- !              initial entry with options (ind .eq. 2)
- !              make c(1) to c(9) non-negative
-                do k = 1, 9
-                   c(k) = dabs(c(k))
-                end do
- !              make floor values non-negative if they are to be used
-                if (c(1).ne.4._dl .and. c(1).ne.5._dl) go to 30
-                   do k = 1, n
-                      c(k+30) = dabs(c(k+30))
-                   end do
-    30          continue
-    35       continue
- !           initialize rreb, dwarf, prev xend, flag, counts
-             c(10) = 2._dl**(-56)
-             c(11) = 1.d-35
- !           set previous xend initially to initial value of x
-             c(20) = x
-             do k = 21, 24
-                c(k) = 0._dl
-             end do
-             go to 50
- !        case 2 - normal re-entry (ind .eq. 3)
- !  .........abort if xend reached, and either x changed or xend not
-    45       if (c(21).ne.0._dl .and. &
-                               (x.ne.c(20) .or. xend.eq.c(20))) go to 500
- !           re-initialize flag
-             c(21) = 0._dl
-             go to 50
- !        case 3 - re-entry following an interrupt (ind .eq. 4 to 6)
- !           transfer control to the appropriate re-entry point..........
- !           this has already been handled by the computed go to        .
- !        end cases                                                     v
-    50    continue
- !
- !     end initialization, etc.
- !
- !     ******************************************************************
- !     * loop through the following 4 stages, once for each trial  step *
- !     * until the occurrence of one of the following                   *
- !     *    (a) the normal return (with ind .eq. 3) on reaching xend in *
- !     *        stage 4                                                 *
- !     *    (b) an error return (with ind .lt. 0) in stage 1 or stage 4 *
- !     *    (c) an interrupt return (with ind  .eq.  4,  5  or  6),  if *
- !     *        requested, in stage 1 or stage 4                        *
- !     ******************************************************************
- !
- 99999 continue
- !
- !        ***************************************************************
- !        * stage 1 - prepare - do calculations of  hmin,  hmax,  etc., *
- !        * and some parameter  checking,  and  end  up  with  suitable *
- !        * values of hmag, xtrial and htrial in preparation for taking *
- !        * an integration step.                                        *
- !        ***************************************************************
- !
- !***********error return (with ind=-1) if no of fcn evals too great
-             if (c(7).eq.0._dl .or. c(24).lt.c(7)) go to 100
-                ind = -1
-                return
-   100       continue
- !
- !           calculate slope (adding 1 to no of fcn evals) if ind .ne. 6
-             if (ind .eq. 6) go to 105
-                call fcn(EV,n, x, y, w(1,1))
-                c(24) = c(24) + 1._dl
-   105       continue
- !
- !           calculate hmin - use default unless value prescribed
-             c(13) = c(3)
-             if (c(3) .ne. 0._dl) go to 165
- !              calculate default value of hmin
- !              first calculate weighted norm y - c(12) - as specified
- !              by the error control indicator c(1)
-                temp = 0._dl
-                if (c(1) .ne. 1._dl) go to 115
- !                 absolute error control - weights are 1
-                   do 110 k = 1, n
-                      temp = dmax1(temp, dabs(y(k)))
-   110             continue
-                   c(12) = temp
-                   go to 160
-   115          if (c(1) .ne. 2._dl) go to 120
- !                 relative error control - weights are 1/dabs(y(k)) so
- !                 weighted norm y is 1
-                   c(12) = 1._dl
-                   go to 160
-   120          if (c(1) .ne. 3._dl) go to 130
- !                 weights are 1/max(c(2),abs(y(k)))
-                   do 125 k = 1, n
-                      temp = dmax1(temp, dabs(y(k))/c(2))
-   125             continue
-                   c(12) = dmin1(temp, 1._dl)
-                   go to 160
-   130          if (c(1) .ne. 4._dl) go to 140
- !                 weights are 1/max(c(k+30),abs(y(k)))
-                   do 135 k = 1, n
-                      temp = dmax1(temp, dabs(y(k))/c(k+30))
-   135             continue
-                   c(12) = dmin1(temp, 1._dl)
-                   go to 160
-   140          if (c(1) .ne. 5._dl) go to 150
- !                 weights are 1/c(k+30)
-                   do 145 k = 1, n
-                      temp = dmax1(temp, dabs(y(k))/c(k+30))
-   145             continue
-                   c(12) = temp
-                   go to 160
-   150          continue
- !                 default case - weights are 1/max(1,abs(y(k)))
-                   do 155 k = 1, n
-                      temp = dmax1(temp, dabs(y(k)))
-   155             continue
-                   c(12) = dmin1(temp, 1._dl)
-   160          continue
-                c(13) = 10._dl*dmax1(c(11),c(10)*dmax1(c(12)/tol,dabs(x)))
-   165       continue
- !
- !           calculate scale - use default unless value prescribed
-             c(15) = c(5)
-             if (c(5) .eq. 0._dl) c(15) = 1._dl
- !
- !           calculate hmax - consider 4 cases
- !           case 1 both hmax and scale prescribed
-                if (c(6).ne.0._dl .and. c(5).ne.0._dl) &
-                                           c(16) = dmin1(c(6), 2._dl/c(5))
- !           case 2 - hmax prescribed, but scale not
-                if (c(6).ne.0._dl .and. c(5).eq.0._dl) c(16) = c(6)
- !           case 3 - hmax not prescribed, but scale is
-                if (c(6).eq.0._dl .and. c(5).ne.0._dl) c(16) = 2._dl/c(5)
- !           case 4 - neither hmax nor scale is provided
-                if (c(6).eq.0._dl .and. c(5).eq.0._dl) c(16) = 2._dl
- !
- !***********error return (with ind=-2) if hmin .gt. hmax
-             if (c(13) .le. c(16)) go to 170
-                ind = -2
-                return
-   170       continue
- !
- !           calculate preliminary hmag - consider 3 cases
-             if (ind .gt. 2) go to 175
- !           case 1 - initial entry - use prescribed value of hstart, if
- !              any, else default
-                c(14) = c(4)
-                if (c(4) .eq. 0._dl) c(14) = c(16)*tol**(1._dl/6._dl)
-                go to 185
-   175       if (c(23) .gt. 1._dl) go to 180
- !           case 2 - after a successful step, or at most  one  failure,
- !              use min(2, .9*(tol/est)**(1/6))*hmag, but avoid possible
- !              overflow. then avoid reduction by more than half.
-                temp = 2._dl*c(14)
-                if (tol .lt. (2._dl/.9d0)**6*c(19)) &
-                        temp = .9d0*(tol/c(19))**(1._dl/6._dl)*c(14)
-                c(14) = dmax1(temp, .5d0*c(14))
-                go to 185
-   180       continue
- !           case 3 - after two or more successive failures
-                c(14) = .5d0*c(14)
-   185       continue
- !
- !           check against hmax
-             c(14) = dmin1(c(14), c(16))
- !
- !           check against hmin
-             c(14) = dmax1(c(14), c(13))
- !
- !***********interrupt no 1 (with ind=4) if requested
-             if (c(8) .eq. 0._dl) go to 1111
-                ind = 4
-                return
- !           resume here on re-entry with ind .eq. 4   ........re-entry..
-  1111       continue
- !
- !           calculate hmag, xtrial - depending on preliminary hmag, xend
-             if (c(14) .ge. dabs(xend - x)) go to 190
- !              do not step more than half way to xend
-                c(14) = dmin1(c(14), .5d0*dabs(xend - x))
-                c(17) = x + dsign(c(14), xend - x)
-                go to 195
-   190       continue
- !              hit xend exactly
-                c(14) = dabs(xend - x)
-                c(17) = xend
-   195       continue
- !
- !           calculate htrial
-             c(18) = c(17) - x
- !
- !        end stage 1
- !
- !        ***************************************************************
- !        * stage 2 - calculate ytrial (adding 7 to no of  fcn  evals). *
- !        * w(*,2), ... w(*,8)  hold  intermediate  results  needed  in *
- !        * stage 3. w(*,9) is temporary storage until finally it holds *
- !        * ytrial.                                                     *
- !        ***************************************************************
- !
-             temp = c(18)/1398169080000._dl
- !
-             do 200 k = 1, n
-                w(k,9) = y(k) + temp*w(k,1)*233028180000._dl
-   200       continue
-             call fcn(EV,n, x + c(18)/6._dl, w(1,9), w(1,2))
- !
-             do 205 k = 1, n
-                w(k,9) = y(k) + temp*(   w(k,1)*74569017600._dl &
-                                       + w(k,2)*298276070400._dl  )
-   205       continue
-             call fcn(EV,n, x + c(18)*(4._dl/15._dl), w(1,9), w(1,3))
- !
-             do 210 k = 1, n
-                w(k,9) = y(k) + temp*(   w(k,1)*1165140900000._dl &
-                                       - w(k,2)*3728450880000._dl &
-                                       + w(k,3)*3495422700000._dl )
-   210       continue
-             call fcn(EV,n, x + c(18)*(2._dl/3._dl), w(1,9), w(1,4))
- !
-             do 215 k = 1, n
-                w(k,9) = y(k) + temp*( - w(k,1)*3604654659375._dl &
-                                       + w(k,2)*12816549900000._dl &
-                                       - w(k,3)*9284716546875._dl &
-                                       + w(k,4)*1237962206250._dl )
-   215       continue
-             call fcn(EV,n, x + c(18)*(5._dl/6._dl), w(1,9), w(1,5))
- !
-             do 220 k = 1, n
-                w(k,9) = y(k) + temp*(   w(k,1)*3355605792000._dl &
-                                       - w(k,2)*11185352640000._dl &
-                                       + w(k,3)*9172628850000._dl &
-                                       - w(k,4)*427218330000._dl &
-                                       + w(k,5)*482505408000._dl  )
-   220       continue
-             call fcn(EV,n, x + c(18), w(1,9), w(1,6))
- !
-             do 225 k = 1, n
-                w(k,9) = y(k) + temp*( - w(k,1)*770204740536._dl &
-                                       + w(k,2)*2311639545600._dl &
-                                       - w(k,3)*1322092233000._dl &
-                                       - w(k,4)*453006781920._dl &
-                                       + w(k,5)*326875481856._dl  )
-   225       continue
-             call fcn(EV,n, x + c(18)/15._dl, w(1,9), w(1,7))
- !
-             do 230 k = 1, n
-                w(k,9) = y(k) + temp*(   w(k,1)*2845924389000._dl &
-                                       - w(k,2)*9754668000000._dl &
-                                       + w(k,3)*7897110375000._dl &
-                                       - w(k,4)*192082660000._dl &
-                                       + w(k,5)*400298976000._dl &
-                                       + w(k,7)*201586000000._dl  )
-   230       continue
-             call fcn(EV,n, x + c(18), w(1,9), w(1,8))
- !
- !           calculate ytrial, the extrapolated approximation and store
- !              in w(*,9)
-             do 235 k = 1, n
-                w(k,9) = y(k) + temp*(   w(k,1)*104862681000._dl &
-                                       + w(k,3)*545186250000._dl &
-                                       + w(k,4)*446637345000._dl &
-                                       + w(k,5)*188806464000._dl &
-                                       + w(k,7)*15076875000._dl &
-                                       + w(k,8)*97599465000._dl   )
-   235       continue
- !
- !           add 7 to the no of fcn evals
-             c(24) = c(24) + 7._dl
- !
- !        end stage 2
- !
- !        ***************************************************************
- !        * stage 3 - calculate the error estimate est. first calculate *
- !        * the  unweighted  absolute  error  estimate vector (per unit *
- !        * step) for the unextrapolated approximation and store it  in *
- !        * w(*,2).  then  calculate the weighted max norm of w(*,2) as *
- !        * specified by the error  control  indicator  c(1).  finally, *
- !        * modify  this result to produce est, the error estimate (per *
- !        * unit step) for the extrapolated approximation ytrial.       *
- !        ***************************************************************
- !
- !           calculate the unweighted absolute error estimate vector
-             do 300 k = 1, n
-                w(k,2) = (   w(k,1)*8738556750._dl &
-                           + w(k,3)*9735468750._dl &
-                           - w(k,4)*9709507500._dl &
-                           + w(k,5)*8582112000._dl &
-                           + w(k,6)*95329710000._dl &
-                           - w(k,7)*15076875000._dl &
-                           - w(k,8)*97599465000._dl)/1398169080000._dl
-   300       continue
- !
- !           calculate the weighted max norm of w(*,2) as specified by
- !           the error control indicator c(1)
-             temp = 0._dl
-             if (c(1) .ne. 1._dl) go to 310
- !              absolute error control
-                do 305 k = 1, n
-                   temp = dmax1(temp,dabs(w(k,2)))
-   305          continue
-                go to 360
-   310       if (c(1) .ne. 2._dl) go to 320
- !              relative error control
-                do 315 k = 1, n
-                   temp = dmax1(temp, dabs(w(k,2)/y(k)))
-   315          continue
-                go to 360
-   320       if (c(1) .ne. 3._dl) go to 330
- !              weights are 1/max(c(2),abs(y(k)))
-                do 325 k = 1, n
-                   temp = dmax1(temp, dabs(w(k,2)) &
-                                    / dmax1(c(2), dabs(y(k))) )
-   325          continue
-                go to 360
-   330       if (c(1) .ne. 4._dl) go to 340
- !              weights are 1/max(c(k+30),abs(y(k)))
-                do 335 k = 1, n
-                   temp = dmax1(temp, dabs(w(k,2)) &
-                                    / dmax1(c(k+30), dabs(y(k))) )
-   335          continue
-                go to 360
-   340       if (c(1) .ne. 5._dl) go to 350
- !              weights are 1/c(k+30)
-                do 345 k = 1, n
-                   temp = dmax1(temp, dabs(w(k,2)/c(k+30)))
-   345          continue
-                go to 360
-   350       continue
- !              default case - weights are 1/max(1,abs(y(k)))
-                do 355 k = 1, n
-                   temp = dmax1(temp, dabs(w(k,2)) &
-                                    / dmax1(1._dl, dabs(y(k))) )
-   355          continue
-   360       continue
- !
- !           calculate est - (the weighted max norm of w(*,2))*hmag*scale
- !              - est is intended to be a measure of the error  per  unit
- !              step in ytrial
-             c(19) = temp*c(14)*c(15)
- !
- !        end stage 3
- !
- !        ***************************************************************
- !        * stage 4 - make decisions.                                   *
- !        ***************************************************************
- !
- !           set ind=5 if step acceptable, else set ind=6
-             ind = 5
-             if (c(19) .gt. tol) ind = 6
- !
- !***********interrupt no 2 if requested
-             if (c(9) .eq. 0._dl) go to 2222
-                return
- !           resume here on re-entry with ind .eq. 5 or 6   ...re-entry..
-  2222       continue
- !
-             if (ind .eq. 6) go to 410
- !              step accepted (ind .eq. 5), so update x, y from xtrial,
- !                 ytrial, add 1 to the no of successful steps, and set
- !                 the no of successive failures to zero
-                x = c(17)
-                do 400 k = 1, n
-                   y(k) = w(k,9)
-   400          continue
-                c(22) = c(22) + 1._dl
-                c(23) = 0._dl
- !**************return(with ind=3, xend saved, flag set) if x .eq. xend
-                if (x .ne. xend) go to 405
-                   ind = 3
-                   c(20) = xend
-                   c(21) = 1._dl
-                   return
-   405          continue
-                go to 420
-   410       continue
- !              step not accepted (ind .eq. 6), so add 1 to the no of
- !                 successive failures
-                c(23) = c(23) + 1._dl
- !**************error return (with ind=-3) if hmag .le. hmin
-                if (c(14) .gt. c(13)) go to 415
-                   ind = -3
-                   return
-   415          continue
-   420       continue
- !
- !        end stage 4
- !
-       go to 99999
- !     end loop
- !
- !  begin abort action
-   500 continue
- !
- 
-       write (*,*) 'Error in dverk, x =',x, 'xend=', xend
-       call MpiStop()
- !
- !  end abort action
- !
-       end subroutine dverk
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/tester.f90 cosmomc_sampler/camb/tester.f90
*** cosmomc/camb/tester.f90	2005-03-31 01:37:14.000000000 +0200
--- cosmomc_sampler/camb/tester.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,59 ****
- !Simple program to get the scalar and tensor Cls, and print them out (and the sum)
- 
-       program tester
-        use CAMB
-         implicit none
-         integer l
-         real(dl) ratio
- 
-         type(CAMBparams)  P !defined in ModelParams in modules.f90
- 
-         
-         call CAMB_SetDefParams(P)
- 
-         P%omegab  = .045
-         P%omegac  = 0.355
-         P%omegav  = 0.6
-         P%omegan  = 0.0
-         P%H0      = 65
-    
-         P%InitPower%nn     = 1 !number of initial power spectra
-         P%InitPower%an(1)  = 1 !scalar spectral index
-         P%InitPower%ant(1) = 0 !tensor spectra index
-         P%InitPower%rat(1) = 1 !ratio of initial amplitudes
-          !actually we don't use this here since we generate the Cls separately
-          !so set to 1, and then put in the ratio after calculating the Cls
- 
-  
-         P%OutputNormalization = outNone
-       
-         !Generate scalars first so that start with maximum Max_l that is used
-         P%WantScalars = .true.
-         P%WantTensors = .true.
-       
-         P%Max_l=1500
-         P%Max_eta_k=3000
-         P%Max_l_tensor=200
-         P%Max_eta_k_tensor=500
- 
-         P%AccuratePolarization = .false. !We are only interested in the temperature here
- 
-         call CAMB_GetResults(P) 
- 
-         ratio =0.1
- 
-         do l=2,P%Max_l
-            !print out scalar and tensor temperature, then sum
-            if (l <= P%Max_l_tensor) then
-               !The indices of the Cl_xxx arrays are l, initial power spectrum index, Cl type
-              write(*,'(1I5,3E15.5)') l, Cl_scalar(l,1, C_Temp), ratio*Cl_tensor(l,1,CT_Temp), &
-                    ratio*Cl_tensor(l,1,C_Temp)+Cl_scalar(l,1,C_Temp) 
-            else
-              write(*,'(1I5,3E15.5)') l,  Cl_scalar(l,1, C_Temp),0._dl,Cl_scalar(l,1,C_Temp) 
-            end if
-         end do   
- 
- 
-         end program Tester
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/utils.F90 cosmomc_sampler/camb/utils.F90
*** cosmomc/camb/utils.F90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_sampler/camb/utils.F90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,2756 ****
- !Module of generally useful routines and definitions
- !Antony Lewis, http://cosmologist.info/
- 
- !April 2006: fix to TList_RealArr_Thin
- !March 2008: fix to Ranges
- !This version Mar 2008
- 
-  module Ranges
-  !A collection of ranges, consisting of sections of minimum step size
-   implicit none
- 
-   integer, parameter :: Max_Ranges = 100
-   double precision, parameter :: RangeTol = 0.1d0 
-     !fraction of bin width we are prepared for merged bin widths to increase by
- 
-   Type Region
-     integer start_index
-     integer steps
-     logical :: IsLog
-     double precision Low, High
-     double precision delta
-     double precision delta_max, delta_min !for log spacing, the non-log max and min step size
-   end Type Region
- 
-   Type Regions
-     
-      integer count
-      integer npoints
-      double precision Lowest, Highest
-      Type(Region) :: R(Max_ranges)
-      logical :: has_dpoints
-      double precision, dimension(:), pointer :: points, dpoints
-        !dpoints is (points(i+1)-points(i-1))/2
-  
-   end Type Regions
- 
-  contains
-   
-    subroutine Ranges_Init(R)
-     Type(Regions) R
- 
-      call Ranges_Free(R)
-     
-    end  subroutine Ranges_Init
- 
-    subroutine Ranges_Free(R)
-     Type(Regions) R
-     integer status     
- 
-      deallocate(R%points,stat = status)
-      deallocate(R%dpoints,stat = status)
-      call Ranges_Nullify(R)
-     
-    end  subroutine Ranges_Free
- 
-     
-   subroutine Ranges_Nullify(R)
-    Type(Regions) R
-   
-      nullify(R%points)
-      nullify(R%dpoints)
-      R%count = 0
-      R%npoints = 0
-      R%has_dpoints = .false.
-    
- 
-   end subroutine Ranges_Nullify
- 
-    function Ranges_IndexOf(Reg, tau) result(pointstep)
-       Type(Regions), intent(in), target :: Reg
-       Type(Region), pointer :: AReg
-       double precision :: tau
-       integer pointstep
-       integer i
- 
-       
-       pointstep=0
-       do i=1,Reg%count
-           AReg => Reg%R(i)
- 
-           if (tau < AReg%High .and. tau >= AReg%Low) then
-              if (AReg%IsLog) then
-               pointstep = AReg%start_index + int( log(tau/AReg%Low)/AReg%delta)
-               else
-               pointstep = AReg%start_index + int(( tau - AReg%Low)/AReg%delta)
-              end if
-              return
-           end if
- 
-       end do
- 
-       if (tau >= Reg%Highest) then
-          pointstep = Reg%npoints
-       else
-        write (*,*) 'Ranges_IndexOf: value out of range'
-        stop 
-       end if
- 
-    end function Ranges_IndexOf
- 
-      
-    subroutine Ranges_GetArray(Reg, want_dpoints)
-      Type(Regions), target :: Reg
-      Type(Region), pointer :: AReg
-      logical, intent(in), optional :: want_dpoints 
-      integer status,i,j,ix     
-      
- 
-      if (present(want_dpoints)) then
-       Reg%has_dpoints = want_dpoints
-      else
-       Reg%has_dpoints = .true.
-      end if
- 
-      deallocate(Reg%points,stat = status)
-      allocate(Reg%points(Reg%npoints)) 
- 
-      ix=0   
-      do i=1, Reg%count
-        AReg => Reg%R(i)
-        do j = 0, AReg%steps-1
-         ix=ix+1
-         if (AReg%IsLog) then
-          Reg%points(ix) = AReg%Low*exp(j*AReg%delta)
-         else
-          Reg%points(ix) = AReg%Low + AReg%delta*j
-         end if
-        end do
-      end do
-      ix =ix+1
-      Reg%points(ix) = Reg%Highest
-      if (ix /= Reg%npoints) stop 'Ranges_GetArray: ERROR'
- 
-      if (Reg%has_dpoints) call Ranges_Getdpoints(Reg)
- 
-    end subroutine Ranges_GetArray
- 
- 
-    subroutine Ranges_Getdpoints(Reg, half_ends)
-       Type(Regions), target :: Reg
-       logical, intent(in), optional :: half_ends
-       integer i, status
-       logical halfs
- 
-       if (present(half_ends)) then
-         halfs = half_ends
-       else
-         halfs = .true.
-       end if
-        
-       deallocate(Reg%dpoints,stat = status)
-       allocate(Reg%dpoints(Reg%npoints)) 
- 
-       do i=2, Reg%npoints-1
-         Reg%dpoints(i) = (Reg%points(i+1) - Reg%points(i-1))/2
-       end do
-       if (halfs) then
-        Reg%dpoints(1) = (Reg%points(2) - Reg%points(1))/2
-        Reg%dpoints(Reg%npoints) = (Reg%points(Reg%npoints) - Reg%points(Reg%npoints-1))/2
-       else
-        Reg%dpoints(1) = (Reg%points(2) - Reg%points(1))
-        Reg%dpoints(Reg%npoints) = (Reg%points(Reg%npoints) - Reg%points(Reg%npoints-1))
-      end if
-    end subroutine Ranges_Getdpoints
- 
- 
-    subroutine Ranges_Add_delta(Reg, t_start, t_end, t_approx_delta, IsLog)
-      Type(Regions), target :: Reg
-      logical, intent(in), optional :: IsLog
-      double precision, intent(in) :: t_start, t_end, t_approx_delta
-      integer n
-      logical :: WantLog
- 
-      if (present(IsLog)) then
-         WantLog = IsLog      
-      else
-         WantLog = .false.    
-      end if
-      
-      if (t_end <= t_start) & 
-        stop 'Ranges_Add_delta: end must be larger than start'
-      if (t_approx_delta <=0) stop 'Ranges_Add_delta: delta must be > 0'
- 
-      if (WantLog) then
-       n  = max(1,int(log(t_end/t_start)/t_approx_delta + 1.d0 - RangeTol))
-      else
-       n  = max(1,int((t_end-t_start)/t_approx_delta + 1.d0 - RangeTol))
-      end if
-      call Ranges_Add(Reg,t_start, t_end, n, WantLog)
-        
-    end subroutine Ranges_Add_delta
- 
- 
-    subroutine Ranges_Add(Reg, t_start, t_end, nstep, IsLog)
-      Type(Regions), target :: Reg
-      logical, intent(in), optional :: IsLog
-      double precision, intent(in) :: t_start, t_end
-      integer, intent(in) :: nstep
-      Type(Region), pointer :: AReg, LastReg
-      Type(Region), target :: NewRegions(Max_Ranges)
-      double precision EndPoints(0:Max_Ranges*2)
-      integer ixin, nreg, ix, i,j, nsteps
-      double precision delta
-      logical WantLog
-      double precision min_request, max_request, min_log_step, max_log_step, diff, max_delta
-      double precision RequestDelta(Max_Ranges)
- 
-      if (present(IsLog)) then
-       WantLog = IsLog
-      else
-       WantLog = .false.
-      end if
- 
-      if (WantLog) then
-       delta = log(t_end/t_start) / nstep
-      else
-       delta = (t_end - t_start) / nstep
-      end if
- 
-      if (t_end <= t_start) stop 'Ranges_Add: end must be larger than start'
-      if (nstep <=0) stop 'Ranges_Add: nstep must be > 0'
-      if (Reg%Count>= Max_Ranges) stop 'Ranges_Add: Increase Max_Ranges'
- 
- !avoid IBM compiler bug, from Angel de Vicente
- !    if (Reg%count > 0) NewRegions(1:Reg%count) = Reg%R(1:Reg%count)
-      if (Reg%count > 0) THEN
-          DO i=1,Reg%count
-          NewRegions(i) = Reg%R(i)
-          END DO
-      END IF
-      nreg = Reg%count + 1
-      AReg=> NewRegions(nreg)
-      AReg%Low = t_start
-      AReg%High = t_end
-      AReg%delta = delta
-      AReg%steps = nstep
-      AReg%IsLog = WantLog 
- 
- !Get end point in order
-      ix = 0
-      do i=1, nreg
- 
-        AReg => NewRegions(i)
-        if (ix==0) then
-           ix = 1
-           EndPoints(ix) = AReg%Low
-           ix = 2
-           EndPoints(ix) = AReg%High
-        else
-         ixin = ix
-         do j=1,ixin
-          if (AReg%Low < EndPoints(j)) then
-            EndPoints(j+1:ix+1) = EndPoints(j:ix)
-            EndPoints(j) = AReg%Low
-            ix=ix+1
-            exit
-          end if
-         end do
-         if (ixin == ix) then
-           ix = ix+1
-           EndPoints(ix) = AReg%Low
-           ix = ix+1
-           EndPoints(ix) = AReg%High
-         else
-             ixin = ix
-             do j=1,ixin
-              if (AReg%High < EndPoints(j)) then
-                EndPoints(j+1:ix+1) = EndPoints(j:ix)
-                EndPoints(j) = AReg%High
-                ix=ix+1
-                exit
-              end if
-             end do
-             if (ixin == ix) then
-               ix = ix+1
-               EndPoints(ix) = AReg%High
-             end if
-                   
-         end if
-        end if
- 
-      end do
- 
- !remove duplicate points
-      ixin = ix
-      ix = 1
-      do i=2, ixin
-        if (EndPoints(i) /= EndPoints(ix)) then
-         ix=ix+1
-         EndPoints(ix) = EndPoints(i)
-        end if
-      end do
-     
- 
- !ix is the number of end points
-      Reg%Lowest = EndPoints(1)
-      Reg%Highest = EndPoints(ix)
-      Reg%count = 0
- 
-      max_delta = Reg%Highest - Reg%Lowest
- 
-      do i=1, ix - 1
-           AReg => Reg%R(i)
-           AReg%Low = EndPoints(i)
-           AReg%High = EndPoints(i+1)
-           
- !          max_delta = EndPoints(i+1) - EndPoints(i)
-           delta = max_delta
-           AReg%IsLog = .false.
- 
-           do j=1, nreg
-            if (AReg%Low >= NewRegions(j)%Low .and. Areg%Low < NewRegions(j)%High) then
-              if (NewRegions(j)%IsLog) then
-                 if (AReg%IsLog) then
-                  delta = min(delta,NewRegions(j)%delta) 
-                 else
-                  min_log_step = AReg%Low*(exp(NewRegions(j)%delta)-1)
-                  if (min_log_step < delta) then
-                    max_log_step = AReg%High*(1-exp(-NewRegions(j)%delta)) 
-                    if  (delta < max_log_step) then
-                      delta = min_log_step
-                    else
-                      AReg%IsLog = .true.
-                      delta = NewRegions(j)%delta 
-                    end if 
-                  end if
-                 end if
-              else !NewRegion is not log
-               if (AReg%IsLog) then
-                 max_log_step = AReg%High*(1-exp(-delta)) 
-                 if (NewRegions(j)%delta < max_log_step) then
-                   min_log_step = AReg%Low*(exp(delta)-1)
-                   if (min_log_step <  NewRegions(j)%delta) then
-                      AReg%IsLog = .false.
-                      delta =  min_log_step
-                   else
-                      delta = - log(1- NewRegions(j)%delta/AReg%High)
-                   end if
-                 end if
-               else
-                delta = min(delta, NewRegions(j)%delta)  
-               end if
-              end if
-            end if
-           end do
- 
-          if (AReg%IsLog) then
-            Diff = log(AReg%High/AReg%Low)
-          else
-            Diff = AReg%High - AReg%Low
-          endif
-          if (delta >= Diff) then
-            AReg%delta = Diff
-            AReg%steps = 1
-          else    
-            AReg%steps  = max(1,int(Diff/delta + 1.d0 - RangeTol))
-            AReg%delta = Diff / AReg%steps
-          end if
- 
-          Reg%count = Reg%count + 1
-          RequestDelta(Reg%Count) = delta
- 
-          if (AReg%IsLog) then
-           if (AReg%steps ==1) then
-            AReg%Delta_min = AReg%High - AReg%Low
-            AReg%Delta_max = AReg%Delta_min
-           else
-            AReg%Delta_min = AReg%Low*(exp(AReg%delta)-1)
-            AReg%Delta_max = AReg%High*(1-exp(-AReg%delta))
-           end if
-          else
-            AReg%Delta_max = AReg%delta
-            AReg%Delta_min = AReg%delta
-          end if
-      end do
- 
- 
- !Get rid of tiny regions
-      ix = Reg%Count
-      do i=ix, 1, -1  
-          AReg => Reg%R(i)
-          if (AReg%steps ==1) then
-               Diff = AReg%High - AReg%Low
-               if (AReg%IsLog) then
-                min_request = AReg%Low*(exp(RequestDelta(i))-1)
-                max_request = AReg%High*(1-exp(-RequestDelta(i)))
-               else
-                min_request = RequestDelta(i)
-                max_request = min_request
-               end if
-               if (i/= Reg%Count) then  !from i/= ix Mar08
-                LastReg => Reg%R(i+1)
-                if (RequestDelta(i) >= AReg%delta .and. Diff <= LastReg%Delta_min &
-                           .and. LastReg%Delta_min <= max_request) then 
- 
-                    LastReg%Low = AReg%Low
-                    if (Diff > LastReg%Delta_min*RangeTol) then
-                       LastReg%steps =  LastReg%steps + 1
-                    end if
-                    if (LastReg%IsLog) then
-                       LastReg%delta = log(LastReg%High/LastReg%Low) / LastReg%steps 
-                    else
-                       LastReg%delta = (LastReg%High -LastReg%Low) / LastReg%steps 
-                    end if
-                    Reg%R(i:Reg%Count-1) = Reg%R(i+1:Reg%Count)
-                    Reg%Count = Reg%Count -1
-                    cycle
-                end if          
-               end if
-               if (i/=1) then
-                LastReg => Reg%R(i-1)
-                if (RequestDelta(i) >= AReg%delta .and. Diff <= LastReg%Delta_max &
-                           .and. LastReg%Delta_max <= min_request) then
-                    LastReg%High = AReg%High
-                    !AlMat08 LastReg%Low = AReg%Low
-                    if (Diff > LastReg%Delta_max*RangeTol) then
-                       LastReg%steps =  LastReg%steps + 1
-                    end if
-                    if (LastReg%IsLog) then
-                       LastReg%delta = log(LastReg%High/LastReg%Low) / LastReg%steps 
-                    else
-                       LastReg%delta = (LastReg%High -LastReg%Low) / LastReg%steps 
-                    end if
-                    Reg%R(i:Reg%Count-1) = Reg%R(i+1:Reg%Count)
-                    Reg%Count = Reg%Count -1
-                end if
-               end if           
-          end if       
-      end do
- 
- 
- !Set up start indices and get total number of steps
-     nsteps = 1
-     do i = 1, Reg%Count
-          AReg => Reg%R(i)
-          AReg%Start_index = nsteps
-          nsteps = nsteps + AReg%steps
-          if (AReg%IsLog) then
-           if (AReg%steps ==1) then
-            AReg%Delta_min = AReg%High - AReg%Low
-            AReg%Delta_max = AReg%Delta_min
-           else
-            AReg%Delta_min = AReg%Low*(exp(AReg%delta)-1)
-            AReg%Delta_max = AReg%High*(1-exp(-AReg%delta))
-           end if
-          else
-            AReg%Delta_max = AReg%delta
-            AReg%Delta_min = AReg%delta
-          end if
-     end do
- 
-     Reg%npoints = nsteps
- 
-    end subroutine Ranges_Add
- 
- 
-    subroutine Ranges_Write(Reg) 
-       Type(Regions), intent(in), target :: Reg
-       Type(Region), pointer :: AReg
-       integer i
- 
-       do i=1,Reg%count
-           AReg => Reg%R(i)
-           if (AReg%IsLog) then
-            Write (*,'("Range ",I3,":", 3E14.4," log")') i, AReg%Low, AReg%High, AReg%delta 
-           else
-            Write (*,'("Range ",I3,":", 3E14.4," linear")') i, AReg%Low, AReg%High, AReg%delta 
-           end if
-       end do
-    end subroutine Ranges_Write
- 
- 
-  end module Ranges
- 
- 
-  module Lists
-   !Currently implements lists of strings and lists of arrays of reals
-   implicit none
- 
-   type real_pointer
-     real, dimension(:), pointer :: p
-   end type real_pointer
- 
-   type double_pointer
-     double precision, dimension(:), pointer :: p
-   end type double_pointer
- 
-   type String_pointer
-     character, dimension(:), pointer :: p
-   end type String_pointer
- 
- 
-   Type TList_RealArr
-     integer Count
-     integer Delta
-     integer Capacity
-     type(Real_Pointer), dimension(:), pointer :: Items
-   end Type TList_RealArr
- 
-   Type TStringList
-     integer Count
-     integer Delta
-     integer Capacity
-     type(String_Pointer), dimension(:), pointer :: Items
-   end Type TStringList
- 
-  contains
-  
-    subroutine TList_RealArr_Init(L)
-     Type (TList_RealArr) :: L
-     
-      L%Count = 0
-      L%Capacity = 0
-      L%Delta = 1024
-      nullify(L%items)
- 
-    end subroutine TList_RealArr_Init
- 
-    subroutine TList_RealArr_Clear(L)
-     Type (TList_RealArr) :: L
-     integer i, status
-      
-      do i=L%Count,1,-1 
-        deallocate (L%Items(i)%P, stat = status)
-      end do
-     deallocate (L%Items, stat = status)
-     nullify(L%Items)
-     L%Count = 0
-     L%Capacity = 0
- 
-    end subroutine TList_RealArr_Clear
- 
-     
-    subroutine TList_RealArr_Add(L, P)
-     Type (TList_RealArr) :: L
-     real, intent(in) :: P(:)
-     integer s
-   
-     if (L%Count == L%Capacity) call TList_RealArr_SetCapacity(L, L%Capacity + L%Delta)
-     s = size(P)
-     L%Count = L%Count + 1
-     allocate(L%Items(L%Count)%P(s))
-     L%Items(L%Count)%P = P
- 
-    end subroutine TList_RealArr_Add
- 
-    subroutine TList_RealArr_SetCapacity(L, C)
-     Type (TList_RealArr) :: L
-     integer C
-     type(Real_Pointer), dimension(:), pointer :: TmpItems
-     
-     if (L%Count > 0) then
-       if (C < L%Count) stop 'TList_RealArr_SetCapacity: smaller than Count'
-       allocate(TmpItems(L%Count))
-       TmpItems = L%Items(1:L%Count)
-       deallocate(L%Items)
-       allocate(L%Items(C))
-       L%Items(1:L%Count) = TmpItems
-       deallocate(TmpItems)
-     else
-      allocate(L%Items(C))
-     end if  
-     L%Capacity = C
-    end subroutine TList_RealArr_SetCapacity
- 
-    subroutine TList_RealArr_Delete(L, i)
-     Type (TList_RealArr) :: L
-     integer, intent(in) :: i
-     integer status
-      
-      deallocate(L%items(i)%P, stat = status)
-      if (L%Count > 1) L%Items(i:L%Count-1) = L%Items(i+1:L%Count)
-      L%Count = L%Count -1
-      
-    end subroutine TList_RealArr_Delete
- 
-    subroutine TList_RealArr_SaveBinary(L,fid)
-     Type (TList_RealArr) :: L
-     integer, intent(in) :: fid
-     integer i
-      
-       write (fid) L%Count
-       do i=1,L%Count
-        write(fid) size(L%Items(i)%P)
-        write(fid) L%Items(i)%P
-       end do
- 
-    end subroutine TList_RealArr_SaveBinary
- 
-    subroutine TList_RealArr_ReadBinary(L,fid)
-     Type (TList_RealArr) :: L
-     integer, intent(in) :: fid
-     integer num,i,sz
-      
-       call TList_RealArr_Clear(L) 
-       read (fid) num
-       call TList_RealArr_SetCapacity(L, num)
-       do i=1,num
-        read(fid) sz
-        allocate(L%Items(i)%P(sz))
-        read(fid) L%Items(i)%P
-       end do
-       L%Count = num
- 
-    end subroutine TList_RealArr_ReadBinary
- 
- 
-    subroutine TList_RealArr_Thin(L, i)
-     Type (TList_RealArr) :: L
-     integer, intent(in) :: i
-     integer newCount
-     type(Real_Pointer), dimension(:), pointer :: TmpItems
-     
-     if (L%Count > 1) then
-       newCount = (L%Count-1)/i+1
-       allocate(TmpItems(newCount))
-       TmpItems = L%Items(1:L%Count:i)
-       deallocate(L%Items)
-       L%Capacity = newCount
-       allocate(L%Items(L%Capacity))
-       L%Items = TmpItems
-       L%Count = newCount
-       deallocate(TmpItems)
-     end if    
-    end subroutine TList_RealArr_Thin
- 
-    subroutine TList_RealArr_ConfidVal(L, ix, limfrac, ix1, ix2, Lower, Upper)
-    !Taking the ix'th entry in each array to be a sample, value for which
-    !limfrac of the items between ix1 and ix2 (inc) are above or below
-    !e.g. if limfrac = 0.05 get two tail 90% confidence limits
-      Type (TList_RealArr) :: L
-      integer, intent(IN) :: ix
-      real, intent(IN) :: limfrac
-      real, intent(OUT), optional :: Lower, Upper
-      integer, intent(IN), optional :: ix1,ix2
-      integer b,t,samps
-      real pos, d
-      type(Real_Pointer), dimension(:), pointer :: SortItems
-     
-      b=1
-      t=L%Count
-      if (present(ix1)) b = ix1
-      if (present(ix2)) t = ix2
-      samps = t - b + 1
-   
-      allocate(SortItems(samps))
-      SortItems = L%Items(b:t)
-      call QuickSortArr_Real(SortItems, 1, samps, ix)
-      if (present(Lower)) then
-        pos = (samps-1)*limfrac + 1 
-        b = max(int(pos),1)
-        Lower = SortItems(b)%P(ix)
-       if (b < samps .and. pos>b) then
-        d = pos - b
-        Lower = Lower*(1 - d) + d * SortItems(b+1)%P(ix) 
-       end if
-      end if
-      if (present(Upper)) then
-       pos = (samps-1)*(1.-limfrac) + 1
-       b = max(int(pos),1)
-       Upper = SortItems(b)%P(ix)
-       if (b < samps .and. pos>b) then
-        d = pos - b
-        Upper = Upper*(1 - d) + d * SortItems(b+1)%P(ix) 
-       end if
-      end if
-    
-      deallocate(SortItems)
- 
-     end subroutine TList_RealArr_ConfidVal
- 
-    subroutine TStringList_Init(L)
-     Type (TStringList) :: L
-     
-      L%Count = 0
-      L%Capacity = 0
-      L%Delta = 128
-      nullify(L%items)
-      
-    end subroutine TStringList_Init
- 
-    subroutine TStringList_Clear(L)
-     Type (TStringList) :: L
-     integer i, status
-      
-      do i=L%Count,1,-1 
-        deallocate (L%Items(i)%P, stat = status)
-      end do
-     deallocate (L%Items, stat = status)
-     call TStringList_Init(L)
- 
-    end subroutine TStringList_Clear
- 
-    subroutine TStringList_SetFromString(L, S, valid_chars)
-     Type (TStringList) :: L
-     character(Len=*), intent(in) :: S, valid_chars
-     character(LEN=1024) item
-     integer i,j
- 
-      call TStringList_Clear(L)
-      item ='' 
-      j=0
-      do i=1, len_trim(S)
-         if (verify(S(i:i),trim(valid_chars)) == 0) then
-           j=j+1
-           item(j:j) = S(i:i)
-         else
-           if (trim(S(i:i))/='') then
-            write (*,*) 'Invalid character in: '//trim(S)
-           end if 
-           if (j>0) call TStringList_Add(L, item(1:j))
-           j=0
-         end if          
-      end do
-      if (j>0) call TStringList_Add(L, item(1:j))
-    
-    end subroutine TStringList_SetFromString
- 
- 
-     
-    subroutine TStringList_Add(L, P)
-     Type (TStringList) :: L
-     character(LEN=*), intent(in) :: P
-     integer s,i
-   
-     if (L%Count == L%Capacity) call TStringList_SetCapacity(L, L%Capacity + L%Delta)
-     s = len_trim(P)
-     L%Count = L%Count + 1
-     allocate(L%Items(L%Count)%P(s))
-     do i=1,s
-     L%Items(L%Count)%P(i) = P(i:i)
-     end do
-    end subroutine TStringList_Add
- 
-    subroutine TStringList_SetCapacity(L, C)
-     Type (TStringList) :: L
-     integer C
-     type(String_Pointer), dimension(:), pointer :: TmpItems
-     
-     if (L%Count > 0) then
-       if (C < L%Count) stop 'TStringList_SetCapacity: smaller than Count'
-       allocate(TmpItems(L%Count))
-       TmpItems = L%Items(1:L%Count)
-       deallocate(L%Items)
-       allocate(L%Items(C))
-       L%Items(1:L%Count) = TmpItems
-       deallocate(TmpItems)
-     else
-      allocate(L%Items(C))
-     end if  
-     L%Capacity = C
-   
-    end subroutine TStringList_SetCapacity
- 
-    subroutine TStringList_Delete(L, i)
-     Type (TStringList) :: L
-     integer, intent(in) :: i
-     integer status
-      
-      deallocate(L%items(i)%P, stat = status)
-      if (L%Count > 1) L%Items(i:L%Count-1) = L%Items(i+1:L%Count)
-      L%Count = L%Count -1
-      
-    end subroutine TStringList_Delete
- 
-    function TStringList_IndexOf(L, S)
-     Type (TStringList) :: L
-     character(LEN=*), intent(in) :: S
-     integer TStringList_IndexOf, i, j,slen
- 
-     slen = len_trim(S)
-     do i=1,L%Count
-      if ( size(L%Items(i)%P)==slen) then
-  !Yes, comparing strings and pointer strings really is this horrible...
-        j=1
-        do while (L%Items(i)%P(j)==S(j:j)) 
-           j=j+1
-           if (j>slen) then
-             TStringList_IndexOf = i
-             return         
-           end if
-        end do
-      end if
-     end do
-     TStringList_IndexOf=-1
-      
-    end function TStringList_IndexOf
- 
- 
-       recursive subroutine QuickSortArr_Real(Arr, Lin, R, index)
-       !Sorts an array of pointers to arrays of reals by the value of the index'th entry
-       integer, intent(in) :: Lin, R, index
- #ifdef __GFORTRAN__
-       type(real_pointer), dimension(:) :: Arr
- #else
-       type(real_pointer), dimension(*) :: Arr
- #endif
-       integer I, J, L
-       real P
-       type(real_pointer) :: temp
-   
-       L = Lin
-       do
- 
-       I = L
-       J = R
-       P = Arr((L + R)/2)%p(index)
-    
-       do
-       do while (Arr(I)%p(index) <  P) 
-          I = I + 1
-       end do
-     
-       do while (Arr(J)%p(index) > P) 
-          J = J - 1
-       end do
- 
-       if (I <= J) then
-      
-        Temp%p => Arr(I)%p
-        Arr(I)%p => Arr(J)%p
-        Arr(J)%p => Temp%p
-        I = I + 1
-        J = J - 1
-       end if
-       if (I > J) exit
-       
-       end do
-     if (L < J) call QuickSortArr_Real(Arr, L, J, index);
-     L = I
-     if (I >= R) exit
-     end do
- 
-     end subroutine QuickSortArr_Real
- 
- 
- 
-     recursive subroutine QuickSortArr(Arr, Lin, R, index)
-       !Sorts an array of pointers to arrays of reals by the value of the index'th entry
-       integer, intent(in) :: Lin, R, index
- #ifdef __GFORTRAN__
-       type(double_pointer), dimension(:) :: Arr
- #else
-       type(double_pointer), dimension(*) :: Arr
- #endif
-       integer I, J, L
-       double precision P
-       type(double_pointer) :: temp
-   
-       L = Lin
-       do
- 
-       I = L
-       J = R
-       P = Arr((L + R)/2)%p(index)
-    
-       do
-       do while (Arr(I)%p(index) <  P) 
-          I = I + 1
-       end do
-     
-       do while (Arr(J)%p(index) > P) 
-          J = J - 1
-       end do
- 
-       if (I <= J) then
-      
-        Temp%p => Arr(I)%p
-        Arr(I)%p => Arr(J)%p
-        Arr(J)%p => Temp%p
-        I = I + 1
-        J = J - 1
-       end if
-       if (I > J) exit
-       
-       end do
-     if (L < J) call QuickSortArr(Arr, L, J, index);
-     L = I
-     if (I >= R) exit
-     end do
- 
-     end subroutine QuickSortArr
- 
- 
-  end module Lists
- 
-   module AMLutils
-   use Lists
-        
- #ifdef DECONLY
-    !Comment out if linking to LAPACK/MKL separetly 
-    !CXML only has LAPACK 2.0
-     include 'CXML_INCLUDE.F90'
- #endif
-  
- 
- #ifdef NAGF95
-         use F90_UNIX
- #endif
- 
-      implicit none
- 
- #ifndef NAGF95
- #ifndef GFC
- #ifndef __INTEL_COMPILER_BUILD_DATE
- #ifndef __GFORTRAN__
-         integer iargc
-         external iargc
- #endif        
- #endif
- #endif
- #endif
- 
- 
- #ifdef MPI
-     include "mpif.h"
- #endif
- 
-   integer :: Feedback = 1
-   integer, parameter :: tmp_file_unit = 50
- 
- 
-   double precision, parameter :: pi=3.14159265358979323846264338328d0, &
-       twopi=2*pi, fourpi=4*pi
-   double precision, parameter :: root2 = 1.41421356237309504880168872421d0, sqrt2 = root2
-   double precision, parameter :: log2 = 0.693147180559945309417232121458d0
- 
-   real, parameter :: pi_r = 3.141592653, twopi_r = 2*pi_r, fourpi_r = twopi_r*2
- 
-   logical :: flush_write = .true.
-     !True means no data lost on crashes, but may make it slower
-     
-   integer, parameter :: file_units_start = 20
-   integer, parameter :: file_units_end = 100
-   
-   logical file_units(file_units_start:file_units_end)
- 
-   INTERFACE CONCAT
-     module procedure concat_s, concat_s_n
-     
-   END INTERFACE
- 
- 
- 
-   contains
- 
-  function new_file_unit()
-   integer i, new_file_unit
-   logical, save :: file_units_inited = .false.
-  
-   if (.not. file_units_inited) then
-    file_units = .false.
-    file_units_inited = .true.
-   end if
-  
-   do i=file_units_start, file_units_end
-    if (.not. file_units(i) .and. i/=tmp_file_unit) then
-     file_units(i)=.true.
-     new_file_unit = i
-     return
-    end if
-   end do 
-   
-   call mpiStop('No unused file unit numbers')
-   
-  end function new_file_unit
- 
- 
-  subroutine CloseFile(i)
-   integer, intent(in) :: i
-   
-   close(i)
-   file_units(i) = .false.
-     
-  end subroutine CloseFile 
- 
-  subroutine ClearFileUnit(i)
-   integer, intent(in) :: i
-   
-   file_units(i) = .false.
-     
-  end subroutine ClearFileUnit
- 
-   function GetParamCount()
-    integer GetParamCount
-  
-     GetParamCount = iargc() 
- 
-   end function GetParamCount
- 
-   function GetMpiRank()
-   integer GetMpiRank
- #ifdef MPI 
-    integer ierror
-    call mpi_comm_rank(mpi_comm_world,GetMPIrank,ierror)
- #else
-     GetMpiRank=0
- #endif    
-    
-   end function GetMpiRank
- 
-   function IsMainMPI()
-    logical IsMainMPI
- 
-    IsMainMPI =  GetMpiRank() == 0
-    
-   end function IsMainMPI
- 
-   subroutine MpiStop(Msg)
-    character(LEN=*), intent(in), optional :: Msg
-    integer i
- #ifdef MPI 
-    integer ierror, MpiRank
- #endif
- 
-    if (present(Msg)) write(*,*) trim(Msg)
-    
- #ifdef MPI
-     call mpi_comm_rank(mpi_comm_world,MPIrank,ierror)
-     write (*,*) 'MpiStop: ', MpiRank
-     call MPI_ABORT(MPI_COMM_WORLD,i)
- #endif
-     i=1     !put breakpoint on this line to debug
-     stop
-     
-  end subroutine MpiStop
-  
-    subroutine MpiStat(MpiID, MpiSize)
-    implicit none
-    integer MpiID,MpiSize  
- #ifdef MPI  
-    integer ierror
-         call mpi_comm_rank(mpi_comm_world,MpiID,ierror)
-         if (ierror/=MPI_SUCCESS) stop 'MpiStat: MPI rank'
-         call mpi_comm_size(mpi_comm_world,MpiSize,ierror)
- #else
-   MpiID=0
-   MpiSize=1   
- #endif
-   end subroutine MpiStat
-  
- #ifdef __GFORTRAN__
-   
-   ! ===========================================================
-   function iargc ()
-     ! ===========================================================
-     integer iargc
-     ! ===========================================================
-     
-     iargc=command_argument_count()
-   end function iargc
-   
-   ! ===========================================================
-   subroutine getarg(num, res)
-     ! ===========================================================
-     integer, intent(in) :: num
-     character(len=*), intent(out) :: res
-     integer l, err
-     ! ===========================================================
-     call get_command_argument(num,res,l,err)
-   end subroutine getarg
-   
- #endif
- 
- 
-   function GetParam(i)
- 
-    character(LEN=512) GetParam
-    integer, intent(in) :: i
-  
-    if (iargc() < i) then
-      GetParam = ''
-    else
-     call getarg(i,GetParam)
-    end if
-   end function GetParam
- 
-   function concat_s(S1,S2,S3,S4,S5,S6,S7,S8) result(concat)
-    character(LEN=*), intent(in) :: S1, S2
-    character(LEN=*), intent(in) , optional :: S3, S4, S5, S6,S7,S8
-    character(LEN = 1000) concat
- 
-    concat = trim(S1) // S2
-    if (present(S3)) then
-     concat = trim(concat) // S3
-      if (present(S4)) then
-        concat = trim(concat) // S4
-        if (present(S5)) then
-          concat = trim(concat) // S5
-            if (present(S6)) then
-              concat = trim(concat) // S6
-               if (present(S7)) then
-                 concat = trim(concat) // S6
-                 if (present(S8)) then
-                   concat = trim(concat) // S8
-                 end if
-               end if    
-            end if
-        end if
-      end if
-    end if
- 
-   end function concat_s
- 
-  function concat_s_n(SS1,N2,SS3,N4,SS5,N6,SS7,N8,SS9,N10,SS11) result(concat)
-    character(LEN=*), intent(in) :: SS1
-    integer, intent(in) :: N2
-    character(LEN=*), intent(in) , optional :: SS3, SS5, SS7, SS9,SS11
-    integer, intent(in), optional ::N4,N6,N8, N10
-    character(LEN = 1000) concat
-    
-    concat = trim(SS1) //trim(IntToStr(N2))
-      if (present(SS3)) then
-     concat = trim(concat) // SS3
-      if (present(N4)) then
-        concat = trim(concat) // trim(IntToStr(N4))
-        if (present(SS5)) then
-          concat = trim(concat) // SS5
-            if (present(N6)) then
-              concat = trim(concat) // trim(intToStr(N6))
-              if (present(SS7)) then
-              concat = trim(concat) // SS7
-               if (present(N8)) then
-                concat = trim(concat) // trim(intToStr(N8))
-               if (present(SS9)) then
-                concat = trim(concat) // SS9
-                 if (present(N10)) then
-                 concat = trim(concat) // trim(intToStr(N10))
-                   if (present(SS11)) then
-                    concat = trim(concat) // SS11
-                   end if
-                 end if
-               end if       
-            end if
-        end if
-      end if
-    end if
-    end if
-    end if
-    
-  end  function concat_s_n
- 
-   subroutine Exchange(i1,i2)
-    integer i1,i2,tmp
-  
-    tmp=i1
-    i1=i2
-    i2=tmp
- 
-   end subroutine Exchange
- 
-   subroutine WriteS(S)
-    character(LEN=*), intent(in) :: S
- 
-     write (*,*) trim(S)
-  
-   end subroutine WriteS
- 
-   subroutine StringReplace(FindS, RepS, S)
-    character(LEN=*), intent(in) :: FindS, RepS
-    character(LEN=*), intent(inout) :: S
-    integer i
-    
-    i = index(S,FindS)
-    if (i>0) then
-      S = S(1:i-1)//trim(RepS)//S(i+len_trim(FindS):len_trim(S))
-    end if
-   
-   
-   end subroutine StringReplace
- 
-   function numcat(S, num)
-    character(LEN=*) S
-    character(LEN=120) numcat, numstr
-    integer num
- 
-    write (numstr, *) num
-    numcat = trim(S) // trim(adjustl(numstr))
-    !OK, so can probably do with with a format statement too... 
-   end function numcat
- 
-   function LogicalToint(B)
-    integer LogicalToint
-    logical, intent(in) :: B
-    
-    if (B) then
-     LogicalToInt=1
-    else
-     LogicalToint=0
-    end if  
-    
-   end function LogicalToInt
-  
-   function IntToLogical(I)
-    integer, intent(in) :: I
-    logical IntToLogical
-    
-    IntToLogical = I /= 0
-    
-   end  function IntToLogical
-  
-   function IntToStr(I)
-    integer , intent(in) :: I
-    character(LEN=30) IntToStr
- 
-    write (IntToStr,*) i
-    IntToStr = adjustl(IntToStr)
- 
-   end function IntToStr
- 
-   function StrToInt(S)
-    integer :: StrToInt
-    character(LEN=30), intent(in) :: S
- 
-    read (S,*) StrToInt
-   end function StrToInt
- 
- 
-    function RealToStr(R, figs)
-    real, intent(in) :: R
-    integer, intent(in), optional :: figs
-    character(LEN=30) RealToStr
- 
-     if (abs(R)>=0.001) then
-      write (RealToStr,'(f12.6)') R
- 
-    RealToStr = adjustl(RealToStr)
-    if (present(figs)) then
-     RealToStr = RealToStr(1:figs)
-    else
-     RealToStr = RealToStr(1:6)  
-    end if
- 
-     else
-      if (present(figs)) then
-       write (RealToStr,'(E'//trim(numcat('(',figs))//'.2)') R
-      else
-       write (RealToStr,'(G9.2)') R
-      end if
-      RealToStr = adjustl(RealToStr)
-     end if
-         
- 
-   end function RealToStr
-   
-   function IndexOf(aval,arr, n)
-      integer, intent(in) :: n, arr(n), aval
-      integer IndexOf, i
- 
-      do i=1,n
-         if (arr(i)==aval) then
-           IndexOf= i
-           return
-         end if
-      end do
-     IndexOf = 0
- 
-   end function IndexOf
- 
-   function MaxIndex(arr, n)
-      integer, intent(in) :: n
-      real, intent(in) :: arr(n)
-      integer locs(1:1), MaxIndex
- 
-      locs = maxloc(arr(1:n))
-      MaxIndex = locs(1)
- 
-   end function MaxIndex
- 
-  
-   function MinIndex(arr, n)
-      integer, intent(in) :: n
-      real, intent(in) :: arr(n)
-      integer locs(1:1), MinIndex
- 
-      locs = minloc(arr(1:n))
-      MinIndex = locs(1)
- 
-   end function MinIndex
- 
- 
-    subroutine TList_RealArr_SaveToFile(L,fname)
-     character(LEN=*), intent(IN) :: fname
-     Type (TList_RealArr) :: L
-     character(LEN=20) aform
-     integer i
-     integer :: Plen = -1
-     integer :: file_id
- 
-     file_id = new_file_unit()
-     call CreateTxtFile(fname,file_id)
-     do i=1, L%Count 
-      if (PLen /= size(L%Items(i)%P)) then
-       PLen = size(L%Items(i)%P)
-       aform = '('//trim(IntToStr(PLen))//'E16.8)'
-      end if 
-      write (file_id,aform) L%Items(i)%P
-     end do
-     call CloseFile(file_id)   
- 
-    end subroutine TList_RealArr_SaveToFile
- 
- 
-   function ExtractFilePath(aname)
-     character(LEN=*), intent(IN) :: aname
-     character(LEN=120) ExtractFilePath
-     integer len, i
- 
-     len = len_trim(aname)
-     do i = len, 1, -1
-        if (aname(i:i)=='/') then
-           ExtractFilePath = aname(1:i)
-           return
-        end if
-     end do
-     ExtractFilePath = ''
- 
-   end function ExtractFilePath
- 
-   function ExtractFileExt(aname)
-     character(LEN=*), intent(IN) :: aname
-     character(LEN=120) ExtractFileExt
-     integer len, i
- 
-     len = len_trim(aname)
-     do i = len, 1, -1
-        if (aname(i:i)=='/') then
-           ExtractFileExt = ''
-           return
-        else if (aname(i:i)=='.') then
-           ExtractFileExt= aname(i:len)   
-           return
-        end if
-     end do
-     ExtractFileExt = ''
- 
-   end function ExtractFileExt
- 
- 
-  function ExtractFileName(aname)
-     character(LEN=*), intent(IN) :: aname
-     character(LEN=120) ExtractFileName
-     integer len, i
- 
-     len = len_trim(aname)
-     do i = len, 1, -1
-        if (aname(i:i)=='/') then
-           ExtractFileName = aname(i+1:len)
-           return
-        end if
-     end do
-     ExtractFileName = aname
- 
-   end function ExtractFileName
- 
-  function ChangeFileExt(aname,ext)
-     character(LEN=*), intent(IN) :: aname,ext
-     character(LEN=120) ChangeFileExt
-     integer len, i
- 
-     len = len_trim(aname)
-     do i = len, 1, -1
-        if (aname(i:i)=='.') then
-           ChangeFileExt = aname(1:i) // trim(ext)
-           return
-        end if
-     end do
-     ChangeFileExt = trim(aname) // '.' // trim(ext)
- 
-   end function ChangeFileExt
- 
- 
-   function CheckTrailingSlash(aname)
-      character(LEN=*), intent(in) :: aname
-      character(LEN=120) CheckTrailingSlash
-      integer len
-      
-      len = len_trim(aname)
- #ifdef IBMXL
-      if (aname(len:len) /= '\\' .and. aname(len:len) /= '/') then
- #else
- #ifdef ESCAPEBACKSLASH
-      if (aname(len:len) /= '\\' .and. aname(len:len) /= '/') then
- #else
-      if (aname(len:len) /= '\' .and. aname(len:len) /= '/') then
- #endif
- #endif
-       CheckTrailingSlash = trim(aname)//'/'
-      else
-       CheckTrailingSlash = aname
-      end if 
- 
- 
-   end  function CheckTrailingSlash
- 
- 
-   subroutine DeleteFile(aname)
-     character(LEN=*), intent(IN) :: aname
-     integer file_id 
- 
-      file_id = new_file_unit()
- 
-      open(unit = file_id, file = aname, err = 2)
-      close(unit = file_id, status = 'DELETE')
-  2   return
- 
-      file_units(file_id) = .false.
-     
-   end subroutine DeleteFile
- 
- 
-   subroutine FlushFile(aunit)
- #ifdef __INTEL_COMPILER_BUILD_DATE
-   USE IFPORT
- #endif
-     integer, intent(IN) :: aunit
- 
- 
- #ifdef IBMXL
-      call flush_(aunit)
- #else
-      call flush(aunit)
- #endif
-     
-   end subroutine FlushFile
- 
- 
-   function FileExists(aname)
-     character(LEN=*), intent(IN) :: aname
-     logical FileExists
-         
-         inquire(file=aname, exist = FileExists)
- 
-   end function FileExists
- 
-  subroutine OpenFile(aname, aunit,mode)
-    character(LEN=*), intent(IN) :: aname,mode
-    integer, intent(in) :: aunit
- 
- 
-    open(unit=aunit,file=aname,form=mode,status='old', err=500)
-    return
- 
- 500 call MpiStop('File not found: '//trim(aname))
-     
- 
-  end subroutine OpenFile
-  
-  
-  subroutine OpenTxtFile(aname, aunit)
-    character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: aunit
- 
-    call OpenFile(aname,aunit,'formatted')
-  
-  end subroutine OpenTxtFile
- 
- subroutine CreateOpenTxtFile(aname, aunit, append)
-    character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: aunit
-    logical, optional, intent(in) :: append
-    logical A
- 
-    if (present(append)) then
-       A=append
-    else
-       A = .false.
-    endif
- 
-    call CreateOpenFile(aname,aunit,'formatted',A)
- 
-  end subroutine CreateOpenTxtFile
- 
- 
-  subroutine CreateTxtFile(aname, aunit)
-     character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: aunit
- 
-    call CreateFile(aname,aunit,'formatted')
- 
-  end subroutine CreateTxtFile
- 
-  
-  subroutine CreateFile(aname, aunit,mode)
-     character(LEN=*), intent(IN) :: aname,mode
-    integer, intent(in) :: aunit
- 
-      open(unit=aunit,file=aname,form=mode,status='replace', err=500)
- 
-    return
- 
- 500 call MpiStop('Error creating file '//trim(aname))
-     
- 
-  end subroutine CreateFile
- 
-  subroutine CreateOpenFile(aname, aunit,mode, append)
-     character(LEN=*), intent(IN) :: aname,mode
-    integer, intent(in) :: aunit
-    logical, optional, intent(in) :: append
-    logical A
- 
-    if (present(append)) then
-       A=append
-    else
-       A = .false.
-    endif
- 
-    if (A) then
-      open(unit=aunit,file=aname,form=mode,status='unknown', err=500, position='append')
-    else
-      open(unit=aunit,file=aname,form=mode,status='replace', err=500)
-    end if
- 
-    return
- 
- 500 call MpiStop('Error creatinging or opening '//trim(aname))
-     
- 
-  end subroutine CreateOpenFile
- 
-  
- 
-  function FileColumns(aunit) result(n)
-    integer, intent(in) :: aunit
-    integer n,i
-    logical isNum
-    character(LEN=4096) :: InLine
- 
-    n=0
-    isNum=.false.
-    read(aunit,'(a)', end = 10) InLine
-    do i=1, len_trim(InLIne)
-     if (verify(InLine(i:i),'-+eE.0123456789') == 0) then
-       if (.not. IsNum) n=n+1
-       IsNum=.true.
-     else
-       IsNum=.false.     
-     end if
-    end do
- 
- 10 rewind aunit
-   
-  end function FileColumns
- 
-  function FileLines(aunit) result(n)
-    integer, intent(in) :: aunit
-    integer n
-    character(LEN=4096) :: InLine
- 
-    n=0
-    do
- 
-    read(aunit,'(a)', end = 200) InLine
-    n = n+1
-    end do
-  
- 200 rewind aunit
-     
- 
-  end function FileLines
- 
- 
- 
-  function TxtFileColumns(aname) result(n)
-     character(LEN=*), intent(IN) :: aname
-     integer n, file_id 
- 
- 
-     file_id = new_file_unit()
- 
-     call OpenTxtFile(aname, file_id)
-     n = FileColumns(file_id)
-     call CloseFile(file_id)
- 
-  end function TxtFileColumns
-  
-  
-  function LastFileLine(aname)
-    character(LEN=*), intent(IN) :: aname
-    character(LEN = 5000) LastFileLine, InLine
-    integer  file_id 
-    
-    file_id = new_file_unit()
-  
-    InLine = ''
-    call OpenTxtFile(aname,file_id)
-    do
-     read(file_id,'(a)', end = 200) InLine
-    end do
-  
- 200 call CloseFile(file_id)
- 
-    LastFileLine = InLine
-  
-  end function LastFileLine
- 
-  
- 
-       subroutine spline_real(x,y,n,y2)
- 
-       integer, intent(in) :: n
-       real, intent(in) :: x(n),y(n)
-       real, intent(out) :: y2(n)
-       integer i,k
-       real p,qn,sig,un
-       real, dimension(:), allocatable :: u
- 
-        
-       allocate(u(1:n))
-   
-         y2(1)=0
-         u(1)=0
-         
-       do i=2,n-1
-         sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
-         p=sig*y2(i-1)+2.0 
-    
-         y2(i)=(sig-1.0)/p
-       
-          u(i)=(6.0*((y(i+1)-y(i))/(x(i+ &
-          1)-x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig* &
-          u(i-1))/p
-       end do
-         qn=0.0
-         un=0.0
- 
-       y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.0)
-       do k=n-1,1,-1
-         y2(k)=y2(k)*y2(k+1)+u(k)
-       end do
- 
-       deallocate(u)
-   
- !  (C) Copr. 1986-92 Numerical Recipes Software, adapted.
-       end subroutine spline_real
- 
- 
-       subroutine spline_double(x,y,n,y2)
- 
-       integer, intent(in) :: n
-       double precision, intent(in) :: x(n),y(n)
-       double precision, intent(out) :: y2(n)
-       integer i,k
-       double precision p,qn,sig,un
-       double precision, dimension(:), allocatable :: u
- 
-        
-       allocate(u(1:n))
-   
-         y2(1)=0
-         u(1)=0
-         
-       do i=2,n-1
-         sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
-         p=sig*y2(i-1)+2 
-    
-         y2(i)=(sig-1)/p
-       
-          u(i)=(6*((y(i+1)-y(i))/(x(i+ &
-          1)-x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig* &
-          u(i-1))/p
-       end do
-       qn=0
-       un=0
- 
-       y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1)
-       do k=n-1,1,-1
-         y2(k)=y2(k)*y2(k+1)+u(k)
-       end do
- 
-       deallocate(u)
-   
- !  (C) Copr. 1986-92 Numerical Recipes Software, adapted.
-       end subroutine spline_double
- 
- 
-       function DLGAMMA(x)
-        !Use Stirling generalization for large x
-        !See e.g. http://en.wikipedia.org/wiki/Stirling's_approximation
-        !Is accurate to at least 10 decimals, worse just about 30
-        double precision :: x
-        double precision:: DLGAMMA !approx log gamma
-        double precision, parameter :: const = .91893853320467274180d0 !log(2pi)/2
-    
-        if (x<32.d0) then
-         DLGAMMA = log(GAMMA(x))
-        else
-         DLGAMMA = (x-0.5d0)*log(x) - x + const +  &
-          1/12.d0/(1+x)*(1+1/(x+2)*(1+59.d0/30/(x+3)*(1+2.9491525423728813559d0/(x+4))))
-       end if
-       end function DLGAMMA
- 
- 
-       function LogGamma(x)
-         real LogGamma
-         real, intent(in) :: x
-         integer i, j
-         real r
- 
-         i = nint(x*2)
-         if (abs(i-x*2) > 1e-4) call MpiStop('LogGamma function for half integral only')
-         if (mod(i,2) == 0) then
-            r=0
-            do j = 2, i/2-1
-               r = r + log(real(j))
-            end do
-            LogGamma = r
-         else
-            r = log(pi)/2
-            do j = 1, i-2 , 2
-              r = r+ log(j/2.0)
-            end do
-            LogGamma = r
-         end if
- 
-       end function LogGamma
- 
-     DOUBLE PRECISION FUNCTION GAMMA(X)
- !----------------------------------------------------------------------
- !
- ! This routine calculates the GAMMA function for a real argument X.
- !   Computation is based on an algorithm outlined in reference 1.
- !   The program uses rational functions that approximate the GAMMA
- !   function to at least 20 significant decimal digits.  Coefficients
- !   for the approximation over the interval (1,2) are unpublished.
- !   Those for the approximation for X .GE. 12 are from reference 2.
- !   The accuracy achieved depends on the arithmetic system, the
- !   compiler, the intrinsic functions, and proper selection of the
- !   machine-dependent constants.
- !*******************************************************************
- !
- ! Explanation of machine-dependent constants
- !
- ! beta   - radix for the floating-point representation
- ! maxexp - the smallest positive power of beta that overflows
- ! XBIG   - the largest argument for which GAMMA(X) is representable
- !          in the machine, i.e., the solution to the equation
- !                  GAMMA(XBIG) = beta**maxexp
- ! XINF   - the largest machine representable floating-point number;
- !          approximately beta**maxexp
- ! EPS    - the smallest positive floating-point number such that
- !          1.0+EPS .GT. 1.0
- ! XMININ - the smallest positive floating-point number such that
- !          1/XMININ is machine representable
- !
- !     Approximate values for some important machines are:
- !
- !                            beta       maxexp        XBIG
- !
- ! CRAY-1         (S.P.)        2         8191        966.961
- ! Cyber 180/855
- !   under NOS    (S.P.)        2         1070        177.803
- ! IEEE (IBM/XT,
- !   SUN, etc.)   (S.P.)        2          128        35.040
- ! IEEE (IBM/XT,
- !   SUN, etc.)   (D.P.)        2         1024        171.624
- ! IBM 3033       (D.P.)       16           63        57.574
- ! VAX D-Format   (D.P.)        2          127        34.844
- ! VAX G-Format   (D.P.)        2         1023        171.489
- !
- !                            XINF         EPS        XMININ
- !
- ! CRAY-1         (S.P.)   5.45E+2465   7.11E-15    1.84E-2466
- ! Cyber 180/855
- !   under NOS    (S.P.)   1.26E+322    3.55E-15    3.14E-294
- ! IEEE (IBM/XT,
- !   SUN, etc.)   (S.P.)   3.40E+38     1.19E-7     1.18E-38
- ! IEEE (IBM/XT,
- !   SUN, etc.)   (D.P.)   1.79D+308    2.22D-16    2.23D-308
- ! IBM 3033       (D.P.)   7.23D+75     2.22D-16    1.39D-76
- ! VAX D-Format   (D.P.)   1.70D+38     1.39D-17    5.88D-39
- ! VAX G-Format   (D.P.)   8.98D+307    1.11D-16    1.12D-308
- !
- !*******************************************************************
- !*******************************************************************
- !
- ! Error returns
- !
- !  The program returns the value XINF for singularities or
- !     when overflow would occur.  The computation is believed
- !     to be free of underflow and overflow.
- !
- !
- !  Intrinsic functions required are:
- !
- !     INT, DBLE, EXP, LOG, REAL, SIN
- !
- !
- ! References: "An Overview of Software Development for Special
- !              Functions", W. J. Cody, Lecture Notes in Mathemati,
- !              506, Numerical Analysis Dundee, 1975, G. A. Watson
- !              (ed.), Springer Verlag, Berlin, 1976.
- !
- !              Computer Approximations, Hart, Et. Al., Wiley and
- !              sons, New York, 1968.
- !
- !  Latest modification: October 12, 1989
- !
- !  Authors: W. J. Cody and L. Stoltz
- !           Applied Mathemati Division
- !           Argonne National Laboratory
- !           Argonne, IL 60439
- !
- !----------------------------------------------------------------------
-       INTEGER I,N
-       LOGICAL PARITY
-     DOUBLE PRECISION C,EPS,FACT,HALF,ONE,P,PI,Q,RES,SQRTPI,SUM,TWELVE, &
-          TWO,X,XBIG,XDEN,XINF,XMININ,XNUM,Y,Y1,YSQ,Z,ZERO
-       DIMENSION C(7),P(8),Q(8)
- !----------------------------------------------------------------------
- !  Mathematical constants
- !----------------------------------------------------------------------
-     DATA ONE,HALF,TWELVE,TWO,ZERO/1.0D0,0.5D0,12.0D0,2.0D0,0.0D0/, &
-         SQRTPI/0.9189385332046727417803297D0/, &
-         PI/3.1415926535897932384626434D0/
- !----------------------------------------------------------------------
- !  Machine dependent parameters
- !----------------------------------------------------------------------
-     DATA XBIG,XMININ,EPS/35.040D0,1.18D-38,1.19D-7/, &
-         XINF/3.4E38/
- !----------------------------------------------------------------------
- !  Numerator and denominator coefficients for rational minimax
- !     approximation over (1,2).
- !----------------------------------------------------------------------
-     DATA P/-1.71618513886549492533811E+0,2.47656508055759199108314E+1, &
-           -3.79804256470945635097577E+2,6.29331155312818442661052E+2, &
-           8.66966202790413211295064E+2,-3.14512729688483675254357E+4, &
-           -3.61444134186911729807069E+4,6.64561438202405440627855E+4/
-     DATA Q/-3.08402300119738975254353E+1,3.15350626979604161529144E+2, &
-          -1.01515636749021914166146E+3,-3.10777167157231109440444E+3, &
-            2.25381184209801510330112E+4,4.75584627752788110767815E+3, &
-          -1.34659959864969306392456E+5,-1.15132259675553483497211E+5/
- !----------------------------------------------------------------------
- ! Coefficients for minimax approximation over (12, INF).
- !----------------------------------------------------------------------
-     DATA C/-1.910444077728D-03,8.4171387781295D-04, &
-         -5.952379913043012D-04,7.93650793500350248D-04, &
-         -2.777777777777681622553D-03,8.333333333333333331554247D-02, &
-          5.7083835261D-03/
- !----------------------------------------------------------------------
- !  Statement functions for conversion between integer and float
- !----------------------------------------------------------------------
-       PARITY = .FALSE.
-       FACT = ONE
-       N = 0
-       Y = X
-       IF (Y .LE. ZERO) THEN
- !----------------------------------------------------------------------
- !  Argument is negative
- !----------------------------------------------------------------------
-             Y = -X
-             Y1 = AINT(Y)
-             RES = Y - Y1
-             IF (RES .NE. ZERO) THEN
-                   IF (Y1 .NE. AINT(Y1*HALF)*TWO) PARITY = .TRUE.
-                   FACT = -PI / SIN(PI*RES)
-                   Y = Y + ONE
-                ELSE
-                   RES = XINF
-                   GO TO 900
-             END IF
-       END IF
- !----------------------------------------------------------------------
- !  Argument is positive
- !----------------------------------------------------------------------
-       IF (Y .LT. EPS) THEN
- !----------------------------------------------------------------------
- !  Argument .LT. EPS
- !----------------------------------------------------------------------
-             IF (Y .GE. XMININ) THEN
-                   RES = ONE / Y
-                ELSE
-                   RES = XINF
-                   GO TO 900
-             END IF
-          ELSE IF (Y .LT. TWELVE) THEN
-             Y1 = Y
-             IF (Y .LT. ONE) THEN
- !----------------------------------------------------------------------
- !  0.0 .LT. argument .LT. 1.0
- !----------------------------------------------------------------------
-                   Z = Y
-                   Y = Y + ONE
-                ELSE
- !----------------------------------------------------------------------
- !  1.0 .LT. argument .LT. 12.0, reduce argument if necessary
- !----------------------------------------------------------------------
-                   N = INT(Y) - 1
-                   Y = Y - REAL(N)
-                   Z = Y - ONE
-             END IF
- !----------------------------------------------------------------------
- !  Evaluate approximation for 1.0 .LT. argument .LT. 2.0
- !----------------------------------------------------------------------
-             XNUM = ZERO
-             XDEN = ONE
-             DO 260 I = 1, 8
-                XNUM = (XNUM + P(I)) * Z
-                XDEN = XDEN * Z + Q(I)
-   260       CONTINUE
-             RES = XNUM / XDEN + ONE
-             IF (Y1 .LT. Y) THEN
- !----------------------------------------------------------------------
- !  Adjust result for case  0.0 .LT. argument .LT. 1.0
- !----------------------------------------------------------------------
-                   RES = RES / Y1
-                ELSE IF (Y1 .GT. Y) THEN
- !----------------------------------------------------------------------
- !  Adjust result for case  2.0 .LT. argument .LT. 12.0
- !----------------------------------------------------------------------
-                   DO 290 I = 1, N
-                      RES = RES * Y
-                      Y = Y + ONE
-   290             CONTINUE
-             END IF
-          ELSE
- !----------------------------------------------------------------------
- !  Evaluate for argument .GE. 12.0,
- !----------------------------------------------------------------------
-             IF (Y .LE. XBIG) THEN
-                   YSQ = Y * Y
-                   SUM = C(7)
-                   DO 350 I = 1, 6
-                      SUM = SUM / YSQ + C(I)
-   350             CONTINUE
-                   SUM = SUM/Y - Y + SQRTPI
-                   SUM = SUM + (Y-HALF)*LOG(Y)
-                   RES = EXP(SUM)
-                ELSE
-                   RES = XINF
-                   GO TO 900
-             END IF
-       END IF
- !----------------------------------------------------------------------
- !  Final adjustments and return
- !----------------------------------------------------------------------
-       IF (PARITY) RES = -RES
-       IF (FACT .NE. ONE) RES = FACT / RES
-   900 GAMMA = RES
- 
-       END FUNCTION GAMMA
- 
-   subroutine SetIdlePriority
- #ifdef RUNIDLE
-     USE DFWIN
-     Integer dwPriority 
-     Integer CheckPriority
- 
-     dwPriority = 64 ! idle priority
-     CheckPriority = SetPriorityClass(GetCurrentProcess(), dwPriority)
- #endif
-   end subroutine SetIdlePriority
- 
- 
-     subroutine GetThreeJs(thrcof,l2in,l3in,m2in,m3in)
-       !Recursive evaluation of 3j symbols. Does minimal error checking on input parameters.
-       implicit none
-       integer, parameter :: dl = KIND(1.d0)
-       integer, intent(in) :: l2in,l3in, m2in,m3in
-       real(dl), dimension(*) :: thrcof
- #ifdef THREEJ
-       INTEGER, PARAMETER :: i8 = 8
-       integer(i8) :: l2,l3,m2,m3
-       integer(i8) :: l1, m1, l1min,l1max, lmatch, nfin, a1, a2
-       
-       real(dl) :: newfac, oldfac, sumfor, c1,c2,c1old, dv, denom, x, sum1, sumuni
-       real(dl) :: x1,x2,x3, y,y1,y2,y3,sum2,sumbac, ratio,cnorm, sign1, thresh
-       integer i,ier, index, nlim, sign2
-       integer nfinp1,nfinp2,nfinp3, lstep, nstep2,n
-       real(dl), parameter :: zero = 0._dl, one = 1._dl
-       real(dl), parameter ::  tiny = 1.0d-30, srtiny=1.0d-15, huge = 1.d30, srhuge = 1.d15
-   
-     ! routine to generate set of 3j-coeffs (l1,l2,l3\\ m1,m2,m3)
- 
-     ! by recursion from l1min = max(abs(l2-l3),abs(m1)) 
-     !                to l1max = l2+l3
-     ! the resulting 3j-coeffs are stored as thrcof(l1-l1min+1)
- 
-     ! to achieve the numerical stability, the recursion will proceed
-     ! simultaneously forwards and backwards, starting from l1min and l1max
-     ! respectively.
-     !
-     ! lmatch is the l1-value at which forward and backward recursion are matched.
-     !
-     ! ndim is the length of the array thrcof
-     !
-     ! ier = -1 for all 3j vanish(l2-abs(m2)<0, l3-abs(m3)<0 or not integer)
-     ! ier = -2 if possible 3j's exceed ndim
-     ! ier >= 0 otherwise
- 
-       l2=l2in
-       l3=l3in
-       m2=m2in
-       m3=m3in
-       newfac = 0
-       lmatch = 0
-       m1 = -(m2+m3)
- 
-     ! check relative magnitude of l and m values
-       ier = 0
-  
-       if (l2 < abs(m2) .or. l3 < m3) then
-       ier = -1
-       call MpiStop('error ier = -1')
-       return
-       end if
- 
-     ! limits for l1
-       l1min = max(abs(l2-l3),abs(m1))
-       l1max = l2+l3
- 
-       if (l1min >= l1max) then
-        if (l1min/=l1max) then
-        ier = -1
-         call MpiStop('error ier = -1')
-        return
-        end if
- 
-     ! reached if l1 can take only one value, i.e.l1min=l1max
-       thrcof(1) = (-1)**abs(l2+m2-l3+m3)/sqrt(real(l1min+l2+l3+1,dl))
-       return
- 
-       end if
- 
-       nfin = l1max-l1min+1
-  
-     ! starting forward recursion from l1min taking nstep1 steps
-       l1 = l1min
-       thrcof(1) = srtiny
-       sum1 = (2*l1 + 1)*tiny
- 
-       lstep = 1
- 
- 30    lstep = lstep+1
-       l1 = l1+1
- 
-       oldfac = newfac
-       a1 = (l1+l2+l3+1)*(l1-l2+l3)*(l1+l2-l3)
-       a2 = (l1+m1)*(l1-m1)*(-l1+l2+l3+1)
-       newfac = sqrt(a2*real(a1,dl))
-       if (l1 == 1) then
-          !IF L1 = 1  (L1-1) HAS TO BE FACTORED OUT OF DV, HENCE
-          c1 = -(2*l1-1)*l1*(m3-m2)/newfac
-       else
- 
-        dv = -l2*(l2+1)*m1 + l3*(l3+1)*m1 + l1*(l1-1)*(m3-m2)
-        denom = (l1-1)*newfac
- 
-        if (lstep > 2) c1old = abs(c1)
-        c1 = -(2*l1-1)*dv/denom
- 
-       end if
- 
-       if (lstep<= 2) then
- 
-     ! if l1=l1min+1 the third term in the recursion eqn vanishes, hence
-        x = srtiny*c1
-        thrcof(2) = x
-        sum1 = sum1+tiny*(2*l1+1)*c1*c1
-        if(lstep==nfin) then
-           sumuni=sum1
-           go to 230
-        end if
-        goto 30
- 
-       end if
- 
-       c2 = -l1*oldfac/denom
- 
-     ! recursion to the next 3j-coeff x  
-       x = c1*thrcof(lstep-1) + c2*thrcof(lstep-2)
-       thrcof(lstep) = x
-       sumfor = sum1
-       sum1 = sum1 + (2*l1+1)*x*x
-       if (lstep/=nfin) then
- 
-     ! see if last unnormalised 3j-coeff exceeds srhuge
-       if (abs(x) >= srhuge) then
-      
-          ! REACHED IF LAST 3J-COEFFICIENT LARGER THAN SRHUGE
-          ! SO THAT THE RECURSION SERIES THRCOF(1), ... , THRCOF(LSTEP)
-          ! HAS TO BE RESCALED TO PREVENT OVERFLOW
-      
-          ier = ier+1
-          do i = 1, lstep
-             if (abs(thrcof(i)) < srtiny) thrcof(i)= zero
-             thrcof(i) = thrcof(i)/srhuge
-          end do
- 
-          sum1 = sum1/huge
-          sumfor = sumfor/huge
-          x = x/srhuge
- 
-       end if
- 
-     ! as long as abs(c1) is decreasing, the recursion proceeds towards increasing
-     ! 3j-valuse and so is numerically stable. Once an increase of abs(c1) is 
-     ! detected, the recursion direction is reversed.
- 
-      if (c1old > abs(c1)) goto 30
- 
-      end if !lstep/=nfin
- 
-     ! keep three 3j-coeffs around lmatch for comparison with backward recursion
- 
-       lmatch = l1-1
-       x1 = x
-       x2 = thrcof(lstep-1)
-       x3 = thrcof(lstep-2)
-       nstep2 = nfin-lstep+3
- 
-     ! --------------------------------------------------------------------------
-     !
-     ! starting backward recursion from l1max taking nstep2 stpes, so that
-     ! forward and backward recursion overlap at 3 points 
-     ! l1 = lmatch-1, lmatch, lmatch+1
- 
-       nfinp1 = nfin+1
-       nfinp2 = nfin+2
-       nfinp3 = nfin+3
-       l1 = l1max
-       thrcof(nfin) = srtiny
-       sum2 = tiny*(2*l1+1)
-  
-       l1 = l1+2
-       lstep=1
- 
-       do
-       lstep = lstep + 1
-       l1= l1-1
- 
-       oldfac = newfac
-       a1 = (l1+l2+l3)*(l1-l2+l3-1)*(l1+l2-l3-1)
-       a2 = (l1+m1-1)*(l1-m1-1)*(-l1+l2+l3+2)
-       newfac = sqrt(a1*real(a2,dl))
- 
-       dv = -l2*(l2+1)*m1 + l3*(l3+1)*m1 +l1*(l1-1)*(m3-m2)
- 
-       denom = l1*newfac
-       c1 = -(2*l1-1)*dv/denom
-       if (lstep <= 2) then
- 
-          ! if l2=l2max+1, the third term in the recursion vanishes
-      
-          y = srtiny*c1
-          thrcof(nfin-1) = y
-          sumbac = sum2
-          sum2 = sum2 + tiny*(2*l1-3)*c1*c1
- 
-          cycle
- 
-       end if
- 
-       c2 = -(l1-1)*oldfac/denom
- 
-     ! recursion to the next 3j-coeff y
-       y = c1*thrcof(nfinp2-lstep)+c2*thrcof(nfinp3-lstep)
- 
-       if (lstep==nstep2) exit
-   
-       thrcof(nfinp1-lstep) = y
-       sumbac = sum2
-       sum2 = sum2+(2*l1-3)*y*y
- 
-     ! see if last unnormalised 3j-coeff exceeds srhuge
-       if (abs(y) >= srhuge) then
-      
-          ! reached if 3j-coeff larger than srhuge so that the recursion series
-          ! thrcof(nfin),..., thrcof(nfin-lstep+1) has to be rescaled to prevent overflow
-      
-          ier=ier+1
-          do i = 1, lstep
-             index=nfin-i+1
-             if (abs(thrcof(index)) < srtiny) thrcof(index)=zero
-             thrcof(index) = thrcof(index)/srhuge
-          end do
- 
-          sum2=sum2/huge
-          sumbac=sumbac/huge
- 
-       end if
- 
-       end do
- 
-     ! the forward recursion 3j-coeffs x1, x2, x3 are to be matched with the 
-     ! corresponding backward recursion vals y1, y2, y3
- 
-       y3 = y
-       y2 = thrcof(nfinp2-lstep)
-       y1 = thrcof(nfinp3-lstep)
- 
-     ! determine now ratio such that yi=ratio*xi (i=1,2,3) holds with minimal error
- 
-       ratio = (x1*y1+x2*y2+x3*y3)/(x1*x1+x2*x2+x3*x3)
-       nlim = nfin-nstep2+1
- 
-       if (abs(ratio) >= 1) then
- 
-        thrcof(1:nlim) = ratio*thrcof(1:nlim) 
-        sumuni = ratio*ratio*sumfor + sumbac
- 
-       else
- 
-       nlim = nlim+1
-       ratio = 1/ratio
-       do n = nlim, nfin
-          thrcof(n) = ratio*thrcof(n)
-       end do
-       sumuni = sumfor + ratio*ratio*sumbac
- 
-       end if
-     ! normalise 3j-coeffs
- 
- 230  cnorm = 1/sqrt(sumuni)
- 
-     ! sign convention for last 3j-coeff determines overall phase
- 
-       sign1 = sign(one,thrcof(nfin))
-       sign2 = (-1)**(abs(l2+m2-l3+m3))
-       if (sign1*sign2 <= 0) then
-         cnorm = -cnorm
-       end if
-       if (abs(cnorm) >= one) then
-          thrcof(1:nfin) = cnorm*thrcof(1:nfin)
-          return
-       end if
- 
-       thresh = tiny/abs(cnorm)
- 
-       do n = 1, nfin
-          if (abs(thrcof(n)) < thresh) thrcof(n) = zero
-          thrcof(n) = cnorm*thrcof(n)
-       end do
-       return 
- #else
-    call MpiStop('must compile with -DTHREEJ to use 3j routine')
- 
- !Just prevent unused variable warnings:
-    thrcof(1)=l2in+l3in+m2in+m3in
- #endif
- 
- 
-     end subroutine GetThreeJs
- 
- 
- 
-   end module AMLutils
-  
-   
- #ifdef ZIGGURAT
- MODULE Ziggurat
- ! Marsaglia & Tsang generator for random normals & random exponentials.
- ! Translated from C by Alan Miller (amiller@bigpond.net.au)
- 
- ! Marsaglia, G. & Tsang, W.W. (2000) `The ziggurat method for generating
- ! random variables', J. Statist. Software, v5(8).
- 
- ! This is an electronic journal which can be downloaded from:
- ! http://www.jstatsoft.org/v05/i08
- 
- ! N.B. It is assumed that all integers are 32-bit.
- ! N.B. The value of M2 has been halved to compensate for the lack of
- !      unsigned integers in Fortran.
- 
- ! Latest version - 1 January 2001
- !
- ! AL: useful material at http://en.wikipedia.org/wiki/Ziggurat_algorithm
-    IMPLICIT NONE
- 
-    PRIVATE
- 
-    INTEGER,  PARAMETER  ::  DP=SELECTED_REAL_KIND( 12, 60 )
-    REAL(DP), PARAMETER  ::  m1=2147483648.0_DP,   m2=2147483648.0_DP,      &
-                             half=0.5_DP
-    REAL(DP)             ::  dn=3.442619855899_DP, tn=3.442619855899_DP,    &
-                             vn=0.00991256303526217_DP,                     &
-                             q,                    de=7.697117470131487_DP, &
-                             te=7.697117470131487_DP,                       &
-                             ve=0.003949659822581572_DP
-    INTEGER,  SAVE       ::  iz, jz, jsr=123456789, kn(0:127),              &
-                             ke(0:255), hz
-    REAL(DP), SAVE       ::  wn(0:127), fn(0:127), we(0:255), fe(0:255)
-    LOGICAL,  SAVE       ::  initialized=.FALSE.
- 
-    PUBLIC  :: zigset, shr3, uni, rnor, rexp
- 
- 
- CONTAINS
- 
- 
- SUBROUTINE zigset( jsrseed )
- 
-    INTEGER, INTENT(IN)  :: jsrseed
- 
-    INTEGER  :: i
- 
-    !  Set the seed
-    jsr = jsrseed
- 
-    !  Tables for RNOR
-    q = vn*EXP(half*dn*dn)
-    kn(0) = (dn/q)*m1
-    kn(1) = 0
-    wn(0) = q/m1
-    wn(127) = dn/m1
-    fn(0) = 1.0_DP
-    fn(127) = EXP( -half*dn*dn )
-    DO  i = 126, 1, -1
-       dn = SQRT( -2.0_DP * LOG( vn/dn + EXP( -half*dn*dn ) ) )
-       kn(i+1) = (dn/tn)*m1
-       tn = dn
-       fn(i) = EXP(-half*dn*dn)
-       wn(i) = dn/m1
-    END DO
- 
-    !  Tables for REXP
-    q = ve*EXP( de )
-    ke(0) = (de/q)*m2
-    ke(1) = 0
-    we(0) = q/m2
-    we(255) = de/m2
-    fe(0) = 1.0_DP
-    fe(255) = EXP( -de )
-    DO  i = 254, 1, -1
-       de = -LOG( ve/de + EXP( -de ) )
-       ke(i+1) = m2 * (de/te)
-       te = de
-       fe(i) = EXP( -de )
-       we(i) = de/m2
-    END DO
-    initialized = .TRUE.
-    RETURN
- END SUBROUTINE zigset
- 
- 
- 
- !  Generate random 32-bit integers
- FUNCTION shr3( ) RESULT( ival )
-    INTEGER  ::  ival
- 
-    jz = jsr
-    jsr = IEOR( jsr, ISHFT( jsr,  13 ) )
-    jsr = IEOR( jsr, ISHFT( jsr, -17 ) )
-    jsr = IEOR( jsr, ISHFT( jsr,   5 ) )
-    ival = jz + jsr
-    RETURN
- END FUNCTION shr3
- 
- 
- 
- !  Generate uniformly distributed random numbers
- FUNCTION uni( ) RESULT( fn_val )
-    REAL(DP)  ::  fn_val
- 
-    fn_val = half + 0.2328306e-9_DP * shr3( )
-    RETURN
- END FUNCTION uni
- 
- 
- 
- !  Generate random normals
- FUNCTION rnor( ) RESULT( fn_val )
-    REAL(DP)             ::  fn_val
- 
-    REAL(DP), PARAMETER  ::  r = 3.442620_DP
-    REAL(DP)             ::  x, y
- 
-    IF( .NOT. initialized ) CALL zigset( jsr )
-    hz = shr3( )
-    iz = IAND( hz, 127 )
-    IF( ABS( hz ) < kn(iz) ) THEN
-       fn_val = hz * wn(iz)
-    ELSE
-       DO
-          IF( iz == 0 ) THEN
-             DO
-                x = -0.2904764_DP* LOG( uni( ) )
-                y = -LOG( uni( ) )
-                IF( y+y >= x*x ) EXIT
-             END DO
-             fn_val = r+x
-             IF( hz <= 0 ) fn_val = -fn_val
-             RETURN
-          END IF
-          x = hz * wn(iz)
-          IF( fn(iz) + uni( )*(fn(iz-1)-fn(iz)) < EXP(-half*x*x) ) THEN
-             fn_val = x
-             RETURN
-          END IF
-          hz = shr3( )
-          iz = IAND( hz, 127 )
-          IF( ABS( hz ) < kn(iz) ) THEN
-             fn_val = hz * wn(iz)
-             RETURN
-          END IF
-       END DO
-    END IF
-    RETURN
- END FUNCTION rnor
- 
- 
- 
- !  Generate random exponentials
- FUNCTION rexp( ) RESULT( fn_val )
-    REAL(DP)  ::  fn_val
- 
-    REAL(DP)  ::  x
- 
-    IF( .NOT. initialized ) CALL Zigset( jsr )
-    jz = shr3( )
-    iz = IAND( jz, 255 )
-    IF( ABS( jz ) < ke(iz) ) THEN
-       fn_val = ABS(jz) * we(iz)
-       RETURN
-    END IF
-    DO
-       IF( iz == 0 ) THEN
-          fn_val = 7.69711 - LOG( uni( ) )
-          RETURN
-       END IF
-       x = ABS( jz ) * we(iz)
-       IF( fe(iz) + uni( )*(fe(iz-1) - fe(iz)) < EXP( -x ) ) THEN
-          fn_val = x
-          RETURN
-       END IF
-       jz = shr3( )
-       iz = IAND( jz, 255 )
-       IF( ABS( jz ) < ke(iz) ) THEN
-          fn_val = ABS( jz ) * we(iz)
-          RETURN
-       END IF
-    END DO
-    RETURN
- END FUNCTION rexp
- 
- END MODULE ziggurat
- #endif 
- 
-   
- 
- module Random
-  integer :: rand_inst = 0 
-  logical, parameter :: use_ziggurat = .false.
-   !Ziggurat is significantly (3-4x) faster, see Wikipedia for details
-   !Have seem some suspicious things, though couldn't replicate; may be OK..
- 
- contains
-    
-   subroutine initRandom(i)
-   use AMLUtils
- #ifdef ZIGGURAT
-   use Ziggurat
- #endif
-   implicit none
-   integer, optional, intent(IN) :: i
-   integer seed_in,kl,ij
-   character(len=10) :: fred
-   real :: klr
-   
-    if (present(i)) then
-     seed_in = i
-    else
-     seed_in = -1
-    end if
-       if (seed_in /=-1) then
-        kl = 9373
-        ij = i
-       else
-        call system_clock(count=ij)
-        ij = mod(ij + rand_inst*100, 31328)
-        call date_and_time(time=fred)
-        read (fred,'(e10.3)') klr
-        kl = mod(int(klr*1000), 30081)       
-       end if
- 
-       if (Feedback > 0 ) write(*,'(" Random seeds:",1I6,",",1I6," rand_inst:",1I4)') ij,kl,rand_inst
-       call rmarin(ij,kl)
- #ifdef ZIGGURAT
-       if (use_ziggurat) call zigset(ij)
- #endif
-   end subroutine initRandom
- 
-   subroutine RandIndices(indices, nmax, n)
-    use AMLUtils
-      integer, intent(in) :: nmax, n
-     integer indices(n),i, ix
-     integer tmp(nmax)
-  
-     if (n> nmax) call MpiStop('Error in RandIndices, n > nmax')
-     do i=1, nmax
-        tmp(i)=i
-     end do
-     do i=1, n
-        ix = int(ranmar()*(nmax +1 -i)) + 1
-        indices(i) = tmp(ix)
-        tmp(ix) = tmp(nmax+1-i)
-     end do
- 
-   end subroutine RandIndices
- 
- 
-   subroutine RandRotation(R, N)
-    !this is most certainly not the world's most efficient or robust random rotation generator
-     integer, intent(in) :: N
-     real R(N,N), vec(N), norm
-     integer i,j
-     
-     do j = 1, N
-      do
-          do i = 1, N
-           vec(i) = Gaussian1()
-          end do
-          do i = 1, j-1
-            vec = vec - sum(vec*R(i,:))*R(i,:)
-          end do
-          norm = sum(vec**2)
-          if (norm > 1e-3) exit
-      end do
-      R(j,:) = vec / sqrt(norm)
-     end do
-     
-   end subroutine RandRotation
- 
- 
-   double precision function GAUSSIAN1()
- #ifdef ZIGGURAT
-     use Ziggurat
- #endif
-     implicit none
-     double precision R, V1, V2, FAC
-     integer, save :: iset = 0
-     double precision, save :: gset
- 
-     if (use_ziggurat) then
- #ifdef ZIGGURAT
-      Gaussian1 = rnor( )
- #endif
-     else
-      !Box muller
-      if (ISET==0) then
-         R=2
-         do while (R >= 1.d0)
-         V1=2.d0*ranmar()-1.d0
-         V2=2.d0*ranmar()-1.d0
-         R=V1**2+V2**2
-         end do
-         FAC=sqrt(-2.d0*log(R)/R)
-         GSET=V1*FAC
-         GAUSSIAN1=V2*FAC
-         ISET=1
-       else
-         GAUSSIAN1=GSET
-         ISET=0
-       endif
-       end if
-       end function GAUSSIAN1
- 
- 
-      double precision function CAUCHY1()
-       implicit none
- 
-       Cauchy1 = Gaussian1()/max(1d-15,abs(Gaussian1()))
- 
-      end function CAUCHY1
- 
- 
-      real FUNCTION RANDEXP1()
- !
- !     Random-number generator for the exponential distribution
- !     Algorithm EA from J. H. Ahrens and U. Dieter,
- !     Communications of the ACM, 31 (1988) 1330--1337.
- !     Coded by K. G. Hamilton, December 1996, with corrections.
- !
-       real u, up, g, y
-   
-       real, parameter ::   alog2= 0.6931471805599453
-       real, parameter ::      a = 5.7133631526454228
-       real, parameter ::      b = 3.4142135623730950
-       real, parameter ::     c = -1.6734053240284925
-       real, parameter ::      p = 0.9802581434685472
-       real, parameter ::     aa = 5.6005707569738080
-       real, parameter ::     bb = 3.3468106480569850
-       real, parameter ::     hh = 0.0026106723602095
-       real, parameter ::     dd = 0.0857864376269050
- 
-       u = ranmar()
-       do while (u.le.0)                 ! Comment out this block 
-         u = ranmar()                    ! if your RNG can never
-       enddo                             ! return exact zero
-       g = c
-       u = u+u
-       do while (u.lt.1.0)
-          g = g + alog2
-          u = u+u
-       enddo
-       u = u-1.0
-       if (u.le.p) then
-         randexp1 = g + aa/(bb-u)
-         return
-       endif
-       do
-         u = ranmar()
-         y = a/(b-u)
-         up = ranmar()
-         if ((up*hh+dd)*(b-u)**2 .le. exp(-(y+c))) then
-           randexp1 = g+y
-           return
-         endif
-       enddo
- 
-       end function randexp1
- 
- 
- ! This random number generator originally appeared in ''Toward a Universal 
- ! Random Number Generator'' by George Marsaglia and Arif Zaman. 
- ! Florida State University Report: FSU-SCRI-87-50 (1987)
- ! 
- ! It was later modified by F. James and published in ''A Review of Pseudo-
- ! random Number Generators'' 
- ! 
- ! THIS IS THE BEST KNOWN RANDOM NUMBER GENERATOR AVAILABLE.
- !    (However, a newly discovered technique can yield 
- !        a period of 10^600. But that is still in the development stage.)
- !
- ! It passes ALL of the tests for random number generators and has a period 
- !   of 2^144, is completely portable (gives bit identical results on all 
- !   machines with at least 24-bit mantissas in the floating point 
- !   representation). 
- ! 
- ! The algorithm is a combination of a Fibonacci sequence (with lags of 97
- !   and 33, and operation "subtraction plus one, modulo one") and an 
- !   "arithmetic sequence" (using subtraction).
- !
- ! On a Vax 11/780, this random number generator can produce a number in 
- !    13 microseconds. 
- !======================================================================== 
- !
- !      PROGRAM TstRAN
- !     INTEGER IJ, KL, I
- ! Thee are the seeds needed to produce the test case results
- !      IJ = 1802
- !      KL = 9373
- !
- !
- ! Do the initialization
- !      call rmarin(ij,kl)
- !
- ! Generate 20000 random numbers
- !      do 10 I = 1, 20000
- !         x = RANMAR()
- !10    continue
- !
- ! If the random number generator is working properly, the next six random
- !    numbers should be:
- !          6533892.0  14220222.0  7275067.0
- !    6172232.0  8354498.0   10633180.0
- !           
- !           
- !        
- !      write(6,20) (4096.0*4096.0*RANMAR(), I=1,6)
- !20    format (3f12.1)
- !      end
- !
-       subroutine RMARIN(IJ,KL)
- ! This is the initialization routine for the random number generator RANMAR()
- ! NOTE: The seed variables can have values between:    0 <= IJ <= 31328
- !                                                      0 <= KL <= 30081
- !The random number sequences created by these two seeds are of sufficient 
- ! length to complete an entire calculation with. For example, if sveral 
- ! different groups are working on different parts of the same calculation,
- ! each group could be assigned its own IJ seed. This would leave each group
- ! with 30000 choices for the second seed. That is to say, this random 
- ! number generator can create 900 million different subsequences -- with 
- ! each subsequence having a length of approximately 10^30.
- !
- ! Use IJ = 1802 & KL = 9373 to test the random number generator. The
- ! subroutine RANMAR should be used to generate 20000 random numbers.
- ! Then display the next six random numbers generated multiplied by 4096*4096
- ! If the random number generator is working properly, the random numbers
- !    should be:
- !           6533892.0  14220222.0  7275067.0
- !           6172232.0  8354498.0   10633180.0
-       double precision U(97), C, CD, CM, S, T
-       integer I97, J97,i,j,k,l,m
-       integer ij,kl
-       integer ii,jj
-            
-     
- !      INTEGER IRM(103)
-       
-       common /RASET1/ U, C, CD, CM, I97, J97
-       if( IJ .lt. 0  .or.  IJ .gt. 31328  .or. &
-          KL .lt. 0  .or.  KL .gt. 30081 ) then
-           print '(A)', ' The first random number seed must have a value  between 0 and 31328'
-           print '(A)',' The second seed must have a value between 0 and   30081'
-             stop
-       endif
-       I = mod(IJ/177, 177) + 2
-       J = mod(IJ    , 177) + 2
-       K = mod(KL/169, 178) + 1
-       L = mod(KL,     169) 
-       do 2 II = 1, 97
-          S = 0.0
-          T = 0.5
-          do 3 JJ = 1, 24
-             M = mod(mod(I*J, 179)*K, 179)
-             I = J
-             J = K
-             K = M
-             L = mod(53*L+1, 169)
-             if (mod(L*M, 64) .ge. 32) then
-                S = S + T
-             endif
-             T = 0.5 * T
- 3        continue
-          U(II) = S
- 2     continue
-       C = 362436.0 / 16777216.0
-       CD = 7654321.0 / 16777216.0
-       CM = 16777213.0 /16777216.0
-       I97 = 97
-       J97 = 33
-     
-       end subroutine RMARIN
- 
-       double precision function RANMAR()
- ! This is the random number generator proposed by George Marsaglia in 
- ! Florida State University Report: FSU-SCRI-87-50
- ! It was slightly modified by F. James to produce an array of pseudorandom
- ! numbers.
-       double precision U(97), C, CD, CM
-       integer I97, J97
-        double precision uni
-     
-       common /RASET1/ U, C, CD, CM, I97, J97
- !      INTEGER IVEC
-          UNI = U(I97) - U(J97)
-          if( UNI .lt. 0.0 ) UNI = UNI + 1.0
-          U(I97) = UNI
-          I97 = I97 - 1
-          if(I97 .eq. 0) I97 = 97
-          J97 = J97 - 1
-          if(J97 .eq. 0) J97 = 97
-          C = C - CD
-          if( C .lt. 0.d0 ) C = C + CM
-          UNI = UNI - C
-          if( UNI .lt. 0.d0 ) UNI = UNI + 1.0 ! bug?
-          RANMAR = UNI
-       
-       end function RANMAR
- 
- 
- end module Random
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/camb/writefits.f90 cosmomc_sampler/camb/writefits.f90
*** cosmomc/camb/writefits.f90	2005-03-31 01:37:14.000000000 +0200
--- cosmomc_sampler/camb/writefits.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,121 ****
- !subroutine to export Cls in FITS format for HEALPix 1.2
- !Antony Lewis July 2003
- 
- 
-  subroutine WriteFitsCls(Clsfile, lmx)
-   use CAMB
-   use head_fits, ONLY : add_card 
-   use fitstools, only : write_asctab
-   implicit none
-   character(LEN=*), INTENT(IN) ::  Clsfile
-   integer, INTENT(IN) :: lmx
-   CHARACTER(LEN=80), DIMENSION(1:120) :: header
-   INTEGER nlheader,i, j
-   real, allocatable, dimension (:,:) :: clout,allcl
-   real(dl) :: fac,  PowerVals(20)
-   character(Len=40) :: unitstr
-   character(Len=8) :: PowerKeys(20)
-   logical COBEnorm
- 
- 
-   if (CP%InitPower%nn>1) write(*,*) &
-        'Warning: FITS file contains result for first power spectrum only'
- 
-   allocate(clout(2:lmx,1:4))
-    
-   call CAMB_GetCls(clout, lmx, 1, .false.)
-   !HealPix 1.2 uses E-B conventions
- 
-   if (CP%OutputNormalization == outCOBE) then
-      fac=2*pi*CP%tcmb**2
-   else
-      if (CP%OutputNormalization >=2) then
-       fac=1
-      else
-       fac=OutputDenominator*CP%tcmb**2
-      end if
-   end if
- 
- !FITS file has Cls without l(l+1)/twopi factors
-   do i=2,lmx
-      clout(i,:)=clout(i,:)/i/dble(i+1)*fac
-   end do
- 
-   allocate(allcl(0:lmx,1:4))
-   allcl(2:lmx,1:4) = clout
-   allcl(0:1,1:4) = 0
-   deallocate(clout)
- 
-   header = ''
- 
-   if (CP%OutputNormalization == outCOBE) then
-      unitstr='Kelvin-squared'
-   else
-      unitstr='unknown'
-   end if
- 
-   call add_card(header,'COMMENT','-----------------------------------------------')
-   call add_card(header,'COMMENT','     CMB power spectrum C(l) keywords          ')
-   call add_card(header,'COMMENT','-----------------------------------------------')
-   call add_card(header,'EXTNAME','''COMPUTED POWER SPECTRUM''')
-   call add_card(header,'COMMENT',' POWER SPECTRUM : C(l) ')
-   call add_card(header)
-   call add_card(header,'CREATOR','CAMB',        'Software creating the FITS file')
-   call add_card(header,'VERSION',version,     'Version of the simulation software')
-   call add_card(header,'POLAR',.true.,'Polarisation included (True/False)')
-   call add_card(header,'POLNORM','CMBFAST','Uses E-B conventions')
-   call add_card(header)
-   call add_card(header)
-   call add_card(header,'TTYPE1', 'TEMPERATURE','Temperature C(l)')
-   call add_card(header,'TUNIT1', unitstr,'unit')
-   call add_card(header)
- 
-      call add_card(header,'TTYPE2', 'E-mode C_l','ELECTRIC polarisation C(l)')
-      call add_card(header,'TUNIT2', unitstr,'unit')
-      call add_card(header)
- 
-      call add_card(header,'TTYPE3', 'B-mode C_l','MAGNETIC polarisation C(l)')
-      call add_card(header,'TUNIT3', unitstr,'unit')
-      call add_card(header)
- 
-      call add_card(header,'TTYPE4', 'E-T cross corr.','Gradient-Temperature cross terms')
-      call add_card(header,'TUNIT4', unitstr,'unit')
-      call add_card(header)
- 
-  call add_card(header,'COMMENT','-----------------------------------------------')
-  call add_card(header,'COMMENT','     Cosmological parameters')
-  call add_card(header,'COMMENT','-----------------------------------------------')
-  call add_card(header,'OMEGAB',CP%omegab, 'Omega in baryons')
-  call add_card(header,'OMEGAC',CP%omegac, 'Omega in CDM')
-  call add_card(header,'OMEGAV',CP%omegav, 'Omega in cosmological constant')
-  call add_card(header,'OMEGAN',CP%omegan, 'Omega in neutrinos')
-  call add_card(header,'HUBBLE', CP%h0, 'Hublle constant in km/s/Mpc')
-  call add_card(header,'NNUNR',CP%Num_Nu_massive, 'number of massive neutrinos')
-  call add_card(header,'NNUR',CP%Num_Nu_massless, 'number of massless neutrinos')
-  call add_card(header,'TCMB',CP%tcmb, 'CMB temperature in Kelvin')
-  call add_card(header,'HELFRACT',CP%yhe, 'Helium fraction')
-  call add_card(header,'OPTDLSS',CP%Reion%optical_depth, 'reionisation optical depth')
-  call add_card(header,'IONFRACT',CP%Reion%fraction, 'ionisation fraction')
-  call add_card(header,'ZREION',CP%reion%redshift, 'reionisation redshift')
-  call add_card(header,'COMMENT','-----------------------------------------------')
-  call add_card(header,'COMMENT','     Other parameters')
-  call add_card(header,'COMMENT','-----------------------------------------------')
-  call add_card(header,'SCALARS',CP%WantScalars, 'includes scalar modes')
-  call add_card(header,'TENSORS',CP%WantTensors, 'includes tensor modes')
-  call add_card(header,'INITFLAG',CP%Scalar_initial_condition, 'initial condition flag') 
-  COBEnorm = CP%outputNormalization==outCOBE
-  call add_card(header,'COBENORM',COBEnorm, 'COBE normalized') 
-  call add_card(header,'KETA_MAX',CP%Max_eta_k, 'Max wavenumber') 
-  call add_card(header,'PRECIS',AccuracyBoost, 'Relative computation accuracy') 
-  call add_card(header,'EQS_FILE',Eqns_name, 'Gauge-dependent and background equations') 
-  call add_card(header,'POW_FILE',Power_Name, 'Initial power spectrum file') 
-  i = Power_Descript(1,CP%WantScalars,CP%WantTensors,PowerKeys,PowerVals)
-  do j=1,i
-  call add_card(header,PowerKeys(j),PowerVals(j), 'Initial power spectrum details') 
-  end do
-   
-   nlheader = SIZE(header)
-   call write_asctab (allcl, lmx, 4, header, nlheader, Clsfile)
-   deallocate(allcl)
- 
- end subroutine WriteFitsCls
--- 0 ----
Files cosmomc/cosmomc.tar and cosmomc_sampler/cosmomc.tar differ
diff -r -c -b -B -N cosmomc/LAMBDA.paramnames cosmomc_sampler/LAMBDA.paramnames
*** cosmomc/LAMBDA.paramnames	2009-09-17 17:47:23.000000000 +0200
--- cosmomc_sampler/LAMBDA.paramnames	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,19 ****
- omegabh2   \Omega_b h^2
- omegach2   \Omega_c h^2
- thetastar  \theta
- tau        \tau
- omegak     \Omega_K
- wlam       w
- a002       10^9 A_s 
- ns002      n_s
- nrun       n_{run}
- asz        A_{SZ}
- sigma8     \sigma_8
- zrei       z_{re}
- age        Age/Gyr
- H0         H_0
- omegamh2   \Omega_m h^2
- omegam     \Omega_m
- omegal     \Omega_\Lambda
- omegab     \Omega_b
- omegac     \Omega_c
\ No newline at end of file
--- 0 ----
diff -r -c -b -B -N cosmomc/params_CMB.covmat cosmomc_sampler/params_CMB.covmat
*** cosmomc/params_CMB.covmat	2008-03-07 21:35:24.000000000 +0100
--- cosmomc_sampler/params_CMB.covmat	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,13 ****
-     0.35705E-06    0.21359E-06    0.11149E-05    0.27518E-05    0.00000E+00    0.00000E+00    0.00000E+00    0.66959E-05    0.00000E+00    0.00000E+00    0.98596E-05    0.00000E+00    0.54479E-04
-     0.21359E-06    0.40562E-04    0.44118E-05   -0.21362E-04    0.00000E+00    0.00000E+00    0.00000E+00   -0.16392E-04    0.00000E+00    0.00000E+00    0.11962E-03    0.00000E+00   -0.26565E-03
-     0.11149E-05    0.44118E-05    0.89326E-05    0.53563E-05    0.00000E+00    0.00000E+00    0.00000E+00    0.22771E-04    0.00000E+00    0.00000E+00    0.44783E-04    0.00000E+00    0.10300E-03
-     0.27518E-05   -0.21362E-04    0.53563E-05    0.30231E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.95079E-04    0.00000E+00    0.00000E+00    0.56221E-03    0.00000E+00   -0.18630E-04
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.66959E-05   -0.16392E-04    0.22771E-04    0.95079E-04    0.00000E+00    0.00000E+00    0.00000E+00    0.19994E-03    0.00000E+00    0.00000E+00    0.24319E-03    0.00000E+00   -0.42249E-03
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.98596E-05    0.11962E-03    0.44783E-04    0.56221E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.24319E-03    0.00000E+00    0.00000E+00    0.18063E-02    0.00000E+00   -0.30229E-02
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.54479E-04   -0.26565E-03    0.10300E-03   -0.18630E-04    0.00000E+00    0.00000E+00    0.00000E+00   -0.42249E-03    0.00000E+00    0.00000E+00   -0.30229E-02    0.00000E+00    0.33910E+00
--- 0 ----
diff -r -c -b -B -N cosmomc/params_CMB_pivot002.covmat cosmomc_sampler/params_CMB_pivot002.covmat
*** cosmomc/params_CMB_pivot002.covmat	2008-03-13 20:04:08.000000000 +0100
--- cosmomc_sampler/params_CMB_pivot002.covmat	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,13 ****
-     0.37746E-06    0.47512E-06    0.12444E-05    0.26567E-05    0.00000E+00    0.00000E+00    0.00000E+00    0.70331E-05    0.00000E+00    0.00000E+00   -0.11470E-04    0.00000E+00    0.32868E-04
-     0.47512E-06    0.38350E-04    0.48219E-05   -0.21296E-04    0.00000E+00    0.00000E+00    0.00000E+00   -0.83625E-05    0.00000E+00    0.00000E+00    0.14088E-03    0.00000E+00   -0.22025E-03
-     0.12444E-05    0.48219E-05    0.95613E-05    0.67625E-05    0.00000E+00    0.00000E+00    0.00000E+00    0.26676E-04    0.00000E+00    0.00000E+00   -0.33425E-04    0.00000E+00   -0.49732E-05
-     0.26567E-05   -0.21296E-04    0.67625E-05    0.29354E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.91830E-04    0.00000E+00    0.00000E+00    0.24973E-03    0.00000E+00   -0.23492E-03
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.70331E-05   -0.83625E-05    0.26676E-04    0.91830E-04    0.00000E+00    0.00000E+00    0.00000E+00    0.20327E-03    0.00000E+00    0.00000E+00   -0.38090E-03    0.00000E+00   -0.83922E-03
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-    -0.11470E-04    0.14088E-03   -0.33425E-04    0.24973E-03    0.00000E+00    0.00000E+00    0.00000E+00   -0.38090E-03    0.00000E+00    0.00000E+00    0.21115E-02    0.00000E+00   -0.61157E-03
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.32868E-04   -0.22025E-03   -0.49732E-05   -0.23492E-03    0.00000E+00    0.00000E+00    0.00000E+00   -0.83922E-03    0.00000E+00    0.00000E+00   -0.61157E-03    0.00000E+00    0.32622E+00
--- 0 ----
diff -r -c -b -B -N cosmomc/params.ini cosmomc_sampler/params.ini
*** cosmomc/params.ini	2009-10-27 15:35:25.000000000 +0100
--- cosmomc_sampler/params.ini	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,187 ****
- #Sample parameters for cosmomc in default parameterization
- 
- #Root name for files produced
- file_root = chains/test
- 
- #action = 0:  MCMC, action=1: postprocess .data file, action=2: find best fit point only
- action = 0
- 
- #Maximum number of chain steps
- samples = 200000
- 
- #Feedback level ( 2=lots,1=chatty,0=none)
- feedback = 1
- 
- #Temperature at which to Monte-Carlo
- temperature = 1
- 
- #filenames for CMB datasets and SZ templates (added to C_l times parameter(13))
- #Note you may need to change lmax in cmbtypes.f90 to use small scales (e.g. lmax=2100)
- cmb_numdatasets = 1
- cmb_dataset1 = WMAP
- cmb_dataset_SZ1 = data/WMAP_SZ_VBand.dat
- cmb_dataset_SZ_scale1 = 1
- 
- cmb_dataset2 = data/acbar2007_v3_corr.newdat
- cmb_dataset_SZ2 = data/WMAP_SZ_VBand.dat
- cmb_dataset_SZ_scale2 = 0.28
- 
- cmb_dataset3 = data/CBIpol_2.0_final.newdat
- cmb_dataset4 = data/B03_NA_21July05.newdat
- 
- #filenames for matter power spectrum datasets, incl twodf
- mpk_numdatasets = 1
- mpk_dataset1 = data/lrgDR7kmax02kmin02newmaxLv2ALL_MAGCOVv3.dataset
- #mpk_dataset1 = data/sdss_lrgDR4.dataset
- #mpk_dataset1 = data/2df_2005.dataset
- 
- #filename for supernovae (default SDSS compilation)
- SN_filename = data/supernovae.dataset
- 
- #if true, use HALOFIT for non-linear corrections (astro-ph/0207664).
- #note lyman-alpha (lya) code assumes linear spectrum
- nonlinear_pk = F
- 
- use_CMB = T
- use_HST = F
- use_mpk = F
- use_bao = F
- use_clusters = F
- use_BBN = F
- use_Age_Tophat_Prior = T
- use_SN = F
- use_lya = F
- use_min_zre = 0
- 
- #directory, e.g. window functions in directory windows under data_dir
- data_dir = data/
- 
- #Force computation of sigma_8 even if use_mpk = F
- get_sigma8 = F
- 
- #1: Simple Metropolis, 2: slice sampling, 3: slice sampling fast parameters, 4: directional gridding
- sampling_method = 1
- 
- #if sampling_method =4, iterations per gridded direction
- directional_grid_steps = 20
- 
- #use fast-slow parameter distinctions to speed up 
- #(note for basic models WMAP3 code is only ~3x as fast as CAMB)
- use_fast_slow = F
- 
- #Can use covariance matrix for proposal density, otherwise use settings below
- #Covariance matrix can be produced using "getdist" program.
- propose_matrix = params_CMB.covmat
- 
- #If propose_matrix is blank (first run), can try to use numerical Hessian to 
- #estimate a good propose matrix. As a byproduct you also get an approx best fit point
- estimate_propose_matrix = F
- 
- #Tolerance on log likelihood to use when estimating best fit point
- delta_loglike = 2
- 
- #Scale of proposal relative to covariance; 2.4 is recommended by astro-ph/0405462 for Gaussians
- #If propose_matrix is much broader than the new distribution, make proportionately smaller
- #Generally make smaller if your acceptance rate is too low
- propose_scale = 2.4
- 
- #Increase to oversample fast parameters more, e.g. if space is odd shape
- oversample_fast = 1
- 
- #if non-zero number of steps between sample info dumped to file file_root.data
- indep_sample = 0
- 
- #number of samples to disgard at start; usually set to zero and remove later
- burn_in = 0
- 
- #If zero set automatically
- num_threads = 0
- 
- #MPI mode multi-chain options (recommended)
- #MPI_Converge_Stop is a (variance of chain means)/(mean of variances) parameter that can be used to stop the chains
- #Set to a negative number not to use this feature. Does not guarantee good accuracy of confidence limits.
- MPI_Converge_Stop = 0.03
- 
- #Do initial period of slice sampling; may be good idea if 
- #cov matrix or widths are likely to be very poor estimates
- MPI_StartSliceSampling  = F
- 
- #Can optionally also check for convergence of confidence limits (after MPI_Converge_Stop reached)
- #Can be good idea as small value of MPI_Converge_Stop does not (necessarily) imply good exploration of tails
- MPI_Check_Limit_Converge = F
- 
- #if MPI_Check_Limit_Converge = T, give tail fraction to check (checks both tails):
- MPI_Limit_Converge = 0.025
- #permitted quantile chain variance in units of the standard deviation (small values v slow):
- MPI_Limit_Converge_Err = 0.2
- #which parameter's tails to check. If zero, check all parameters:
- MPI_Limit_Param = 0
- 
- #if MPI_LearnPropose = T, the proposal density is continally updated from the covariance of samples so far (since burn in)
- MPI_LearnPropose = T
- #can set a value of converge at which to stop updating covariance (so that it becomes rigorously Markovian)
- #e.g. MPI_R_StopProposeUpdate = 0.4 will stop updating when (variance of chain means)/(mean of variances) < 0.4
- MPI_R_StopProposeUpdate = 0
- 
- #If have covmat, R to reach before updating proposal density (increase if covmat likely to be poor)
- #Only used if not varying new parameters that are fixed in covmat
- MPI_Max_R_ProposeUpdate = 2
- #As above, but used if varying new parameters that were fixed in covmat
- MPI_Max_R_ProposeUpdateNew = 30
- 
- #if blank this is set from system clock
- rand_seed = 
- 
- #If true, generate checkpoint files and terminated runs can be restarted using exactly the same command
- #and chains continued from where they stopped
- #With checkpoint=T note you must delete all chains/file_root.* files if you want new chains with an old file_root
- checkpoint = F
- 
- 
- #CAMB parameters
- #If we are including tensors
- compute_tensors = F
- #Initial power spectrum amplitude point (Mpc^{-1})
- pivot_k = 0.05
- #If using tensors, enforce n_T = -A_T/(8A_s)
- inflation_consistency = F
- 
- #Whether the CMB should be lensed (slows a lot unless also computing matter power)
- CMB_lensing = T
- #increase accuracy_level to run CAMB on higher accuracy
- #(default is about 0.3%, accuracy_level=2 around 0.1% at high l)
- accuracy_level = 1
- 
- #If action = 1
- redo_likelihoods = T
- redo_theory = F
- redo_cls = F
- redo_pk = F
- redo_skip = 0
- redo_outroot = 
- redo_thin = 1
- redo_add = F
- redo_from_text = F
- #If large difference in log likelihoods may need to offset to give sensible weights
- #for exp(difference in likelihoods)
- redo_likeoffset =  0
- 
- #parameter start center, min, max, start width, st. dev. estimate
- param[omegabh2] = 0.0223 0.005 0.1 0.001 0.001
- param[omegadmh2] = 0.105 0.01 0.99 0.01 0.01
- param[theta] = 1.04 0.5 10 0.002 0.002
- param[tau] = 0.09 0.01 0.8 0.03 0.03
- 
- param[omegak] = 0 0 0 0 0
- param[fnu] = 0 0 0 0 0
- param[w] = -1 -1 -1 0 0
- 
- param[ns] = 0.95 0.5 1.5 0.02 0.01
- param[nt] = 0 0 0 0 0
- param[nrun] = 0 0 0 0 0
- 
- #log[10^10 A_s]
- param[logA] = 3 2.7 4 0.01 0.01
- param[r] = 0 0 0 0 0
- #SZ amplitude, as in WMAP analysis
- param[asz]= 1 0 2 0.4 0.4
--- 0 ----
diff -r -c -b -B -N cosmomc/source/bao.f90 cosmomc_sampler/source/bao.f90
*** cosmomc/source/bao.f90	2009-10-22 14:24:37.000000000 +0200
--- cosmomc_sampler/source/bao.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,86 ****
- ! Percival et al 2009 BAO results hard-coded here by Beth Reid March 2009
- ! Copied structure from supernovae.f90
- !
- !default values from http://arxiv.org/abs/0907.1660
- 
- module bao
- use cmbtypes
- use CAMB, only : AngularDiameterDistance  !!angular diam distance also in Mpc no h units
- use constants
- implicit none
- 
- real(dl), parameter :: rstodvz1 = 0.190533, z1 = 0.2
- real(dl), parameter :: rstodvz2 = 0.109715, z2 = 0.35
- real(dl), dimension(2,2) :: invcov
- 
- contains
- 
-  subroutine BAO_init
- 
- invcov(1,1) = 30124.1d0
- invcov(1,2) = -17226.9d0
- invcov(2,1) = invcov(1,2)
- invcov(2,2) = 86976.6d0
- 
-  end subroutine BAO_init
- 
- function CMBToBAOrs(CMB)
-      use settings
-      use cmbtypes
-      use ModelParams
-      use Precision
-      implicit none
-      Type(CMBParams) CMB
-      double precision zdrag, adrag, atol, rsdrag, myomh2val, b1, b2
-      double precision, external :: dsoundda, rombint
-      real CMBToBAOrs
-      integer error
- 
- !!From Eisenstein and Hu 1998, formula for zdrag.
- !!At zdrag neutrinos are still relativistic, so omega_m h^2 is omch2 + ombh2 (does not include neutrinos).
- !!Note be careful if you muck around here -- I had to add parenthesis and/or d0 to get these numbers to come out correctly.
-        myomh2val = (CMB%omdmh2*(1.0-CMB%nufrac)+CMB%ombh2)
-        b1 = 0.313d0*(myomh2val)**(-0.419d0)*(1.0d0+0.607*(myomh2val)**(0.674d0))
-        b2 = 0.238d0*(myomh2val)**0.223d0
-        zdrag =  1291.0d0*(myomh2val)**0.251d0/(1.0d0+0.659*(myomh2val)**0.828)*(1.0d0+b1*(CMB%ombh2)**b2)
-        adrag = 1.0d0/(1.0d0+zdrag)
-        atol = 1e-6
-        rsdrag = rombint(dsoundda,1d-8,adrag,atol)
-        CMBToBAOrs = rsdrag
-   end function CMBToBAOrs
- 
- real(dl) function BAO_LnLike(CMB)
-   use Precision
-   type(CMBParams) CMB
-   real :: rs, dv1theory, dv2theory, hz1, hz2, omegam
-   real :: rstodvz1theorydelta, rstodvz2theorydelta
-   logical, save :: do_BAO_init = .true.
- 
-   if(do_BAO_init) then
-     call BAO_init
-     do_BAO_init = .false.
-   end if
- 
-   rs = CMBToBAOrs(CMB)
- 
-   !!AngularDiameterDistance and rs returned in Mpc no h units.
-   !! at z <~ 0.5, the neutrinos are nonrelativistic, so they contribute to the matter density, unlike at zdrag.
-   omegam = 1.d0 - CMB%omv - CMB%omk
-   hz1 = sqrt(omegam*(1.0d0+z1)**3.0d0+CMB%omk*(1.0d0+z1)**2.0+CMB%omv*(1.0d0+z1)**(3.0d0*(1.0d0+CMB%w)))
-   hz2 = sqrt(omegam*(1.0d0+z2)**3.0d0+CMB%omk*(1.0d0+z2)**2.0+CMB%omv*(1.0d0+z2)**(3.0d0*(1.0d0+CMB%w)))
-   dv1theory = ((1.0d0+z1)*AngularDiameterDistance(z1))**2.0d0*c*z1/CMB%H0/hz1/1000.0d0
-   dv2theory = ((1.0d0+z2)*AngularDiameterDistance(z2))**2.0d0*c*z2/CMB%H0/hz2/1000.0d0
-   dv1theory = dv1theory**(1.0d0/3.0d0)
-   dv2theory = dv2theory**(1.0d0/3.0d0)
- 
-   rstodvz1theorydelta = rs/dv1theory - rstodvz1
-   rstodvz2theorydelta = rs/dv2theory - rstodvz2
- 
-   BAO_LnLike = 0.5*((rstodvz1theorydelta) * invcov(1,1) * (rstodvz1theorydelta) &
-      & + 2.0d0 * (rstodvz1theorydelta) * invcov(1,2) * (rstodvz2theorydelta) &
-      & + (rstodvz2theorydelta) * invcov(2,2) * (rstodvz2theorydelta))
-  
-    if (Feedback > 1) print *,'BAO_LnLike: ',BAO_LnLike
- end function BAO_LnLike
- 
- end module bao
--- 0 ----
diff -r -c -b -B -N cosmomc/source/bsplinepk.c cosmomc_sampler/source/bsplinepk.c
*** cosmomc/source/bsplinepk.c	2009-10-21 23:07:32.000000000 +0200
--- cosmomc_sampler/source/bsplinepk.c	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,179 ****
- /*
- copied from http://www.gnu.org/software/gsl/manual/html_node/Basis-Splines.html
- */
- 
- #include <assert.h>
- #include <stdlib.h>
- #include <stdio.h>
- #include <string.h>
- #include <math.h>
- #include <gsl/gsl_bspline.h>
- #include <gsl/gsl_multifit.h>
- #include <gsl/gsl_sf_erf.h>
- 
- void geterf_(double *xanderfx) {
-   xanderfx[1] = gsl_sf_erf(xanderfx[0]);
- }
- 
- //spline locations held fixed in Mpc^-1; CMB basically fixed P(k) in these units
- void dopksmoothbspline_(double *kvals, double *lnpklinear, double *lnpksmooth, int *npts)  {
- 
- 	double kmaxsuppress = 0.01*0.7;
- 	size_t n, ncoeffs, nbreak;
- 	gsl_bspline_workspace *bw;
- 	gsl_vector *B;
- 	gsl_vector *c, *w, *x, *y;
- 	gsl_matrix *X, *cov;
- 	gsl_multifit_linear_workspace *mw;
- 	double deltak,lastk;
- 	int i,j,countkeep;
- 
- 	nbreak = 9;
- 	gsl_vector *mybreaks = gsl_vector_alloc(nbreak);
- 	gsl_vector_set(mybreaks,0,(0.001*0.7));
- 	gsl_vector_set(mybreaks,1,(0.025*0.7));
- 	gsl_vector_set(mybreaks,2,(0.075*0.7));
- 	gsl_vector_set(mybreaks,3,(0.125*0.7));
- 	gsl_vector_set(mybreaks,4,(0.175*0.7));
- 	gsl_vector_set(mybreaks,5,(0.225*0.7));
- 	gsl_vector_set(mybreaks,6,(0.275*0.7));
- 	gsl_vector_set(mybreaks,7,(0.325*0.7));
- 	gsl_vector_set(mybreaks,8,(0.375*0.7));
- 
- 	countkeep = 0;
- 	for(i=0;i<(*npts);i++)  {
- 		if((kvals[i]) >= gsl_vector_get(mybreaks,0) && (kvals[i]) <= gsl_vector_get(mybreaks,nbreak-1)) {
- 			countkeep += 1;
- 			}
- 		}
- 	n = countkeep;
- 	ncoeffs = nbreak + 2;
- 
- 	/* allocate a cubic bspline workspace (k = 4) */
- 	bw = gsl_bspline_alloc(4, nbreak);
- 	B = gsl_vector_alloc(ncoeffs);     
- 	x = gsl_vector_alloc(n);
- 	y = gsl_vector_alloc(n);
- 	X = gsl_matrix_alloc(n, ncoeffs);
- 	c = gsl_vector_alloc(ncoeffs);
- 	w = gsl_vector_alloc(n);
- 	cov = gsl_matrix_alloc(ncoeffs, ncoeffs);
- 	mw = gsl_multifit_linear_alloc(n, ncoeffs);
- 	i=0;
- 	for(j=0;j<(*npts);j++)  {
- 		if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) {
- 			gsl_vector_set(x,i,(kvals[j]));
- 			gsl_vector_set(y,i,exp(lnpklinear[j])*pow(kvals[j],1.5));
- 			if(j>0)  {
- 				deltak = kvals[j] - kvals[j-1];
- 				}
- 			else {
- 				deltak = kvals[0];
- 				if(kvals[1] - kvals[0] < deltak)  {
- 					deltak = kvals[1]-kvals[0];
- 					}
- 				}
- 			gsl_vector_set(w,i,deltak);
- 			i+=1;
- 			}
- 		}
- 	gsl_bspline_knots(mybreaks,bw);
- 	for(i=0;i<n;i++)  {
- 		double xi = gsl_vector_get(x,i);
- 		gsl_bspline_eval(xi,B,bw);
- 		for(j=0;j<ncoeffs;j++)  {
- 			double Bj = gsl_vector_get(B,j);
- 			gsl_matrix_set(X,i,j,Bj);
- 			}
- 		}
- 	//do fit
- 	double yi,yierr,chisq;
- 	gsl_multifit_wlinear(X,w,y,c,cov,&chisq,mw);
- 	i = 0;
- 	for(j=0;j<(*npts);j++)  {
- 		if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) {
- 			gsl_bspline_eval(gsl_vector_get(x,i),B,bw);
- 			gsl_multifit_linear_est(B,c,cov,&yi,&yierr);
- 			lnpksmooth[j] = log(yi*pow(kvals[j],-1.5));
- 			i += 1;
- 			}
- 		else {
- 			lnpksmooth[j] = lnpklinear[j];
- 			}
- 		//spline is wacky at small k -- suppress difference at k < 0.01
- 		if(kvals[j] < kmaxsuppress)  {
- 			lnpksmooth[j] = lnpklinear[j];
- 			}
- 		}
- 	assert(i==n);
- 	gsl_bspline_free(bw);
- 	gsl_vector_free(B);
- 	gsl_vector_free(x);
- 	gsl_vector_free(y);
- 	gsl_vector_free(mybreaks);
- 	gsl_matrix_free(X);
- 	gsl_vector_free(c);
- 	gsl_vector_free(w);
- 	gsl_matrix_free(cov);
- 	gsl_multifit_linear_free(mw);
- 	}
- /*
- 
- FILE *open_file_read(char *filename) {
- 	FILE *ifp;
- 
- 	if(!(ifp=fopen(filename,"r")))  {
- 		fprintf(stderr,"Can't open %s\n",filename);
- 		return NULL;
- 		}
- 	else {
- 		return ifp;
- 		}
- 	}	
- 
- int get_file_length(FILE *ifp, int *headercount, int *linecount) {
- 	int i;
- 	char line[256];
- 	
- 	*headercount = 0;
- 	*linecount = 0;
- 			
-     while(fgets(line,256,ifp))  {
-         if(!feof(ifp))  {
-             (*linecount)++;
-             }
- 		else {
- 			break;
- 			}
- 		if(strstr(line,"#"))  {
- 			(*headercount)++;
- 			}
-         }
- 	(void) rewind(ifp);
- 	}
- 
- 
- 
- int main()  {
- 	double *lnpksmooth, *lnpklinear, *kvals;
- 	FILE *ifp;
- 	int headercount, linecount,i,j;
- 	double kval,pnw,plin;
- 	ifp = open_file_read("/Users/breid/cosmomcmnu/test1.cut");
- 	get_file_length(ifp,&headercount,&linecount);
- 	lnpksmooth = (double *) malloc(sizeof(double)*linecount);
- 	lnpklinear = (double *) malloc(sizeof(double)*linecount);
- 	kvals = (double *) malloc(sizeof(double)*linecount);
- 	for(i=0;i<linecount;i++)  {
- 		fscanf(ifp,"%lf %lf %lf\n",&kval,&pnw,&plin);
- 		lnpklinear[i] = plin;
- 		kvals[i] = kval*0.701;
- 		//kvals[i] = kval;
- 		}
- 	dopksmoothbspline_(kvals,lnpklinear,lnpksmooth,&linecount);
- 	for(i=0;i<linecount;i++)  {
- 		printf("%f %f %f\n",kvals[i],lnpklinear[i],lnpksmooth[i]);
- 		}
- 	return 0;
- 	}
- */
--- 0 ----
diff -r -c -b -B -N cosmomc/source/calclike.f90 cosmomc_sampler/source/calclike.f90
*** cosmomc/source/calclike.f90	2009-10-23 10:46:58.000000000 +0200
--- cosmomc_sampler/source/calclike.f90	2009-10-28 18:00:26.100502857 +0100
***************
*** 1,25 ****
  module CalcLike
-  use CMB_Cls
-  use cmbtypes
-  use cmbdata
-  use mpk
   use Random
   use settings
   use ParamDef
-  use snovae
-  use WeakLen
-  use Lya
   implicit none
  
-  logical :: Use_Age_Tophat_Prior = .true.
-  logical :: Use_CMB = .true.
-  logical :: Use_BBN = .false.
-  logical :: Use_Clusters = .false.
-   
-  integer :: H0_min = 40, H0_max = 100
-  real :: Omk_min = -0.3, Omk_max = 0.3
-  real :: Use_min_zre = 0
-  integer :: Age_min = 10, Age_max = 20
   real :: Temperature  = 1
  
  contains
--- 1,9 ----
***************
*** 41,72 ****
    end function GenericLikelihoodFunction
  
    
-   function GetLogPrior(CMB, Info) !Get -Ln(Prior)
-     real GetLogPrior
-     real Age
-     Type (CMBParams) CMB
-     Type(ParamSetInfo) Info
- 
-     GetLogPrior = logZero
-  
-     if (.not. generic_mcmc) then
-      if (CMB%H0 < H0_min .or. CMB%H0 > H0_max) return
-      if (CMB%omk < Omk_min .or. CMB%omk > Omk_max .or. CMB%Omv < 0) return
-      if (CMB%zre < Use_min_zre) return
- 
-      Age = GetAge(CMB, Info)
-       !This sets up parameters in CAMB, so do not delete unless you are careful!
-  
-      if (Use_Age_Tophat_Prior .and. (Age < Age_min .or. Age > Age_max) .or. Age < 0) return
-     
-     end if
-     GetLogPrior = 0
-  
-   end function GetLogPrior
- 
    function GetLogLike(Params) !Get -Ln(Likelihood)
      type(ParamSet)  Params 
-     Type (CMBParams) CMB
      real GetLogLike
      real dum(1,1)
   
--- 25,32 ----
***************
*** 81,176 ****
  
      else
  
!      call ParamsToCMBParams(Params%P,CMB)
! 
!      GetLogLike = GetLogLikePost(CMB, Params%Info,dum,.false.)
      end if 
     end function GetLogLike
  
      
-   function GetLogLikePost(CMB, Info, inCls, HasCls) 
-     real GetLogLikePost
-     Type (CMBParams) CMB
-     Type(ParamSetInfo) Info
-     real, intent(in):: inCls(:,:)
-     logical, intent(in) :: HasCls
-     real acl(lmax,num_cls)
-     integer error
- 
-     if (generic_mcmc) stop 'GetLogLikePost: not supported for generic'
- 
-     GetLogLikePost  = GetLogPrior(CMB, Info)
-     if ( GetLogLikePost >= logZero) then
-        GetLogLikePost = logZero
-        
-     else 
-        GetLogLikePost = GetLogLikePost + sum(CMB%nuisance(1:nuisance_params_used)**2)/2
-           !Unit Gaussian prior on all nuisance parameters
-        if (Use_BBN) GetLogLikePost = GetLogLikePost + (CMB%ombh2 - 0.022)**2/(2*0.002**2) 
-           !I'm using increased error bars here
-    
-        if (Use_CMB .or. Use_LSS) then
-           if (HasCls) then
-            acl = inCls
-            error =0
-           else
-            call GetCls(CMB, Info, acl, error)
-           end if
-          if (error /= 0) then
-           GetLogLikePost = logZero 
-          else
-           if (Use_CMB) GetLogLikePost = &
-             CMBLnLike(acl, CMB%norm(norm_freq_ix:norm_freq_ix+num_freq_params-1),CMB%nuisance) + GetLogLikePost
-           if (Use_mpk) GetLogLikePost = GetLogLikePost + LSSLnLike(CMB, Info%theory)
-           if (Use_WeakLen) GetLogLikePost = GetLogLikePost + WeakLenLnLike(CMB, Info%theory)     
-           if (Use_Lya) GetLogLikePost = GetLogLikePost +  LSS_Lyalike(CMB, Info%Theory)
-           if ( GetLogLikePost >= logZero) then
-             GetLogLikePost = logZero
-           end if
-          end if
-          if (Use_SN .and. GetLogLikePost /= logZero ) then
-             if (Info%Theory%SN_loglike /= 0) then
-              GetLogLikePost = GetLogLikePost + Info%Theory%SN_loglike
-             else
-              GetLogLikePost = GetLogLikePost + SN_LnLike(CMB)
-             end if
-                !Assume computed only every time hard parameters change
-          end if
-          if (Use_BAO .and. GetLogLikePost /= logZero ) then
-             if (Info%Theory%BAO_loglike /= 0) then
-              GetLogLikePost = GetLogLikePost + Info%Theory%BAO_loglike
-             else
-              GetLogLikePost = GetLogLikePost + BAO_LnLike(CMB)
-             end if
-                !Assume computed only every time hard parameters change
-          end if
-          if (Use_HST .and. GetLogLikePost /= logZero) then
-             if (Info%Theory%HST_loglike /= 0) then
-              GetLogLikePost = GetLogLikePost + Info%Theory%HST_loglike
-             else
-              GetLogLikePost = GetLogLikePost + HST_LnLike(CMB)
-             end if
-            !!Old: GetLogLikePost = GetLogLikePost + (CMB%H0 - 72)**2/(2*8**2)  !HST 
-          end if  
-      
-          else
-            if (Use_SN) GetLogLikePost = GetLogLikePost + SN_LnLike(CMB)
-            if (Use_BAO) GetLogLikePost = GetLogLikePost + BAO_LnLike(CMB)
-            if (Use_HST) GetLogLikePost = GetLogLikePost + HST_LnLike(CMB)           
-          end if
-          
-      
-       if (Use_Clusters .and. GetLogLikePost /= LogZero) then
-           GetLogLikePost = GetLogLikePost + &
-                  (Info%Theory%Sigma_8-0.9)**2/(2*0.05**2)
-           stop 'Write your cluster prior in calclike.f90 first!'
-       end if
- 
-      if (GetLogLikePost /= LogZero) GetLogLikePost = GetLogLikePost/Temperature
-    
- 
-     end if
  
-   end function GetLogLikePost
  
  end module CalcLike
--- 41,51 ----
  
      else
  
!        stop
      end if 
     end function GetLogLike
  
      
  
  
  end module CalcLike
diff -r -c -b -B -N cosmomc/source/CMB_Cls_simple.f90 cosmomc_sampler/source/CMB_Cls_simple.f90
*** cosmomc/source/CMB_Cls_simple.f90	2009-10-21 22:14:28.000000000 +0200
--- cosmomc_sampler/source/CMB_Cls_simple.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,506 ****
- !Use CAMB
- module CMB_Cls
-   use cmbtypes
-   use CAMB, only : CAMB_GetResults, CAMB_GetAge, CAMBParams, CAMB_SetDefParams,Transfer_GetMatterPower, &
-           AccuracyBoost,  Cl_scalar, Cl_tensor, Cl_lensed, outNone, w_lam, &
-           CAMBParams_Set, MT, CAMBdata, NonLinear_Pk, Reionization_GetOptDepth, CAMB_GetZreFromTau, &
-           CAMB_GetTransfers,CAMB_FreeCAMBdata,CAMB_InitCAMBdata, CAMB_TransfersToPowers, &
-           initial_adiabatic,initial_vector,initial_iso_baryon,initial_iso_neutrino, initial_iso_neutrino_vel
-           
-   use settings
-   use snovae
-   use bao
-   use HST
-   use IO
-   implicit none
-   logical :: Use_SN =.false. !Compute Supernovae likelihoods only when background changes
-   logical :: Use_HST =.false. !Compute HST likelihoods only when background changes
-   logical :: Use_BAO = .false.
- 
-   logical :: compute_tensors = .false.
-   logical :: CMB_lensing = .false.
-   logical :: use_nonlinear = .false.
- 
-   Type ParamSetInfo  
-     
-     Type (CosmoTheory) :: Theory
-     Type (CAMBdata)    :: Transfers
-     Type (CMBParams)   :: LastParams
-   end Type ParamSetInfo
- 
-   integer, parameter :: ScalClOrder(3) = (/1,3,2/), TensClOrder(4) = (/1,4,2,3/)
-       !Mapping of CAMB CL array ordering to TT , TE, EE, BB  
-   integer :: ncalls = 0
-   type(CAMBParams)  CAMBP 
-   logical :: w_is_w  = .true.
- 
- contains
-   subroutine CMBToCAMB(CMB,P)
-     use LambdaGeneral
-     type(CMBParams) CMB
-     type(CAMBParams)  P
-     P = CAMBP
-     P%omegab = CMB%omb
-     P%omegan = CMB%omnu
-     P%omegac = CMB%omc
-     P%omegav = CMB%omv
-     P%H0 = CMB%H0
-     P%Reion%redshift= CMB%zre    
-     if (w_is_w) then
-      w_lam = CMB%w
-     else
-      P%InitialConditionVector(initial_iso_baryon) = CMB%w
-      w_lam = -1
-     end if
-   end subroutine CMBToCAMB
- 
-  function RecomputeTransfers (A, B)
-    logical RecomputeTransfers
-    type(CMBParams) A, B
- 
-    RecomputeTransfers =  .not. (A%omb == B%omb .and. A%omc == B%omc .and. A%omv == B%omv .and. &
-              A%omnu == B%omnu .and. A%zre == B%zre .and. A%omk == B%omk .and. A%w == B%w)
-               
-  end function RecomputeTransfers
- 
- 
-  subroutine GetCls(CMB,Info, Cls, error)
-    use ModelParams, only : ThreadNum
- #ifdef DR71RG 
-    use lrggettheory
-    real(dl) :: getabstransferscale 
-    !! BR09: this variable is for renormalizing the power spectra to the z=0 value; 
-    !this is the assumption of the LRG model.
- #endif     
-    type(CMBParams) CMB
-    integer error
-    Type(ParamSetInfo) Info
-    real Cls(lmax,1:num_Cls)
-    type(CAMBParams)  P
-    logical NewTransfers
-    integer zix
-    character(LEN=128) :: LogLine
-   
-   
-     error = 0
-     Newtransfers = .false.
-   
-     if (RecomputeTransfers(CMB, Info%LastParams))  then
-      !Slow parameters have changed
-          call CAMB_InitCAMBdata(Info%Transfers)
-          call CMBToCAMB(CMB, P) 
-       
-          if (Feedback > 1) write (*,*) 'Calling CAMB'
-          Threadnum =num_threads
-   
-          call CAMB_GetTransfers(P, Info%Transfers, error)
-          NewTransfers = .true.
-          Info%LastParams = CMB
-          if (Use_SN) then
-             Info%Theory%SN_Loglike = SN_LnLike(CMB)
-          else
-             Info%Theory%SN_Loglike = 0     
-          end if  
-          if (Use_BAO) then
-             Info%Theory%BAO_loglike = BAO_LnLike(CMB)
-          else
-             Info%Theory%BAO_loglike = 0
-          end if 
-          if (Use_HST) then
-             Info%Theory%HST_Loglike = HST_LnLike(CMB)
-          else
-             Info%Theory%HST_Loglike = 0     
-          end if  
-          
-          ncalls=ncalls+1
-          if (mod(ncalls,100)==0 .and. logfile_unit/=0) then
-           write (logLine,*) 'CAMB called ',ncalls, ' times'
-           call IO_WriteLog(logfile_unit,logLine)
-          end if 
-          if (Feedback > 1) write (*,*) 'CAMB done'
- 
-     end if 
-     
- !    if ((error==0) .and. (Newtransfers .or. any(CMB%InitPower /= Info%LastParams%InitPower))) then
-        !Use the initial power spectra to get the Cls and matter power spectrum
-      if (error == 0) then
-       !Always get everything again. Slight waste of time in general, but allows complete mixing of fast
-       !parameters, and works with lensing
- 
-          call SetCAMBInitPower(Info%Transfers%Params,CMB,1)       
- 
-          call CAMB_TransfersToPowers(Info%Transfers)
-             !this sets slow CAMB params correctly from value stored in Transfers
-            
-          call SetTheoryFromCAMB(Info%Theory)
-     
-          if (any(Info%Theory%cl(:,1) < 0 )) then
-             error = 1
-             !Kill initial power spectra that go negative
-             return
-          end if
-    
-          if (Use_LSS) then
-             Info%Theory%sigma_8 = Info%Transfers%MTrans%sigma_8(matter_power_lnzsteps,1)
- #ifdef DR71RG 
-             !! BR09 get lrgtheory info
-             if (num_matter_power /= 0 .and. use_dr7lrg) then
-                 do zix = 1,matter_power_lnzsteps
-                  if(zix .eq. iz0lrg .or. zix .eq. izNEARlrg .or. zix .eq. izMIDlrg .or. zix .eq. izFARlrg) then
-                    call Transfer_GetMatterPowerAndNW(Info%Transfers%MTrans,&
-                      Info%Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                       1,matter_power_minkh, matter_power_dlnkh,num_matter_power,&
-                        kmindata,getabstransferscale, &
-                        Info%Theory%mpk_nw(:,zix),Info%Theory%mpkrat_nw_nl(:,zix))
-                      if(zix == iz0lrg) powerscaletoz0(1) = getabstransferscale**2.0d0
-                      if(zix == izNEARlrg)   powerscaletoz0(2) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                      if(zix == izMIDlrg)   powerscaletoz0(3) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                      if(zix == izFARlrg)   powerscaletoz0(4) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                   else  !! not an LRG redshift, so call regular function.
-                    call Transfer_GetMatterPower(Info%Transfers%MTrans,&
-                      Info%Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                      1,matter_power_minkh, matter_power_dlnkh,num_matter_power)
-                   end if
-                  end do
-                  if(zix == iz0lrg) powerscaletoz0(1) = 1.0d0
-              else if (num_matter_power /= 0) then
-             !! end BR09 get lrgtheory info
- #else
-             if (num_matter_power /= 0) then
- #endif
-                 do zix = 1,matter_power_lnzsteps
-                  call Transfer_GetMatterPower(Info%Transfers%MTrans,& 
-                    Info%Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                     1,matter_power_minkh, matter_power_dlnkh,num_matter_power) 
-                  end do             
-              end if
-          else
-             Info%Theory%sigma_8 = 0
-          end if
- 
-      end if
-      if (error /= 0) return
- 
-      call ClsFromTheoryData(Info%Theory, CMB, Cls)
-      
-  end subroutine GetCls
- 
-  subroutine SetTheoryFromCAMB(Theory)
-    Type(CosmoTheory) Theory
-    real, parameter :: cons =  2.726e6**2*2*pi
-    real nm
-    integer l
- 
-    !The reason we store tensors separately is that can then importance sample re-computing scalars only,
-    !using the stored tensor C_l
- 
-     do l = 2, lmax
- 
-        nm = cons/(l*(l+1))
-        if (CMB_Lensing) then
-             Theory%cl(l,1:num_clsS) =  nm*Cl_lensed(l,1, TensClOrder(1:num_clsS))
-          else 
-             Theory%cl(l,1:num_clsS) =  nm*Cl_scalar(l,1, scalClOrder(1:num_clsS))
-        end if         
-    
-        if (compute_tensors .and. l<=lmax_tensor) then
-             Theory%cl_tensor(l,1:num_cls) =  nm*Cl_tensor(l,1, TensClOrder(1:num_cls))
-        end if
-     end do 
-     
-     if (num_cls>num_clsS) Theory%cl(:,num_clsS+1:num_cls) = 0 
- 
- 
-  end subroutine SetTheoryFromCAMB
- 
-  subroutine GetClsInfo(CMB, Theory, error, DoCls, DoPk)
-    use ModelParams, only : ThreadNum
- #ifdef DR71RG
-    use lrggettheory
-    real(dl) :: getabstransferscale
-    !! BR09: this variable is for renormalizing the power spectra to the z=0 value;
-    !this is the assumption of the LRG model.
- #endif
-    type(CMBParams) CMB
-    Type(CosmoTheory) Theory
-    integer error
-    logical, intent(in) :: DoCls, DoPk
-    type(CAMBParams)  P
-    logical MatterOnly
-    integer zix
-    error = 0
-    Threadnum =num_threads
-    call CMBToCAMB(CMB, P)
-    P%OnlyTransfers = .false.
-    call SetCAMBInitPower(P,CMB,1)   
-     
-    MatterOnly = .false.
-    if (DoPk) then
-       P%WantTransfer = .true.
-       if (.not. DoCls) then
-          MatterOnly = .true.         
-          P%WantScalars = .false.
-          P%WantTensors = .false.
-       end if
-    end if
-    if (DoCls) then
-       !Assume we just want Cls to higher l
-       P%WantScalars = .true.
-       !P%WantTensors = .false.
-       !compute_tensors = .false.
-       P%WantTensors = compute_tensors 
-        
-        if (.not. DoPk) then
-         P%WantTransfer = .false.
-        end if
-    end if
-    
-    call CAMB_GetResults(P)
-    error = 0 !using error optional parameter gives seg faults on SGI
-    if (error==0) then
-        
-       if (DoCls) then
-   
-        Theory%cl_tensor(2:lmax_tensor,1:num_cls) = 0
-        call SetTheoryFromCAMB(Theory)
-       end if
- 
- !!BR09 new addition, putting LRGs back here as well, same structure as above.  
-       if (DoPk) then 
-          Theory%sigma_8 = MT%sigma_8(matter_power_lnzsteps,1)
- 
- #ifdef DR71RG
-          !! BR09 get lrgtheory info
-          if (num_matter_power /= 0 .and. use_dr7lrg) then
-              do zix = 1,matter_power_lnzsteps
-               if(zix .eq. iz0lrg .or. zix .eq. izNEARlrg .or. zix .eq. izMIDlrg .or. zix .eq. izFARlrg) then
-                 call Transfer_GetMatterPowerAndNW(MT,&
-                   Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                    1,matter_power_minkh, matter_power_dlnkh,num_matter_power,&
-                     kmindata,getabstransferscale, &
-                     Theory%mpk_nw(:,zix),Theory%mpkrat_nw_nl(:,zix))
-                      if(zix == iz0lrg) powerscaletoz0(1) = getabstransferscale**2.0d0
-                      if(zix == izNEARlrg)   powerscaletoz0(2) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                      if(zix == izMIDlrg)   powerscaletoz0(3) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                      if(zix == izFARlrg)   powerscaletoz0(4) = powerscaletoz0(1)/getabstransferscale**2.0d0
-                else  !! not an LRG redshift, so call regular function.
-                 call Transfer_GetMatterPower(MT,&
-                   Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                   1,matter_power_minkh, matter_power_dlnkh,num_matter_power)
-                end if
-              end do
-              if(zix == iz0lrg) powerscaletoz0(1) = 1.0d0
-               else if (num_matter_power /= 0) then
-          !! end BR09 get lrgtheory info
- #else
-             if (num_matter_power /= 0) then
- #endif
-                 do zix = 1,matter_power_lnzsteps
-                  call Transfer_GetMatterPower(MT,&
-                    Theory%matter_power(:,zix),matter_power_lnzsteps-zix+1,&
-                     1,matter_power_minkh, matter_power_dlnkh,num_matter_power)
-                  end do
-             end if
-       end if
-       Theory%Age = CAMB_GetAge(P)
- 
-    end if
-  end subroutine GetClsInfo
- 
- 
-  subroutine InitCAMB(CMB,error, DoReion)
-    type(CMBParams), intent(in) :: CMB
-    logical, optional, intent(in) :: DoReion
-    logical WantReion
-    type(CAMBParams)  P
-    integer error
-    
-    if (present(DoReion)) then
-     WantReion = DoReion
-    else
-     WantReion = .true.
-    end if
- 
-    call CMBToCAMB(CMB, P)
-    call CAMBParams_Set(P,error,WantReion)
- 
-  end subroutine InitCAMB
- 
-  function GetOpticalDepth(CMB)
-    type(CMBParams) CMB
-    real GetOpticalDepth
-    type(CAMBParams)  P
-    integer error
-    
-    call CMBToCAMB(CMB, P)
-    call CAMBParams_Set(P,error)
- 
-    if (error/= 0) then
-       GetOpticalDepth = -1 
-    else
-       GetOpticalDepth = Reionization_GetOptDepth(P%Reion, P%ReionHist) 
-    end if
-  end  function GetOpticalDepth
- 
-  function GetZreFromTau(CMB, tau)
-    type(CMBParams) CMB
-    real, intent(in) :: tau
-    real GetZreFromTau
-    type(CAMBParams)  P
-    
-    call CMBToCAMB(CMB, P)
-    GetZreFromTau = CAMB_GetZreFromTau(P,dble(tau))
-  
-  end  function GetZreFromTau 
-  
-  function GetAge(CMB, Info)
-    !Return <0 if error
-    real GetAge
-    type(CMBParams) CMB
-    Type(ParamSetInfo) Info
-    type(CAMBParams)  P
-    call CMBToCAMB(CMB, P)
-  
-    Info%Theory%Age = CAMB_GetAge(P)
-  
-    GetAge = Info%Theory%Age
-  end function GetAge
- 
-  subroutine InitCAMBParams(P)
-    use lensing
-    use ModelParams
-    use Lya
-    use mpk
-    type(CAMBParams)  P 
-    integer zix
-    real redshifts(matter_power_lnzsteps)
- 
-         Threadnum =num_threads
-         w_lam = -1
-         call CAMB_SetDefParams(P)
-  
-         P%OutputNormalization = outNone
-       
-         P%WantScalars = .true.
-         P%WantTensors = compute_tensors
-         P%WantTransfer = Use_LSS
- 
-         P%Max_l=lmax
-         P%Max_eta_k=lmax*2
-         P%Max_l_tensor=lmax_tensor
-         P%Max_eta_k_tensor=lmax_tensor*5./2
-  
-         P%Transfer%k_per_logint=0
-  
-         if (use_nonlinear) then
-          P%NonLinear = NonLinear_Pk
-          P%Transfer%kmax = 1.2
-         else
-          P%Transfer%kmax = 0.8
-         end if
-         if (Use_Lya) P%Transfer%kmax = lya_kmax
-         P%Transfer%num_redshifts = matter_power_lnzsteps
-         
-         if (AccuracyLevel > 1) then
-           if (USE_LSS) then
-             P%Transfer%high_precision=.true.
-             P%Transfer%kmax=P%Transfer%kmax + 0.2
-            end if
-           AccuracyBoost = AccuracyLevel
-           lAccuracyBoost = AccuracyLevel
-           lSampleBoost = AccuracyLevel
-           P%AccurateReionization = .true.
-         end if
-                 
-         if (max_transfer_redshifts < matter_power_lnzsteps) then
-           stop 'Need to manually set max_transfer_redshifts larger in CAMB''s modules.f90'
-         end if
-         if (use_LSS) then
-            redshifts(1) = 0
-            
-            do zix=2, matter_power_lnzsteps
-             !Default Linear spacing in log(z+1) if matter_power_lnzsteps > 1           
-              redshifts(zix) = exp( log(matter_power_maxz+1) * &
-                 real(zix-1)/(max(2,matter_power_lnzsteps)-1) )-1
-                !put in max(2,) to stop compilers complaining of div by zero
-            end do
-            
-            if (use_mpk) call mpk_SetTransferRedshifts(redshifts) !can modify to use specific redshifts
-            if (redshifts(1) > 0.0001) call MpiStop('mpk redshifts: lowest redshift must be zero')
-            do zix=1, matter_power_lnzsteps 
-             !CAMB's ordering is from highest to lowest
-             P%Transfer%redshifts(zix) = redshifts(matter_power_lnzsteps-zix+1)
-            end do
-         else 
-           P%Transfer%redshifts(1) = 0
-          end if   
-         
-         P%Num_Nu_Massive = 3
-         P%Num_Nu_Massless = 0.04
-         P%InitPower%nn = 1
-         P%AccuratePolarization = num_cls/=1 
-         P%Reion%use_optical_depth = .false.
-         P%OnlyTransfers = .true.
- 
-         if (CMB_Lensing) then
-             P%DoLensing = .true.
-             P%Max_l = lmax +250 + 50 !+50 in case accuracyBoost>1 and so odd l spacing
-             P%Max_eta_k = P%Max_l*2 
-         end if
-         
-         lensing_includes_tensors = .false.
- 
-         P%Scalar_initial_condition = initial_vector
-         P%InitialConditionVector = 0
-         P%InitialConditionVector(initial_adiabatic) = -1
- 
- 
-  end subroutine InitCAMBParams
- 
-  subroutine CMB_Initialize(Info)
-    Type(ParamSetInfo) Info
-    type(CAMBParams)  P 
-         compute_tensors = Ini_Read_Logical('compute_tensors',.false.)
-         if (num_cls==3 .and. compute_tensors) write (*,*) 'WARNING: computing tensors with num_cls=3 (BB=0)'
-         CMB_lensing = Ini_Read_Logical('CMB_lensing',.false.)
- 
-         if (Feedback > 0 ) then
-           write (*,*) 'Computing tensors:', compute_tensors
-           write (*,*) 'Doing CMB lensing:',CMB_lensing
-           write(*,'(" lmax           = ",1I4)') lmax       
-           if (compute_tensors) write(*,'(" lmax_tensor    = ",1I4)') lmax_tensor
-           write(*,'(" Number of C_ls = ",1I4)') num_cls
-         end if
- 
-         if (CMB_lensing) num_clsS = num_cls   !Also scalar B in this case
-      
-         call InitCAMBParams(P)
-   
-         call CAMB_InitCAMBdata(Info%Transfers)
-     
-         P%WantTensors = compute_tensors
-         Info%LastParams%omb = -1 !Make sure we calculate the CMB first time called
-         CAMBP = P
-         
-  end subroutine CMB_Initialize
- 
- 
-  subroutine AcceptReject(accpt, CurParams, Trial)
-    logical, intent(in) :: accpt
-    Type(ParamSetInfo) CurParams, Trial
- 
-    if (.not. associated(CurParams%Transfers%ClTransScal%Delta_p_l_k,&
-                         Trial%Transfers%ClTransScal%Delta_p_l_k)) then
-     !If they point to same memory don't need to free anything
-     if (accpt) then
-        call CAMB_FreeCAMBdata(CurParams%Transfers)
-     else
-        call CAMB_FreeCAMBdata(Trial%Transfers)
-     end if
- 
-    end if
- 
-  end subroutine AcceptReject
- 
- end module CMB_Cls
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/cmbdata.F90 cosmomc_sampler/source/cmbdata.F90
*** cosmomc/source/cmbdata.F90	2009-10-27 14:50:36.000000000 +0100
--- cosmomc_sampler/source/cmbdata.F90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1052 ****
- !Module storing observed datasets, their points and window functions
- !and routines for computing the likelihood
- !Cls passed to these routines are in in MicroK^2, no 2pi or l(l+1)
- !WMAP data is handled separately as a special case
- 
- !If windows_are_bandpowers=T Windows functions read in from files are assumed to be W_l/l. 
- !(unless windows_are_bare=T, in which case we assume they are W_l)
- !The band powers are obtained from
- !W_l by \sum_l (l+1/2) W_l C_l/2pi where W_l is normalized so \sum_l (l+1/2)/l(l+1) W_l = 1.
- !If windows_are_normalized=T  the windows are assumed to be already normalized; 
- !this must be the case for polarization in which the window files contain
- ! l TT TE EE BB
- !contributions to each band power. Usually all but two columns will be zeros.
- 
- !If windows_are_bandpowers=F then window functions are assumed raw, and directly related
- !to the bandpowers by B_i=sum_l W_{il} C_l
- 
- !This code is very indebted to Sarah's cosmarg
- !Analytic marginalization over calibration and beam from astro-ph/0112114
- 
- !x factors are described in astro-ph/9808264. Essentially they are a first correction
- !for the bandpower errors being non-Gaussian. If no x-factors we assume they are gaussian.
- !Using x-factors we transform to a variable Z = log (bandpower + x), and assume Z has Gaussian errors.
- !When x-factors are used the inverse covariance matrix is assumed to be that for Z.
- !See the RADPACK page for data http://bubba.ucdavis.edu/~knox/radpack.html
- 
- !This version August 2006
- !Mar 04: added first_band parameter to .dataset files, added format for doing exact likelihoods
- !Jul 05: Readdataset_bcp changes for BOOM/CBI data, allowing for band cuts
- !Mar 06: changed to WMAP 3-year likelihood
- !Aug 06: added cal**2 scaling of x-factors
- !Oct 06: edited ReadAllExact to auto-account for number of cls (e.g. missing BB)
- !Oct 07: added Planck-like CMBLikes format
- !March 08: switched to support WMAP5
- !Sept 09: modified ReadDataset_bcp for QUaD, allowing beam errors to be explicitly provided for each band
- !         CMBLnLike passes array of parameters for frequency-dependent part of signal
- !Oct 27 Oct 09: fixed bugs using .newdat files
- module cmbdata
- use settings
- use cmbtypes
- use MatrixUtils
- use CMBLikes
- implicit none
- 
-  
- !if CMBdataset%has_xfactors then obs, var and N_inv are for the offset-lognormal variables Z
- 
-   Type CMBdatapoint
-     integer win_min, win_max
-      !Ranges in which window is non-zero
-     real, pointer, dimension(:,:) :: window
-      !Normalized window function in l
-     real obs, err_minus, err_plus, sigma, var
-      !Observed value of l(l+1) C_l/2pi bandpowers in MicroK^2, with errors
-     real beam_err !fractional beam error (file is value in MicroK^2)
-     logical inc_pol
- 
-   end Type CMBdatapoint
- 
-   Type CMBdataset
-     logical :: use_set
-     logical :: has_pol, windows_are_bandpowers,windows_are_normalized
-     logical :: has_sz_template
-     real :: calib_uncertainty
-     logical :: beam_uncertain, has_corr_errors, has_xfactors
-     integer :: num_points, file_points
-     character(LEN=80) :: name
-     Type(CMBdatapoint), pointer, dimension(:) :: points
-     real, pointer, dimension(:,:) :: N_inv
-     real, pointer, dimension(:) :: xfactors
-     logical, pointer, dimension(:) :: has_xfactor !whether each bin has one
-     logical :: all_l_exact
-     logical :: CMBLike !New format
-     integer :: all_l_lmax
-     integer :: nuisance_parameters
-     real, pointer, dimension(:,:) :: all_l_obs, all_l_noise
-     real, pointer, dimension(:) :: all_l_fsky
-     real, pointer, dimension(:) :: sz_template
-     Type (TCMBLikes), pointer :: CMBLikes
-   end Type CMBdataset
- 
-   integer :: num_datasets = 0
-   Type(CMBdataset) datasets(10)
- 
-   logical :: init_MAP = .true.
- 
-   integer :: cl_bin_width =1
- 
-  
-   integer, parameter :: halfsteps = 5 !do 2*halfsteps+1 steps in numerical marginalization
-   real margeweights(-halfsteps:halfsteps)
-   real :: margenorm = 0 
-   private halfsteps, margeweights, margenorm
- contains
- 
- 
-  subroutine ReadWindow(AP, aname, are_bare, aset)
-    Type(CMBdatapoint) AP
-    character(LEN=*), intent(IN) :: aname
-    logical, intent(IN) :: are_bare
-    Type (CMBdataset) :: aset
-    integer l, ncls
-    real wpol(1:num_cls-1),ll, IW,w
-    character(LEN=200) tmp
- 
-    if (Feedback > 1) write (*,*) 'reading window: '//trim(aname)
- 
-    if (aset%has_pol) then
-     ncls = num_cls
-    else
-     ncls = 1
-    endif
-    allocate(AP%window(ncls,lmax))
- 
-    AP%window = 0
- 
-    call OpenTxtFile(aname, tmp_file_unit)
- 
-      do
-      if (aset%has_pol) then
-        read(tmp_file_unit,'(a)',end=1) tmp
-        read(tmp,*, end=1) ll, w, wpol
-      else
-        read(tmp_file_unit,*, end=1) ll, w
-      end if
- 
-      l=nint(ll)
-      if (abs(l-ll) > 1e-4) stop 'non-integer l in window file' 
-      if (l>=2 .and. l<=lmax) then
-         AP%window(1,l) = w
-         if(aset%has_pol) then
-          AP%window(2:num_cls,l) = wpol
-         end if
-        if (.not. are_bare) AP%window(:,l) = AP%window(:,l)*l
-      else
-         if (l>lmax .and. w /= 0) then
-            write (*,*) 'Warning: Window function non-zero outside l_max: ',trim(aname)
-            write (*,*) 'assuming contribution is negligible'
-            exit
-         end if
-      end if
- 
-      end do
- 1  close(tmp_file_unit)
- 
-    do l=2, lmax
-       if (any(AP%window(:,l)/=0)) then
-          AP%win_min = l
-          exit
-       end if
-    end do
- 
-    do l=lmax,2,-1
-       if (any(AP%window(:,l)/=0)) then
-          AP%win_max = l
-          exit
-       end if
-    end do
- 
-    AP%inc_pol = .false.
- 
-    if (aset%windows_are_bandpowers) then
-        IW = 0
-        do l = AP%win_min, AP%win_max
-           IW = IW + ((l+0.5)*AP%window(1,l))/(l*(l+1))
-           AP%window(:,l) = AP%window(:,l)*(l+0.5)/(2*pi)
-        end do
-        if (.not. aset%windows_are_normalized) then
-           if (aset%has_pol) stop 'Polarization windows must be normalized'
-           AP%window(1,AP%win_min:AP%win_max) = &
-                       AP%window(1,AP%win_min:AP%win_max)/IW
-        end if
-    end if
-     !If has_pol we are assuming windows are normalized
-   
-    if (aset%has_pol) AP%inc_pol = any(AP%window(2:num_cls,:)/=0)
-   
-  end subroutine ReadWindow
- 
-  subroutine ReadAllExact(Ini,aset)
-       Type(TIniFile) :: Ini
-       Type (CMBdataset) :: aset
-       character(LEN=Ini_max_string_len) :: fname
-       integer l, idum, ncls, ncol
-       real inobs(4)
-       integer file_unit
- 
-     !In this case we have data for every l, and use exact full-sky likelihood expression
-     !with some fudge factor fsky_eff^2 to reduce the degrees of freedom: fsky^eff*(2l+1)
-         
-        if (Feedback > 0) &
-         write(*,*) 'all_l_exact note: you might want to change fsky_eff^2 factor to fsky_eff' 
- 
-        aset%num_points = 0
-        aset%all_l_lmax = Ini_Read_Int_File(Ini,'all_l_lmax')
- 
-        if (aset%all_l_lmax > lmax) stop 'cmbdata.f90::ReadAllExact: all_l_lmax > lmax'
-        if (aset%has_pol) then
-         allocate(aset%all_l_obs(2:aset%all_l_lmax,num_cls))
-         allocate(aset%all_l_noise(2:aset%all_l_lmax,2))
-        else
-         allocate(aset%all_l_obs(2:aset%all_l_lmax,1))
-         allocate(aset%all_l_noise(2:aset%all_l_lmax,1))
-        end if
-        allocate(aset%all_l_fsky(2:aset%all_l_lmax))
-        fname = trim(Ini_Read_String_File(Ini,'all_l_file'))
-        ncol = TxtFileColumns(fname)
-        if (ncol==7) then
-          ncls = 3
-        elseif (ncol==8) then
-          ncls = 4
-        elseif (ncol==4) then 
-          ncls=1
-          if (aset%has_pol) stop 'cmbdata.f90::ReadAllExact: has_pol wrong'
-        else
-           stop 'cmbdata.f90::ReadAllExact: wrong number of columns'
-        end if
-        
-        file_unit =  new_file_unit()
- 
-        call OpenTxtFile(fname,file_unit)
- !File format:
- !l C_TT (C_TE C_EE [C_BB]) N_T (N_P) fsky_eff
- !Must have num_cls set to correct value for file
-        do l = 2, aset%all_l_lmax
-           read (file_unit, *, end=100, err=100) idum,inobs(1:ncls), aset%all_l_noise(l,:), aset%all_l_fsky(l)
-           if (idum /= l) stop 'Error reading all_l_file'
-             !set BB to pure noise if not in file
-           if (aset%has_pol .and. ncls < num_cls) inobs(num_cls) = aset%all_l_noise(l,2)
-           aset%all_l_obs(l,:) = inobs(1:num_cls)
-         end do
-        call CloseFile(file_unit)
- 
-        return
- 100    stop 'Error reading all_l_file file'
-      
- 
-  end subroutine ReadAllExact
- 
- 
-  function ChiSqExact(cl, aset) 
-   !Compute -ln(Likelihood) 
-    real cl(lmax,num_cls)
-    Type(CMBdataset) :: aset
-    integer l
-    real ChiSqExact, chisq, term, CT, CE, CB, CC
-    real CThat, CChat, CEhat
-    real dof
-    integer i
- 
-    chisq=0
- 
-    
-    do l=2, 30 
-      dof = aset%all_l_fsky(l)**2*(2*l+1)
-        !Ignoring l correlations but using f_sky^2_eff fudge factor may be a good approx
-        !for nearly full sky observations
-      CT = cl(l,1) + aset%all_l_noise(l,1)
-      if (aset%has_pol) then
-       CE = cl(l,3) + aset%all_l_noise(l,2)
-       term = CT*CE- cl(l,2)**2
-       chisq = chisq + dof*( &
-        (CT*aset%all_l_obs(l,3) + CE*aset%all_l_obs(l,1) - 2 *cl(l,2)*aset%all_l_obs(l,2))/term &
-         + log( term/ (aset%all_l_obs(l,1)*aset%all_l_obs(l,3) - aset%all_l_obs(l,2)**2)) -2)
-       if (num_cls>3) then
-         !add in BB
-         CB = cl(l,num_cls) + aset%all_l_noise(l,2)
-         chisq = chisq + dof * (aset%all_l_obs(l,num_cls)/CB &
-                 +log(CB/aset%all_l_obs(l,num_cls)) - 1)
-       end if
-      else
-         chisq = chisq + dof * (aset%all_l_obs(l,1)/CT &
-                 +log(CT/aset%all_l_obs(l,1)) - 1)
-      end if
-    end do
- 
- 
-    do l=31 , aset%all_l_lmax, cl_bin_width
-      dof = 0
-      CT=0
-      CE=0
-      CC=0
-      CThat=0
-      CEhat=0
-      CChat=0
-      do i=l,l+cl_bin_width-1
-       dof = dof + aset%all_l_fsky(i)**2*(2*i+1)
-       CT = CT + (cl(i,1) + aset%all_l_noise(i,1))*(2*i+1)
-       CThat = CThat + aset%all_l_obs(i,1)*(2*i+1)
-       if (aset%has_pol) then
-        CE = CE + (cl(i,3) + aset%all_l_noise(i,2) ) *(2*i+1)
-        CC = CC +  cl(i,2)*(2*i+1)
-        CEhat = CEhat + aset%all_l_obs(i,3)*(2*i+1)
-        CChat = CChat + aset%all_l_obs(i,2)*(2*i+1)
-       end if
-      end do
- 
- 
-      if (aset%has_pol) then
-       term = CT*CE - CC**2
-       chisq = chisq + dof*( &
-        (CT*CEHat + CE*CThat - 2 *CC*CCHat)/term &
-         + log( term/ (CTHat*CEHat - CCHat**2)) -2)
-       if (num_cls>3) then
-         !add in BB
-         CB = cl(i,num_cls) + aset%all_l_noise(i,2)
-         chisq = chisq + dof * (aset%all_l_obs(i,num_cls)/CB &
-                 +log(CB/aset%all_l_obs(i,num_cls)) - 1)
-       end if
-      else
-         chisq = chisq + dof * (CTHat/CT +log(CT/CTHat) - 1)
-      end if
-    end do
- 
-    ChiSqExact = ChiSq
- 
-  end function ChiSqExact
- 
-  subroutine ReadDataset(aname)
-    use CMBLikes
-    character(LEN=*), intent(IN) :: aname
-    character(LEN=Ini_max_string_len) :: InLine, window_dir, Ninv_file, xfact_file, band_file
-    logical bad, windows_are_bare
-    Type (CMBdataset) :: aset
-    integer i, first_band, use_i
-    real, pointer, dimension(:,:) :: tmp_mat
-    real, pointer, dimension(:) :: tmp_arr
-    character(LEN=Ini_max_string_len) :: data_format
-    integer file_unit
-    Type(TIniFile) :: Ini
-    
-    num_datasets = num_datasets + 1
-    
-    if (num_datasets > 10) stop 'too many datasets'
- 
-    aset%has_sz_template = .false.
-    aset%nuisance_parameters = 0
-  
- !Special cases
-    if (aname == 'MAP' .or. aname == 'WMAP') then 
-      aset%name = 'WMAP'
-      datasets(num_datasets) = aset
-      return   
-    elseif( aname(LEN_TRIM(aname)-5:LEN_TRIM(aname)) == 'newdat') then
-     !Carlo format for polarized Boomerang et al.
-      if (Feedback > 0) write(*,*) 'Reading BCP data set: ' // TRIM(aname)
-      call ReadDataset_bcp(aset,aname)
-      datasets(num_datasets) = aset
-      return 
-    end if
- 
-    file_unit = new_file_unit()
-    
-    call Ini_Open_File(Ini,aname, file_unit, bad, .false.)
-    if (bad) then
-      write (*,*)  'Error opening dataset file '//trim(aname)
-      stop
-    end if
-    Ini_fail_on_not_found = .true.
-       
-    aset%name = Ini_Read_String_File(Ini,'name')
-    aset%use_set =.true.
-    aset%num_points = 0
-     
-    if (Feedback > 0) write (*,*) 'reading: '//trim(aset%name)
- 
-    Ini_fail_on_not_found = .false.
- 
-    data_format  = Ini_Read_String_File(Ini,'dataset_format')
- 
-    aset%CMBlike = data_format == 'CMBLike'
- 
-    aset%all_l_exact = (data_format =='all_l_exact') &
-             .or. Ini_Read_Logical_File(Ini,'all_l_exact',.false.)
-    if (aset%CMBLike) then
-       allocate(aset%CMBLikes)
-       call CMBLikes_ReadData(aset%CMBLikes, Ini, ExtractFilePath(aname))
-       aset%nuisance_parameters = aset%CMBLikes%num_nuisance_parameters 
-     
-    else if (aset%all_l_exact) then
-        aset%has_pol = Ini_Read_Logical_File(Ini,'has_pol',.false.)
-        call ReadAllExact(Ini,aset)
-    else if (data_format/='') then
-         write(*,*) 'Error in '//trim(aname)
-         write(*,*) 'Unknown data_format: '//trim(data_format)
-         stop
-    else
-     !Otherwise do usual guassian/offset lognormal stuff
- 
-        aset%has_pol = Ini_Read_Logical_File(Ini,'has_pol',.false.)
- 
-        aset%num_points = Ini_Read_Int_File(Ini,'num_points')
- 
-        aset%calib_uncertainty = Ini_Read_Double_File(Ini,'calib_uncertainty')
-        aset%beam_uncertain = Ini_Read_logical_File(Ini,'beam_uncertainty')
-         
-        window_dir  = ReadIniFilename(Ini,'window_dir')
- 
-        windows_are_bare = Ini_Read_Logical_File(Ini,'windows_are_bare',.false.)
-        aset%windows_are_bandpowers = Ini_Read_Logical_File(Ini,'windows_are_bandpowers',.true.)
-        aset%windows_are_normalized = Ini_Read_Logical_File(Ini,'windows_are_normalized',.false.)
-   
-        aset%file_points = Ini_read_Int_File(Ini,'file_points',aset%num_points)
-        first_band = Ini_read_Int_File(Ini,'first_band',1)
-        if (first_band + aset%num_points > aset%file_points+1) then
-             write (*,*)  'Error with dataset file '//trim(aname)
-             write (*,*) 'first_band + num_points > file_points'
-             stop
-        end if
-     !Read in the observed values, errors and beam uncertainties
-        allocate(aset%points(aset%num_points))
-        band_file = Ini_Read_String_File(Ini,'bandpowers')
-        if (band_file /= '') call OpenTxtFile(band_file, 51)
-        Ini_fail_on_not_found = .true.
-        do i=1, aset%num_points + first_band -1
-           if (band_file /= '') then
-             read(51,'(a)') InLine
-           else
-             InLine = Ini_Read_String_File(Ini,numcat('data',i))
-           end if
-           if (i < first_band) cycle
-           use_i = i - first_band + 1          
-           if (aset%beam_uncertain) then
-             read(InLine,*) aset%points(use_i)%obs, aset%points(use_i)%err_minus, aset%points(use_i)%err_plus, &
-                             aset%points(use_i)%beam_err
-             aset%points(use_i)%beam_err = aset%points(use_i)%beam_err/aset%points(use_i)%obs
-           else
-            read(InLine,*) aset%points(use_i)%obs, aset%points(use_i)%err_minus, aset%points(use_i)%err_plus
-            aset%points(use_i)%beam_err = 0
-           end if
-           aset%points(use_i)%sigma = (aset%points(use_i)%err_minus + aset%points(use_i)%err_plus)/2
-           aset%points(use_i)%var = aset%points(use_i)%sigma**2
-           call ReadWindow(aset%points(use_i),trim(window_dir)//'/'//trim(numcat(aset%name,i)),windows_are_bare,aset)
-        end do
-        if (band_file /= '') Close(51)
-   
- 
-     !See if the inverse covariance matrix is given (otherwise assume diagonal)
-        Ini_fail_on_not_found = .false.
-     
-        Ninv_file = Ini_Read_String_File(Ini,'N_inv')
-        aset%has_corr_errors = Ninv_file /= ''
-        if (aset%has_corr_errors) then
-           allocate(tmp_mat(aset%file_points,aset%file_points))
-           allocate(aset%N_inv(aset%num_points,aset%num_points))
-           call ReadMatrix(Ninv_file, tmp_mat,aset%file_points,aset%file_points)
-           if (aset%num_points /= aset%file_points) then
-             !!Changed to truncation of covariance matrix, AL: May 2003
-             call Matrix_Inverse(tmp_mat)
-             aset%N_inv = tmp_mat(first_band:first_band+aset%num_points-1,&
-                     first_band:first_band + aset%num_points -1)
-             call Matrix_Inverse(aset%N_inv)
-           else
-             aset%N_inv = tmp_mat(1:aset%num_points,1:aset%num_points)
-           end if
-           deallocate(tmp_mat)
-        end if
- 
-        if (Ini_Read_Logical_File(Ini,'use_hyperparameter',.false.)) stop 'Hyperparameters deprecated'
- 
-     !See if xfactors are given
- 
-        xfact_file = Ini_Read_String_File(Ini,'xfactors')
-        aset%has_xfactors = xfact_file /= ''
- 
-        if (aset%has_xfactors) then
-           allocate(tmp_arr(aset%num_points + first_band -1))
-           call ReadVector(xfact_file, tmp_arr,aset%num_points+ first_band -1)
-           allocate(aset%xfactors(aset%num_points))
-           allocate(aset%has_xfactor(aset%num_points))
-           aset%has_xfactor = .true.
-           aset%xfactors = tmp_arr(first_band:first_band+aset%num_points-1)
-           deallocate(tmp_arr)
-           aset%points(:)%var = aset%points(:)%var/(aset%points(:)%obs +aset%xfactors)**2
-           aset%points(:)%obs = log(aset%points(:)%obs +aset%xfactors)
-         
-        end if
- 
-    end if !not all_l_exact or cut sky unbinned
-    
-    call Ini_Close_File(Ini)
-    call ClearFileUnit(file_unit)
- 
-    datasets(num_datasets) = aset
- 
-  end subroutine ReadDataset
- 
-  subroutine ReadSZTemplate(aset, aname, ascale)
-     Type (CMBdataset) :: aset
-     real, intent(in) :: ascale
-     character(LEN=*), intent(IN) :: aname
-     integer l, unit
-     real sz
-      allocate(aset%sz_template(2:lmax))
-      aset%sz_template = 0
-      aset%has_sz_template = .true.
-      call OpenTxtFile(aname, tmp_file_unit)
-      do
-        read(tmp_file_unit,*,end=2) l, sz
-        if (l>=2 .and. l<=lmax) aset%sz_template(l) = ascale * sz/(l*(l+1)/twopi)
-      end do
-      
- 2    Close(tmp_file_unit)
-  end subroutine ReadSZTemplate
- 
-  function GetWinBandPower(AP, cl)
-    real  GetWinBandPower
-    real cl(lmax,num_cls)
-    Type(CMBdatapoint) AP
-    integer l
-    real bandpower
- 
-    bandpower = sum(cl(AP%win_min:AP%win_max,1)*AP%window(1,AP%win_min:AP%win_max))
- 
-    if (AP%inc_pol) then
-        do l= AP%win_min, AP%win_max
-            bandpower = bandpower + sum(cl(l,2:num_cls)*AP%window(2:num_cls,l))
-        end do
-    endif
-    GetWinBandPower  = bandpower
-      
-  end function GetWinBandPower
-  
-  subroutine InitNumericalMarge
-    integer i
- 
-    do i= -halfsteps, halfsteps
-     margeweights(i) = exp(-(i*3/real(halfsteps))**2/2)
-    end do
-    margenorm = sum(margeweights)
- 
-  end subroutine InitNumericalMarge
- 
-  function GetCalibMargexChisq(bandpowers, aset)
-   !Numerically integrate over the calibration uncertainty
-   !Assume Gaussian prior, as for analytic calculation without x-factors
-   !Could also Monte-Carlo
-    real GetCalibMargexChisq
-    Type(CMBdataset) aset
-    real bandpowers(aset%num_points),beambandpowers(aset%num_points),diffs(aset%num_points)
-    real calib, chisq(-halfsteps:halfsteps),chisqcalib(-halfsteps:halfsteps)
-    real minchisq
-    integer i,j, ibeam
- 
-    if (margenorm == 0) call InitNumericalMarge
- 
-    do ibeam= -halfsteps, halfsteps
- 
-       if (aset%beam_uncertain) then
-          beambandpowers = bandpowers*(1 + aset%points(:)%beam_err*ibeam*3/real(halfsteps))!Go out to 3 sigma
-       else
-          beambandpowers = bandpowers
-       end if
- 
-       do i=-halfsteps,halfsteps
- 
-          calib = 1 + aset%calib_uncertainty*i*3./halfsteps !Go out to 3 sigma
- 
-         if (aset%has_xfactors) then 
-          do j=1, aset%num_points
-           if (aset%has_xfactor(j)) then
-             diffs(j) = aset%points(j)%obs- log(calib*beambandpowers(j) + aset%xfactors(j))
-           else
-             diffs(j) = aset%points(j)%obs - calib*beambandpowers(j)
-           endif       
-          end do
-         else
-             diffs = aset%points(:)%obs - calib*beambandpowers
-         end if 
- 
-          if (aset%has_corr_errors) then
-             chisq(i) = SUM(diffs*MATMUL(aset%N_inv,diffs))
-           else
-             chisq(i) = SUM(diffs**2/aset%points(:)%var)  
-          end if
-       end do
- 
-       minchisq = minval(chisq)
- 
-       chisqcalib(ibeam) = -2*log(sum(margeweights*exp(max(-30.,-(chisq-minchisq)/2)))/margenorm) + minchisq
- 
-       if (.not. aset%beam_uncertain) then
-          GetCalibMargexChisq = chisqcalib(ibeam)
-          return
-       end if
- 
-    end do
- 
-    minchisq = minval(chisqcalib)
-    GetCalibMargexChisq = -2*log(sum(margeweights*exp(max(-30.,-(chisqcalib-minchisq)/2)))/margenorm) + minchisq
-   
-  end function GetCalibMargexChisq
- 
- 
-   !Routine by Carlo Contaldi to read .newdat file format (Boomerang et al)
-   !Modified to account for offset lognormal toggle per band
-   !AL July 2005: modified to allow band selection
-   !MLB May 09: modified to allow provision of per-band beam errors (Quad)
-  SUBROUTINE ReadDataset_bcp(aset,aname)
-   !File Format:
-   !name
-   !n_bands_TT n_EE, n_BB, n_EB, n_TE, n_TB
-   !has_calib_uncertain calib(amplitude) calib_err(power)
-   !has_beam_uncertain beam beam_err
-   !ilike (0: Gaussian, 1: all x-factor, 2: specified have x-factor)
-   !loop over {
-   ! band-types
-   ! band info: num obs + - x_factor l_min l_max use_x
-   ! correlation-matrix (ignored)
-   ! }  
-   ! covariance matrix
- 
-    CHARACTER(LEN=*), INTENT(IN) :: aname
-    TYPE (CMBdataset) :: aset
- 
-    CHARACTER(LEN=100) :: instr
-    CHARACTER(LEN=3), DIMENSION(1:6) :: ch_types
- 
-    LOGICAL windows_are_bare
-    INTEGER i, j, k,use_i, n_types, xin
-    REAL, POINTER, DIMENSION(:) :: tmp_x
-    REAL, POINTER, DIMENSION(:,:) :: lb
-    real, allocatable, dimension(:,:) :: tmp_mat
-    integer, allocatable, dimension(:) :: used_bands
- 
-    INTEGER :: npol(6), minmax(2,6)
-    INTEGER :: file_i,ijunk, ilike, ibeam
-    REAL :: cal, beam_width, beam_sigma, l_mid
-    integer, parameter :: like_xfactorall=1, like_xfactorsome = 2
-    !to be compatible with some older CITA output files
-    LOGICAL :: FISHER_T_CMB
-    integer file_unit
-    
-    
-    file_unit = new_file_unit()
-    CALL OpenTxtFile(aname, file_unit)
- 
-    READ(file_unit,'(a)') instr
-    FISHER_T_CMB = .FALSE.
-    IF(instr == 'FISHER_T_CMB') THEN
-       FISHER_T_CMB = .TRUE.
-       READ(file_unit,'(a)') instr
-       WRITE(*,'(a)') 'FISHER_T_CMB is set for :'//TRIM(ADJUSTL(instr))
-    ENDIF
-    aset%name = TRIM(ADJUSTL(instr))
-    WRITE(*,*) 'Reading: '//TRIM(ADJUSTL(aset%name))
-    aset%use_set =.TRUE.
- 
-    READ(file_unit,*) npol(1:6)
- 
-    aset%has_pol = any(npol(2:6) /=0)
-  
-    aset%all_l_exact = .FALSE.
-    aset%file_points = SUM(npol)
-    aset%num_points = SUM(npol)
-    n_types = count(npol /= 0)
-    READ(file_unit,'(a)') instr
-    IF(instr == 'BAND_SELECTION') THEN
-       !list of 'first_band last_band' for each pol type
-       !if first_band=0 then ignore that pol type
-       aset%num_points = 0
-       aset%has_pol = .false.
-       if(feedback>0) WRITE(*,*) 'Using selected band ranges' 
-       do i=1,6
-        READ(file_unit,*) minmax(1:2,i)
-        if (minmax(1,i)/=0) then
-         aset%num_points = aset%num_points + minmax(2,i) - minmax(1,i) + 1
-         if (i>1) aset%has_pol = .true.
-        else
-         minmax(2,i) = 0
-        end if
-       end do
-       READ(file_unit,'(a)') instr
-    ELSE
-      !use all bands in file
-       do i=1,6
-         minmax(1,i)=1
-         minmax(2,i)=npol(i)
-       end do  
-    ENDIF
- 
- 
-    READ(instr,*) ijunk, cal, aset%calib_uncertainty
-    IF(ijunk == 0) aset%calib_uncertainty = 0.e0
- 
-    READ(file_unit,*) ibeam, beam_width, beam_sigma
-    aset%beam_uncertain = ibeam /= 0
- 
-    !this agrees with latest windows coming out of MPIlikely
-    windows_are_bare = .FALSE.
-    aset%windows_are_bandpowers = .TRUE. 
-    aset%windows_are_normalized = .TRUE.
- 
-    ALLOCATE(aset%points(aset%num_points))
-    allocate(used_bands(aset%num_points))
- 
-    READ(file_unit,*) ilike
-    aset%has_xfactors = ilike ==like_xfactorsome .or. ilike==like_xfactorall 
-    !1 : all bands are offset lognormal
-    !2 : only bands specified have offset lognormal
-    IF(aset%has_xfactors) then
-      ALLOCATE(aset%has_xfactor(1:aset%num_points))
-      aset%has_xfactor = .true.
-    end if
- 
-    ALLOCATE(tmp_x(1:aset%num_points))
-    ALLOCATE(lb(1:aset%num_points,1:2))
-    k = 0
-    use_i = 0
-    file_i = 0
-    DO j=1,n_types
-       READ(file_unit,'(a2)') ch_types(j)
-       k = k + 1
-       DO i=1,20
-          IF(npol(k) == 0 ) THEN
-             k = k + 1
-          ELSE
-             EXIT
-          ENDIF
-       ENDDO
-      
-       if(feedback>1) write(*,*) j, ch_types(j), minmax(1,k), minmax(2,k)
-     
-       DO i=1,npol(k)
-          file_i = file_i+1
-          if (i>=minmax(1,k) .and. i<=minmax(2,k)) then
-              use_i = use_i + 1
-              used_bands(use_i) = file_i
-             IF(ibeam .le. 1) THEN 
-                IF(ilike /= like_xfactorsome) THEN
-                   READ(file_unit,'(a)') instr
-                   READ(instr,*) ijunk, aset%points(use_i)%obs,aset%points(use_i)%err_minus, &
-                        aset%points(use_i)%err_plus,tmp_x(use_i),lb(use_i,1),lb(use_i,2)
-                ELSE
-                   !like_xfactorsome
-                   !read also offset switch per band
-                   READ(file_unit,*) ijunk, aset%points(use_i)%obs,aset%points(use_i)%err_minus, &
-                        aset%points(use_i)%err_plus,tmp_x(use_i),lb(use_i,1),lb(use_i,2),xin
-                   aset%has_xfactor(use_i) = xin/=0
-                ENDIF
-                !beam error in bandpower
-                l_mid = (lb(use_i,2)-lb(use_i,1))/2.d0 + lb(use_i,1)
-                aset%points(use_i)%beam_err = exp(-l_mid*(l_mid+1.d0)*1.526e-8*2.d0*beam_sigma*beam_width)-1.d0 
-                aset%points(use_i)%beam_err = abs(aset%points(use_i)%beam_err)
-             ELSE !Bandpowers from file, a la Quad
-                IF(ilike /= like_xfactorsome) THEN
-                   READ(file_unit,'(a)') instr
-                   READ(instr,*) ijunk, aset%points(use_i)%obs,aset%points(use_i)%err_minus, &
-                        aset%points(use_i)%err_plus,tmp_x(use_i),lb(use_i,1),lb(use_i,2),aset%points(use_i)%beam_err
-                ELSE 
-                   !like_xfactorsome
-                   !read also offset switch per band
-                   READ(file_unit,*) ijunk, aset%points(use_i)%obs,aset%points(use_i)%err_minus, &
-                        aset%points(use_i)%err_plus,tmp_x(use_i),lb(use_i,1),lb(use_i,2),xin,aset%points(use_i)%beam_err
-                   aset%has_xfactor(use_i) = xin/=0
-                ENDIF
-                l_mid = (lb(use_i,2)-lb(use_i,1))/2.d0 + lb(use_i,1)
-             ENDIF
-             aset%points(use_i)%sigma = (aset%points(use_i)%err_minus + aset%points(use_i)%err_plus)/2
- 
-             if (Feedback>1 ) print*, aset%beam_uncertain, l_mid, aset%points(use_i)%beam_err 
- 
-              !recalibrate
-              aset%points(use_i)%obs = cal**2 * aset%points(use_i)%obs
-              aset%points(use_i)%sigma = cal**2 * aset%points(use_i)%sigma
- 
-              aset%points(use_i)%var = aset%points(use_i)%sigma**2
- !AL: Oct 08, changed to set path from the dataset path
-              CALL ReadWindow(aset%points(use_i), trim(concat(ExtractFilePath(aname),'windows/')) // &
-                   TRIM(numcat(aset%name,file_i)),windows_are_bare,aset)
- 
-          else
-           !discard band
-           READ(file_unit,'(a)') instr
-          end if
-       ENDDO
-       !discard correlation submatrix 
-       READ(file_unit,'(a)') (instr,i=1,npol(k)) 
-    ENDDO
- 
-    !assume always have the matrix
-    aset%has_corr_errors = .TRUE.
-    allocate(tmp_mat(aset%file_points,aset%file_points))
-    ALLOCATE(aset%N_inv(aset%num_points,aset%num_points))
-    READ(file_unit,*) (tmp_mat(1:aset%file_points,i),i=1,aset%file_points)
-    aset%N_inv = tmp_mat(used_bands,used_bands)
-    deallocate(tmp_mat)
-    deallocate(used_bands)
-  
-    !READ(file_unit,*,err=101,end=101) instr
-    !stop 'ReadDataset_bcp:Should be at end of file after reading matrix'
- 101 call CloseFile(file_unit)
- 
-    !recalibrate and change units as required
-    !some older output had final fisher matrix in 
-    !in units of T_CMB whitle bandpowers are in units
-    !of \microK^2
-    IF(FISHER_T_CMB) THEN
-       aset%N_inv = cal**4 * aset%N_inv *2.725**4 * 1.e24
-    ELSE
-       aset%N_inv = cal**4 * aset%N_inv
-    ENDIF
- 
-    IF(aset%has_pol) WRITE(*,*) 'has pols: ', ADJUSTR(ch_types(1:n_types))
- 
-    !transform into Z_B = ln(C_B+x_B) for bandpowers with xfactors
-    IF(aset%has_xfactors) THEN
-       ALLOCATE(aset%xfactors(1:aset%num_points))
-       aset%xfactors(1:aset%num_points) = cal**2*tmp_x(1:aset%num_points)
-       DO i=1,aset%num_points
-          DO j=1,aset%num_points
-             if(aset%has_xfactor(i)) aset%N_inv(i,j) =  aset%N_inv(i,j)/(aset%points(i)%obs + aset%xfactors(i))
-             if(aset%has_xfactor(j)) aset%N_inv(i,j) =  aset%N_inv(i,j)/(aset%points(j)%obs + aset%xfactors(j))
-          ENDDO
-       ENDDO
-       DO i=1,aset%num_points
-          IF(aset%has_xfactor(i)) THEN
-             aset%points(i)%var = aset%points(i)%var/(aset%points(i)%obs +aset%xfactors(i))**2
-             aset%points(i)%obs  = LOG(aset%points(i)%obs + aset%xfactors(i))
-          ENDIF
-       ENDDO
-       CALL Matrix_Inverse(aset%N_inv)
-    ELSE
-       CALL Matrix_Inverse(aset%N_inv)
-    ENDIF
- 
-    DEALLOCATE(tmp_x)
-    deallocate(lb)
-  END SUBROUTINE ReadDataset_bcp
- 
- 
-  function CalcLnLike(cl, aset,nuisance_params) 
-   !Compute -ln(Likelihood) 
-    real cl(lmax,num_cls), CalcLnLike
-    real, intent(in) :: nuisance_params(:)
-    Type(CMBdataset) aset
-    integer i
-    real chisq
-    real chi2op, chi2pp, wpp, wdd
-    real chi2dd,chi2pd,chi2od
-    real bandpowers(aset%num_points), diffs(aset%num_points), tmp(aset%num_points), beam(aset%num_points)
-    real denom
- 
-    if (.not. aset%use_set) then
-       CalcLnLike = 0
-       return
-    end if
- 
-    if (aset%CMBLike) then
- 
-      chisq =  CMBLikes_CMBLike(aset%CMBLikes, cl, nuisance_params) 
- 
-    else if (aset%all_l_exact) then
-      
-      chisq = ChiSqExact(cl,aset)
-    
-    else
-    
-        denom = 1 !Assume Prob \propto exp(-chisq/2)/sqrt(denom)
- 
-        do i=1, aset%num_points
-           bandpowers(i) = GetWinBandPower(aset%points(i), cl)
-        end do
-    
-        if (aset%has_xfactors .and. (aset%calib_uncertainty > 1e-4 .or. aset%beam_uncertain))  then
- 
-           chisq = GetCalibMargexChisq(bandpowers,aset)
- 
-        else
- 
-         if (aset%has_xfactors) then 
-          do i=1, aset%num_points
-           if (aset%has_xfactor(i)) then
-            !obs in this case is Z = log(observed + x)
-            diffs(i) = aset%points(i)%obs- log(bandpowers(i) + aset%xfactors(i))
-           else
-            diffs(i) = aset%points(i)%obs - bandpowers(i)
-           end if
-          end do
-         else
-            diffs = aset%points(:)%obs - bandpowers
-         end if
- 
-        if (aset%has_corr_errors) then
-           chisq = SUM(diffs*MATMUL(aset%N_inv,diffs))
-        else
-           chisq = SUM(diffs**2/aset%points(:)%var)  
-        end if
- 
-        if (aset%calib_uncertainty > 1e-4 .or. aset%beam_uncertain) then
-  
-          if (aset%has_corr_errors) then
-             tmp = MATMUL(aset%N_inv,bandpowers)
-          else
-             tmp = bandpowers/aset%points(:)%var  
-          end if
-          chi2op = SUM(diffs*tmp)
-          chi2pp = SUM(bandpowers*tmp)
-          if (aset%beam_uncertain) then
-              beam = aset%points(:)%beam_err*bandpowers
-              if (aset%has_corr_errors) then
-                 tmp = MATMUL(aset%N_inv,beam)
-              else
-                 tmp = beam/aset%points(:)%var 
-              end if
-              chi2dd = SUM(beam*tmp)
-              chi2pd = SUM(bandpowers*tmp)
-              chi2od = SUM(diffs*tmp)
-          end if
- 
-          if (aset%calib_uncertainty > 1e-4) then
-           !analytic marginalization over calibration uncertainty
-           wpp = 1/(chi2pp+1/aset%calib_uncertainty**2) 
-           chisq = chisq - wpp*chi2op**2 
-           denom = denom/wpp*aset%calib_uncertainty**2
-          else
-           wpp = 0
-          end if
- 
-          if (aset%beam_uncertain) then
-           !analytic marginalization over beam uncertainty  
-           wdd=1/(chi2dd-wpp*chi2pd**2+1)
-           chisq = chisq - wdd*(chi2od-wpp*chi2op*chi2pd)**2
-           denom = denom/wdd
-          end if
- 
-        end if
- 
-        end if
- 
-         if (denom /= 1) chisq = chisq + log(denom)
-   
-     end if
-     CalcLnLike = chisq/2
-  
- 
-  
-  end function CalcLnLike
- 
-  function CMBLnLike(cl, freq_params, nuisance_params)
-   real, intent(in) ::  cl(lmax,num_cls)
-   real CMBLnLike
-   real,intent(in) :: freq_params(num_freq_params),nuisance_params(:)
-   real sznorm, szcl(lmax,num_cls)
-   integer i
-   integer nuisance
-   real tot(num_datasets)
-   
-   sznorm = freq_params(1)  
-   nuisance =1
-   do i=1, num_datasets
-      szcl = cl
-      if (datasets(i)%has_sz_template) then
-       szcl(2:lmax,1) = szcl(2:lmax,1) + sznorm*datasets(i)%sz_template(2:lmax)  
-      end if
-      if (datasets(i)%name == 'WMAP') then
-       tot(i) = MAPLnLike(szcl)
-      else
-       tot(i) = CalcLnLike(szcl,datasets(i), nuisance_params(nuisance:))
-       if (datasets(i)%CMBLike) nuisance = nuisance + datasets(i)%CMBLikes%num_nuisance_parameters
-      end if
-   end do
-   CMBLnLike = SUM(tot) 
-  end function
- 
- 
-  function MAPLnLike(cl)
- #ifndef NOWMAP
-   use wmap_likelihood_5yr
-   use WMAP_OPTIONS
-   use WMAP_UTIL
- #endif
-   real cl(lmax,num_cls), MAPLnLike
- #ifndef NOWMAP
- 
-   real(8), dimension(2:ttmax) :: cl_tt,cl_te,cl_ee,cl_bb
-   real(8)                     :: like(num_WMAP),like_tot
-   integer  l
- 
-   if (Init_MAP) then
- #ifdef WMAPNOHIGHLTT
-    use_TT = .false.
-    use_TT_beam_ptsrc = .false.   
- #endif
-    if (lmax<ttmax) stop 'lmax not large enough for WMAP'
-    if (Feedback>0) write(*,*) 'reading WMAP5 data'
-    Init_MAP = .false.
-   end if
- 
-   
-   do l = 2, ttmax
-      cl_tt(l) = cl(l,1)*l*(l+1)/twopi
-      cl_te(l) = cl(l,2)*l*(l+1)/twopi
-      cl_ee(l) = cl(l,3)*l*(l+1)/twopi
-      if(num_cls == 4) then
-         cl_bb(l) = cl(l,num_cls)*l*(l+1)/twopi
-      else
-         cl_bb(l) = 0.0d0
-      end if
-   end do
- 
-   like=0.0d0
-   call wmap_likelihood_compute(cl_tt,cl_te,cl_ee,cl_bb,like)
-   !call wmap_likelihood_error_report
-   
-   if (wmap_likelihood_ok) then
-      MAPLnLike = sum(like)
-   else
-      MAPLnLike = LogZero
-   endif
- #else
-    MAPLnLike=cl(2,1) !just stop unused symbol warnings
-    stop 'Compiled without WMAP'
- #endif
-  end function
- 
- 
- !WMAP1
- ! function MAPLnLike(cl)
- !  use WMAP
- !  real cl(lmax,num_cls), MAPLnLike
- ! integer  l
- !  real(WMAP_precision) clTT(WMAP_lmax_TT), clTE(WMAP_lmax_TT), ClEE(WMAP_lmax_TT)
- !  integer stat 
- !  character(LEN=20) :: ttFile = 'WMAP/tt_diag.dat'
- !  character(LEN=20) :: ttOffDiag ='WMAP/tt_offdiag.dat'
- ! character(LEN=20) :: teFile   = 'WMAP/te_diag.dat'
- !  character(LEN=20) :: teOffDiag ='WMAP/te_offdiag.dat'
- ! 
- !  if (Init_MAP) then
- !   if (lmax<WMAP_lmax_TT) stop 'lmax not large enough for WMAP'
- !   if (Feedback>0) write(*,*) 'reading WMAP data'
- !   Call WMAP_init(ttFile, ttOffDiag, teFile, teOffDiag, stat)!
- !
- !   if (stat /=0) stop 'Error reading WMAP files'
- !   if (Feedback>0) write(*,*) 'WMAP read'
- !   Init_MAP = .false.
- !  end if
- 
- !  do l = 2, WMAP_lmax_TT
- !      clTT(l) = cl(l,1)*l*(l+1)/twopi
- !      clTE(l) = cl(l,2)*l*(l+1)/twopi
- !      clEE(l) = cl(l,3)*l*(l+1)/twopi
- !  end do
- !  MAPLnLike = -(WMAP_LnLike_TT(clTT) + WMAP_LnLike_TE(clTT, clTE, clEE))
- 
- ! end function
- 
- 
- end module cmbdata
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/cmbtypes.f90 cosmomc_sampler/source/cmbtypes.f90
*** cosmomc/source/cmbtypes.f90	2009-10-20 16:45:00.000000000 +0200
--- cosmomc_sampler/source/cmbtypes.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,425 ****
- !Define the data types and read/writes them to disk. Also change l_max here.
- 
- module cmbtypes
- use settings
- implicit none
- 
- 
- !Number of Cls, 1 for just temperature, 3 (4) for polarization (with B)
-   integer, parameter  :: num_cls  = 3
- 
- !l_max. Tensors are not computed unless compute_tensors = T in input file
- !Make these multiples of 50, should be 50 more than you need accurately
-   integer, parameter :: lmax = 2100, lmax_tensor = 400
- 
- !Parameters for calculating/storing the matter power spectrum
- !Note that by default everything is linear
- !Old mpk settings
- #ifdef DR71RG
- !!! BR09: Reid et al 2009 settings for the LRG power spectrum.
-   integer, parameter :: num_matter_power = 300 !number of points computed in matter power spectrum
-   real, parameter    :: matter_power_minkh =  0.999e-4  !minimum value of k/h to store
-   real, parameter    :: matter_power_dlnkh = 0.03     !log spacing in k/h
-   real, parameter    :: matter_power_maxz = 0.
-   integer, parameter :: matter_power_lnzsteps = 4  ! z=0 to get sigma8 (this first entry appears to be coded in some spots in the code!!), plus 3 LRG redshifts.
- #else
-   integer, parameter :: num_matter_power = 74 !number of points computed in matter power spectrum
-   real, parameter    :: matter_power_minkh =  0.999e-4  !1e-4 !minimum value of k/h to store
-   real, parameter    :: matter_power_dlnkh = 0.143911568     !log spacing in k/h
-   real, parameter    :: matter_power_maxz = 0.    !6.0
-   integer, parameter :: matter_power_lnzsteps = 1 !20
- #endif
- !Only used in params_CMB
-    real :: pivot_k = 0.05 !Point for defining primordial power spectra
-    logical :: inflation_consistency = .false. !fix n_T or not
- 
-         !Note these are the interpolated/extrapolated values. The k at which matter power is computed up to 
-         !by CAMB is set in CMB_Cls_xxx with, e.g. P%Transfer%kmax = 0.6 (which is enough for 2dF)
- 
- !Number of scalar-only cls
- !if num_cls=4 and CMB_lensing then increased to 4 
-   integer :: num_clsS=min(num_cls,3) 
- 
-   integer, parameter :: norm_As=1, norm_amp_ratio=2, norm_freq_ix = 3
-   
-   Type CMBParams
-      real nuisance(1:num_nuisance_params)
-       !unit Gaussians for experimental parameters
-      real norm(1:num_norm)
-       !These are fast parameters controling amplitudes, calibrations, etc.
-      real InitPower(1:num_initpower)
-       !These are fast paramters for the initial power spectrum
-      !Now remaining (non-independent) parameters
-      real omb, omc, omv, omnu, omk, omdm
-      real ombh2, omch2, omnuh2, omdmh2
-      real zre, nufrac
-      real h, H0
-      real w
-      real reserved(5)
-   
-   end Type CMBParams
- 
-   Type CosmoTheory
-      real Age, r10
-      real SN_loglike, HST_loglike, BAO_loglike, reserved(1)
-      real cl(lmax,num_cls), cl_tensor(lmax_tensor,num_cls) !TT, TE, EE and BB  in that order
-      real sigma_8
-      real matter_power(num_matter_power,matter_power_lnzsteps)
-        !second index is redshifts from 0 to matter_power_maxz
-        !if custom_redshift_steps = false with equal spacing in
-        !log(1+z) and matter_power_lnzsteps points
-        !if custom_redshift_steps = true set in mpk.f90 
-      ! BR09 additions
-      real mpk_nw(num_matter_power,matter_power_lnzsteps) !no wiggles fit to matter power spectrum
-      real mpkrat_nw_nl(num_matter_power,matter_power_lnzsteps) !halofit run on mpk_nw
-      real finalLRGtheoryPk(num_matter_power)  !! this is the quantity that enters the LRG likelihood calculation
-     ! end BR09 additions
-   end Type CosmoTheory
- 
-   logical, parameter ::  Old_format  = .false.
-   logical, parameter :: write_all_Cls = .false. 
-    !if false use CAMB's flat interpolation scheme (lossless if models are flat except near lmax when lensed)
- 
- contains
- 
- 
-    subroutine WriteModel(i,CMB, T, like, mult)
-     integer i
-     real, intent(in), optional :: mult
-     Type(CosmoTheory) T
-     real like, amult
-     Type(CMBParams) CMB
-     integer j 
- 
-     if (present(mult)) then
-        amult = mult
-     else
-        amult = 1
-     end if
-     
-     if (Old_format) then
- 
-       stop 'old not supported'    
-     else
- 
-     j = 0 !format ID
-     if (write_all_cls) j=1
-     write(i) j
- 
-     write(i) amult, num_matter_power, lmax, lmax_tensor, num_cls
- 
-     write(i) T%SN_loglike, T%HST_loglike, T%reserved
- 
-     write(i) like
-     write(i) CMB
- 
-     write(i) T%Age, T%r10, T%sigma_8, T%matter_power
- 
-     if (write_all_cls) then
-      write(i) T%cl(2:lmax,1:num_cls)
-      write(i) T%cl_tensor(2:lmax_tensor,1:num_cls)
-     else
- 
-        !Use interpolation scheme CAMB uses for flat models
-        !If using significantly non-flat, or increasing interpolation accuracy, save all th cls instead
-         write(i) T%cl(2:20,1:num_cls)
-         do j=30,90,10 
-          write(i) T%cl(j,1:num_cls)
-         end do
-         do j=110,130, 20
-          write(i) T%cl(j,1:num_cls)
-         end do
-         do j=150,lmax, 50
-          write(i) T%cl(j,1:num_cls)
-         end do
- 
-         if (lmax_tensor /= 0) then
-             if (lmax_tensor<150) stop 'lmax_tensor too small'
-             write(i) T%cl_tensor(2:20,1:num_cls)
-             do j=30,90,10 
-              write(i) T%cl_tensor(j,1:num_cls)
-             end do
-             do j=110,130,20 
-              write(i) T%cl_tensor(j,1:num_cls)
-             end do
-             do j=150,lmax_tensor, 50
-              write(i) T%cl_tensor(j,1:num_cls)
-             end do
-         end if
-     end if
- 
-     end if 
- 
-     if (flush_write) call FlushFile(i)
- 
-    end subroutine WriteModel
- 
-    
-  subroutine ReadModel(i,CMB, T, mult, like, error)
-     integer, intent(in) :: i
-     integer, intent(out) :: error
-     real, intent(out) :: mult
-     Type(CosmoTheory) T
-     real like
-     Type(CMBParams) CMB
-     real icl(lmax,1:num_cls)
-     integer allcl,j,ind, ix(lmax)
-     integer almax,almaxtensor, anumpowers, anumcls
-    
-     error = 0
- 
-     if (old_format) then
- 
-        stop 'old not supported'
- 
-     else
- 
-         read(i,end=100,err=100) allcl
- 
-         if (allcl/=0 .and. allcl/=1) stop 'wrong file format'
- 
-         read(i,end=100,err=100) mult,anumpowers,almax, almaxtensor, anumcls
-         if (almax > lmax) stop 'reading file with larger lmax'
-         if (anumcls > num_cls) stop 'reading file with more Cls (polarization)'
- 
-         read(i) T%SN_loglike, T%HST_loglike,T%reserved
-    
-         read(i,end = 100, err=100) like
-         read(i) CMB
- 
-     
-         read(i) T%Age, T%r10, T%sigma_8, T%matter_power(1:anumpowers,1:matter_power_lnzsteps)
-         T%cl = 0
-         T%cl_tensor = 0
-          
-         if(allcl==1) then  
-          read(i) T%cl(2:almax,1:anumcls)
-          read(i) T%cl_tensor(2:almaxtensor,1:anumcls)
-         else
- 
-             read(i) icl(1:19,1:num_cls)
-             ind =1
-             do j =2,20 
-                ix(ind)=j
-                ind=ind+1
-             end do
-             do j=30,90,10 
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind + 1
-             end do
-              do j=110,130,20 
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind + 1
-             end do
-             do j=150,almax, 50
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind+1
-             end do
-             ind = ind-1
-  
-            call InterpCls(ix,icl, T%cl, ind, almax, num_Cls)
- 
-            if (almaxtensor /= 0) then     
-             read(i) icl(1:19,1:num_cls)
-             ind =1
-             do j =2,20 
-                ix(ind)=j
-                ind=ind+1
-             end do
-             do j=30,90,10 
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind + 1
-             end do
-             do j=110,130,20 
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind + 1
-             end do
-             do j=150,almaxtensor, 50
-              read(i) icl(ind,1:num_cls)
-              ix(ind) = j
-              ind = ind+1
-             end do
-             ind = ind-1
-             call InterpCls(ix,icl, T%cl_tensor, ind, almaxtensor,num_cls)
-            end if
-         
-         end if 
- 
-         return
-     100 error = 1
- 
-     end if
- 
-    end subroutine ReadModel
- 
-       subroutine InterpCls(l,iCl, all_Cl, n, almax, ncls)
-       integer, intent(in) :: n, almax,ncls
-    
-       real, intent(in) :: iCl(lmax,1:num_cls)
-       integer l(n),p
-       real all_Cl(:,:)
-    
-       integer il,llo,lhi,xi
-       real xl(n),  ddCl(n)
- 
-       real a0,b0,ho
-       real inCl(n)
- 
-     
-       do p =1, ncls
- 
-         do il=1,n
-            inCl(il) = iCl(il,p)*l(il)**2
-         end do
- 
-         xl = l
-         call spline_real(xl,inCl,n,ddCl)
-      
-         llo=1
-         do il=2,l(n)
-            xi=il
-            if ((xi > l(llo+1)).and.(llo < n)) then
-               llo=llo+1
-            end if
-            lhi=llo+1
-            ho=l(lhi)-l(llo)
-            a0=(xl(lhi)-xi)/ho
-            b0=(xi-xl(llo))/ho
-           
-            all_Cl(il,p) = (a0*inCl(llo)+ b0*inCl(lhi)+((a0**3-a0)* ddCl(llo) &
-                    +(b0**3-b0)*ddCl(lhi))*ho**2/6)/il**2
-   
-         end do
- 
-       end do
- 
-       all_Cl(l(n)+1:almax,:) = 0
-        
- 
-       end subroutine InterpCls
-   
-   
-    subroutine ClsFromTheoryData(T, CMB, Cls)
-      Type(CosmoTheory) T
-      Type(CMBParams) CMB
-      real Cls(lmax,num_cls)
-      integer i
-      
-      Cls(2:lmax,1:num_clsS) =T%cl(2:lmax,1:num_clsS)    !CMB%norm(norm_As)*T%cl(2:lmax,1:num_clsS)
-      if (num_cls>3 .and. num_ClsS==3) Cls(2:lmax,num_cls)=0
- 
-      i = norm_amp_ratio !this convolution is to avoid compile-time bounds-check errors on CMB%norm
-      if (CMB%norm(i) /= 0) then
-         Cls(2:lmax_tensor,:) =  Cls(2:lmax_tensor,:)+ T%cl_tensor(2:lmax_tensor,:) 
-          !CMB%norm(norm_As)*CMB%norm(norm_amp_ratio)*T%cl_tensor(2:lmax_tensor,:)
-      end if 
- 
-    end subroutine ClsFromTheoryData
- 
-    subroutine WriteTextCls(aname,T, CMB)
-      Type(CosmoTheory) T
-      Type(CMBParams) CMB
-      character (LEN=*), intent(in) :: aname
-      integer l
-      real Cls(lmax,num_cls)
- 
-      call ClsFromTheoryData(T,CMB,Cls)
-      open(unit = tmp_file_unit, file = aname, form='formatted', status = 'replace')
-      do l=2, lmax
-         write (tmp_file_unit,*) l, Cls(l,:)*l*(l+1)/(2*pi)
-      end do
-      close(tmp_file_unit)
- 
-    end subroutine WriteTextCls
- 
-    function MatterPowerAt(T,kh)
-      !get matter power spectrum today at kh = k/h by interpolation from stored values
-      real, intent(in) :: kh
-      Type(CosmoTheory) T
-      real MatterPowerAt
-      real x, d
-      integer i
-    
-      x = log(kh/matter_power_minkh) / matter_power_dlnkh
-      if (x < 0 .or. x >= num_matter_power-1) then
-         write (*,*) ' k/h out of bounds in MatterPowerAt (',kh,')'
-         stop 
-      end if
-      i = int(x)
-      d = x - i
-      MatterPowerAt = exp(log(T%matter_power(i+1,1))*(1-d) &
-        + log(T%matter_power(i+2,1))*d)
-      !Just do linear interpolation in logs for now..
-      !(since we already cublic-spline interpolated to get the stored values)
-      !Assume matter_power_lnzsteps is at redshift zero
-    end function
- 
- 
- 
- !BR09 this function is just a copy of the one above but with LRG theory put in instead of linear theory
-    function LRGPowerAt(T,kh)
-      !get LRG matter power spectrum today at kh = k/h by interpolation from stored values
-      real, intent(in) :: kh
-      Type(CosmoTheory) T
-      real LRGPowerAt
-      real x, d
-      integer i
-    
-      x = log(kh/matter_power_minkh) / matter_power_dlnkh
-      if (x < 0 .or. x >= num_matter_power-1) then
-         write (*,*) ' k/h out of bounds in MatterPowerAt (',kh,')'
-         stop 
-      end if
-      i = int(x)
-      d = x - i
-      LRGPowerAt = exp(log(T%finalLRGtheoryPk(i+1))*(1-d) + log(T%finalLRGtheoryPk(i+2))*d)
-      !Just do linear interpolation in logs for now..
-      !(since we already cublic-spline interpolated to get the stored values)
-    end function
- !!BRO09 addition end
- 
-    function MatterPowerAt_Z(T,kh,z)
-      !get matter power spectrum at z at kh = k/h by interpolation from stored values
- 
-      real, intent(in) :: kh
-      Type(CosmoTheory) T
-      real MatterPowerAt_Z
-      real x, d, z, y, dz, mup, mdn
-      real matter_power_dlnz
-      integer i, iz
-    
-      matter_power_dlnz = log(matter_power_maxz+1) / (matter_power_lnzsteps -1 + 1e-13)
-      y = log(1.+ z) / matter_power_dlnz 
- 
-      if (z > matter_power_maxz ) then
-         write (*,*) ' z out of bounds in MatterPowerAt_Z (',z,')'
-         stop
-      end if
-      x = log(kh/matter_power_minkh) / matter_power_dlnkh
-      if (x < 0 .or. x >= num_matter_power-1) then
-         write (*,*) ' k/h out of bounds in MatterPowerAt_Z (',kh,')'
-         stop
-      end if
- 
-      iz = int(y*0.99999999)
-      dz = y - iz
- 
-      i = int(x)
-      d = x - i
- 
-      mup = log(T%matter_power(i+1,iz+2))*(1-d) + log(T%matter_power(i+2,iz+2))*d
-      mdn = log(T%matter_power(i+1,iz+1))*(1-d) + log(T%matter_power(i+2,iz+1))*d
- 
-      MatterPowerAt_Z = exp(mdn*(1-dz) + mup*dz)
- 
-    end function MatterPowerAt_Z
- 
- 
- 
- 
- end module cmbtypes
--- 0 ----
diff -r -c -b -B -N cosmomc/source/conjgrad_wrapper.f90 cosmomc_sampler/source/conjgrad_wrapper.f90
*** cosmomc/source/conjgrad_wrapper.f90	2009-10-20 16:04:10.000000000 +0200
--- cosmomc_sampler/source/conjgrad_wrapper.f90	2009-10-28 17:18:17.276306858 +0100
***************
*** 4,9 ****
--- 4,10 ----
   use ParamDef
   use CalcLike
   use Random
+  use wrapper
   implicit none
   private 
   real ftol, Bestfit_loglike
diff -r -c -b -B -N cosmomc/source/cosmomc.dsp cosmomc_sampler/source/cosmomc.dsp
*** cosmomc/source/cosmomc.dsp	2008-02-26 21:47:26.000000000 +0100
--- cosmomc_sampler/source/cosmomc.dsp	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,440 ****
- # Microsoft Developer Studio Project File - Name="cosmomc" - Package Owner=<4>
- # Microsoft Developer Studio Generated Build File, Format Version 6.00
- # ** DO NOT EDIT **
- 
- # TARGTYPE "Win32 (x86) Console Application" 0x0103
- 
- CFG=cosmomc - Win32 Debug
- !MESSAGE This is not a valid makefile. To build this project using NMAKE,
- !MESSAGE use the Export Makefile command and run
- !MESSAGE 
- !MESSAGE NMAKE /f "cosmomc.mak".
- !MESSAGE 
- !MESSAGE You can specify a configuration when running NMAKE
- !MESSAGE by defining the macro CFG on the command line. For example:
- !MESSAGE 
- !MESSAGE NMAKE /f "cosmomc.mak" CFG="cosmomc - Win32 Debug"
- !MESSAGE 
- !MESSAGE Possible choices for configuration are:
- !MESSAGE 
- !MESSAGE "cosmomc - Win32 Release" (based on "Win32 (x86) Console Application")
- !MESSAGE "cosmomc - Win32 Debug" (based on "Win32 (x86) Console Application")
- !MESSAGE 
- 
- # Begin Project
- # PROP AllowPerConfigDependencies 0
- # PROP Scc_ProjName ""
- # PROP Scc_LocalPath ""
- CPP=cl.exe
- F90=df.exe
- RSC=rc.exe
- 
- !IF  "$(CFG)" == "cosmomc - Win32 Release"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 0
- # PROP BASE Output_Dir "Release"
- # PROP BASE Intermediate_Dir "Release"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 0
- # PROP Output_Dir "Release"
- # PROP Intermediate_Dir "Release"
- # PROP Target_Dir ""
- # ADD BASE F90 /compile_only /nologo /warn:nofileopt
- # ADD F90 /compile_only /nologo /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD BASE RSC /l 0x809 /d "NDEBUG"
- # ADD RSC /l 0x809 /d "NDEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- 
- !ELSEIF  "$(CFG)" == "cosmomc - Win32 Debug"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 1
- # PROP BASE Output_Dir "Debug"
- # PROP BASE Intermediate_Dir "Debug"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 1
- # PROP Output_Dir "Debug"
- # PROP Intermediate_Dir "Debug"
- # PROP Ignore_Export_Lib 0
- # PROP Target_Dir ""
- # ADD BASE F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD F90 /check:bounds /compile_only /dbglibs /debug:full /define:"NOWMAP" /define:"MATRIX_SINGLE" /define:"DECONLY" /fpp /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD BASE RSC /l 0x809 /d "_DEBUG"
- # ADD RSC /l 0x809 /d "_DEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"../cosmomc.exe" /pdbtype:sept
- 
- !ENDIF 
- 
- # Begin Target
- 
- # Name "cosmomc - Win32 Release"
- # Name "cosmomc - Win32 Debug"
- # Begin Group "Source Files"
- 
- # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
- # Begin Group "CAMB"
- 
- # PROP Default_Filter ""
- # Begin Source File
- 
- SOURCE=..\camb\bessels.f90
- DEP_F90_BESSE=\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\Ranges.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\camb.f90
- DEP_F90_CAMB_=\
- 	".\Debug\CAMBmain.mod"\
- 	".\Debug\GaugeInterface.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lensing.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\SpherBessels.mod"\
- 	".\Debug\ThermoData.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\cmbmain.f90
- DEP_F90_CMBMA=\
- 	".\Debug\GaugeInterface.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\MassiveNu.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\NonLinear.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\SpherBessels.mod"\
- 	".\Debug\ThermoData.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\equations.f90
- DEP_F90_EQUAT=\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\MassiveNu.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\ThermoData.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\halofit.f90
- DEP_F90_HALOF=\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Transfer.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\inifile.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\lensing.f90
- DEP_F90_LENSI=\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\lvalues.mod"\
- 	".\Debug\ModelData.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\modules.f90
- DEP_F90_MODUL=\
- 	".\Debug\AMLutils.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\InitialPower.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\Ranges.mod"\
- 	".\Debug\RECFAST.MOD"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\power_tilt.f90
- DEP_F90_POWER=\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\recfast.f90
- DEP_F90_RECFA=\
- 	".\Debug\Precision.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\subroutines.f90
- DEP_F90_SUBRO=\
- 	".\Debug\AMLutils.mod"\
- 	
- # End Source File
- # End Group
- # Begin Source File
- 
- SOURCE=.\calclike.f90
- DEP_F90_CALCL=\
- 	".\Debug\CMB_Cls.mod"\
- 	".\Debug\cmbdata.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\lya.mod"\
- 	".\Debug\mpk.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\Random.mod"\
- 	".\Debug\settings.mod"\
- 	".\Debug\snovae.mod"\
- 	".\Debug\WeakLen.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\CMB_Cls_simple.f90
- DEP_F90_CMB_C=\
- 	".\Debug\CAMB.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\LambdaGeneral.mod"\
- 	".\Debug\lensing.mod"\
- 	".\Debug\lya.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\settings.mod"\
- 	".\Debug\snovae.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\cmbdata.f90
- DEP_F90_CMBDA=\
- 	".\Debug\CMBLikes.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\settings.mod"\
- 	
- NODEP_F90_CMBDA=\
- 	".\Debug\WMAP_OPTIONS.mod"\
- 	".\Debug\WMAP_PASS2.mod"\
- 	".\Debug\WMAP_UTIL.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\cmbtypes.f90
- DEP_F90_CMBTY=\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\conjgrad_wrapper.f90
- DEP_F90_CONJG=\
- 	".\Debug\CalcLike.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\Random.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\driver.F90
- DEP_F90_DRIVE=\
- 	".\Debug\CalcLike.mod"\
- 	".\Debug\cmbdata.mod"\
- 	".\Debug\ConjGradModule.mod"\
- 	".\Debug\EstCovmatModule.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\MonteCarlo.mod"\
- 	".\Debug\mpk.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\posthoc.mod"\
- 	".\Debug\settings.mod"\
- 	".\Debug\WeakLen.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\EstCovmat.f90
- DEP_F90_ESTCO=\
- 	".\Debug\CalcLike.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\Random.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\lya.f90
- DEP_F90_LYA_F=\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\Matrix_utils.F90
- DEP_F90_MATRI=\
- 	".\Debug\AMLutils.mod"\
- 	
- NODEP_F90_MATRI=\
- 	".\Debug\IFPORT.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\MCMC.f90
- DEP_F90_MCMC_=\
- 	".\Debug\CalcLike.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\propose.mod"\
- 	".\Debug\Random.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\mpk.f90
- DEP_F90_MPK_F=\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\paramdef.F90
- DEP_F90_PARAM=\
- 	".\Debug\CMB_Cls.mod"\
- 	".\Debug\cmbdata.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\Random.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\params_CMB.f90
- DEP_F90_PARAMS=\
- 	".\Debug\CAMB.mod"\
- 	".\Debug\CMB_Cls.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\ModelParams.mod"\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\Precision.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\Planck_like.f90
- DEP_F90_PLANC=\
- 	".\Debug\AMLutils.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\MatrixUtils.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\postprocess.f90
- DEP_F90_POSTP=\
- 	".\Debug\CalcLike.mod"\
- 	".\Debug\CMB_Cls.mod"\
- 	".\Debug\cmbdata.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\propose.f90
- DEP_F90_PROPO=\
- 	".\Debug\ParamDef.mod"\
- 	".\Debug\Random.mod"\
- 	".\Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\settings.f90
- DEP_F90_SETTI=\
- 	".\Debug\AMLutils.mod"\
- 	".\Debug\IniFile.mod"\
- 	".\Debug\Random.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\supernovae.f90
- DEP_F90_SUPER=\
- 	".\Debug\CAMB.mod"\
- 	".\Debug\cmbtypes.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\utils.F90
- DEP_F90_UTILS=\
- 	{$(INCLUDE)}"cxml_dll_use.mod"\
- 	{$(INCLUDE)}"CXML_INCLUDE.F90"\
- 	{$(INCLUDE)}"cxml_static_use.mod"\
- 	
- NODEP_F90_UTILS=\
- 	".\Debug\F90_UNIX.mod"\
- 	".\Debug\IFPORT.mod"\
- 	".\Debug\mpif.h"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\WeakLen.f90
- DEP_F90_WEAKL=\
- 	".\Debug\cmbtypes.mod"\
- 	
- # End Source File
- # End Group
- # Begin Group "Header Files"
- 
- # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
- # End Group
- # Begin Group "Resource Files"
- 
- # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- # End Group
- # End Target
- # End Project
--- 0 ----
diff -r -c -b -B -N cosmomc/source/cosmomc.dsw cosmomc_sampler/source/cosmomc.dsw
*** cosmomc/source/cosmomc.dsw	2004-08-07 06:35:16.000000000 +0200
--- cosmomc_sampler/source/cosmomc.dsw	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,41 ****
- Microsoft Developer Studio Workspace File, Format Version 6.00
- # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
- 
- ###############################################################################
- 
- Project: "GetDist"=.\GetDist.dsp - Package Owner=<4>
- 
- Package=<5>
- {{{
- }}}
- 
- Package=<4>
- {{{
- }}}
- 
- ###############################################################################
- 
- Project: "cosmomc"=.\cosmomc.dsp - Package Owner=<4>
- 
- Package=<5>
- {{{
- }}}
- 
- Package=<4>
- {{{
- }}}
- 
- ###############################################################################
- 
- Global:
- 
- Package=<5>
- {{{
- }}}
- 
- Package=<3>
- {{{
- }}}
- 
- ###############################################################################
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/cosmomc.sln cosmomc_sampler/source/cosmomc.sln
*** cosmomc/source/cosmomc.sln	2009-09-17 18:33:21.000000000 +0200
--- cosmomc_sampler/source/cosmomc.sln	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,25 ****
- Microsoft Visual Studio Solution File, Format Version 10.00
- # Visual Studio 2008
- Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "cosmomc", "cosmomc.vfproj", "{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}"
- EndProject
- Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "GetDist", "GetDist.vfproj", "{573A6A6A-BD92-4FF0-BD64-E101E2496178}"
- EndProject
- Global
- 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
- 		Debug|Win32 = Debug|Win32
- 		Release|Win32 = Release|Win32
- 	EndGlobalSection
- 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
- 		{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}.Debug|Win32.ActiveCfg = Debug|Win32
- 		{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}.Debug|Win32.Build.0 = Debug|Win32
- 		{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}.Release|Win32.ActiveCfg = Release|Win32
- 		{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}.Release|Win32.Build.0 = Release|Win32
- 		{573A6A6A-BD92-4FF0-BD64-E101E2496178}.Debug|Win32.ActiveCfg = Debug|Win32
- 		{573A6A6A-BD92-4FF0-BD64-E101E2496178}.Debug|Win32.Build.0 = Debug|Win32
- 		{573A6A6A-BD92-4FF0-BD64-E101E2496178}.Release|Win32.ActiveCfg = Release|Win32
- 		{573A6A6A-BD92-4FF0-BD64-E101E2496178}.Release|Win32.Build.0 = Release|Win32
- 	EndGlobalSection
- 	GlobalSection(SolutionProperties) = preSolution
- 		HideSolutionNode = FALSE
- 	EndGlobalSection
- EndGlobal
--- 0 ----
diff -r -c -b -B -N cosmomc/source/cosmomc.vfproj cosmomc_sampler/source/cosmomc.vfproj
*** cosmomc/source/cosmomc.vfproj	2009-10-22 10:40:35.000000000 +0200
--- cosmomc_sampler/source/cosmomc.vfproj	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,68 ****
- <?xml version="1.0" encoding="UTF-8"?>
- <VisualStudioProject ProjectCreator="Intel Fortran" Keyword="Console Application - Converted from CVF" Version="11.0" ProjectIdGuid="{5818CEFF-E933-41ED-A2A1-7A6D8F22AFB6}">
- 	<Platforms>
- 		<Platform Name="Win32"/></Platforms>
- 	<Configurations>
- 		<Configuration Name="Release|Win32" OutputDirectory="Release" IntermediateDirectory="Release" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.exe;$(TargetPath)">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" LocalVariableStorage="localStorageSave" CallingConvention="callConventionCVF" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" AssemblerListingLocation="$(INTDIR)/"/>
- 				<Tool Name="VFLinkerTool" AdditionalOptions="/MACHINE:I386" OutputFile="$(OUTDIR)/cosmomc.exe" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" ProgramDatabaseFile="$(OUTDIR)/cosmomc.pdb" SubSystem="subSystemConsole" ImportLibrary="" AdditionalDependencies="kernel32.lib"/>
- 				<Tool Name="VFResourceCompilerTool" PreprocessorDefinitions="NDEBUG" Culture="rcEnglishBritain" ResourceOutputFileName="$(INTDIR)/$(InputName).res"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="" DLLDataFileName="" TypeLibraryName="$(OUTDIR)/cosmomc.tlb"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration>
- 		<Configuration Name="Debug|Win32" OutputDirectory="Debug" IntermediateDirectory="Debug" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.exe;$(TargetPath)">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" PreprocessorDefinitions="NOWMAP,RUNIDLE,MATRIX_SINGLE" LocalVariableStorage="localStorageSave" CallingConvention="callConventionCVF" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" AssemblerListingLocation="$(INTDIR)/" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug"/>
- 				<Tool Name="VFLinkerTool" AdditionalOptions="/MACHINE:I386" OutputFile="../cosmomc.exe" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" AdditionalLibraryDirectories="C:\Program Files\Intel\MKL\9.1.027\ia32\lib" GenerateDebugInformation="true" ProgramDatabaseFile="$(OUTDIR)/cosmomc.pdb" SubSystem="subSystemConsole" ImportLibrary="" AdditionalDependencies="kernel32.lib mkl_s.lib libguide.lib"/>
- 				<Tool Name="VFResourceCompilerTool" PreprocessorDefinitions="_DEBUG" Culture="rcEnglishBritain" ResourceOutputFileName="$(INTDIR)/$(InputName).res"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="" DLLDataFileName="" TypeLibraryName="$(OUTDIR)/cosmomc.tlb"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/>
- 				<Tool Name="VFManifestTool" SuppressStartupBanner="true"/></Configuration></Configurations>
- 	<Files>
- 		<Filter Name="Header Files" Filter="h;hpp;hxx;hm;inl;fi;fd"/>
- 		<Filter Name="Resource Files" Filter="ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"/>
- 		<Filter Name="Source Files" Filter="cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp">
- 		<Filter Name="CAMB">
- 		<File RelativePath="..\camb\bessels.f90"/>
- 		<File RelativePath="..\camb\camb.f90"/>
- 		<File RelativePath="..\camb\cmbmain.f90"/>
- 		<File RelativePath="..\camb\constants.f90"/>
- 		<File RelativePath="..\camb\equations.f90"/>
- 		<File RelativePath="..\camb\halofit.f90"/>
- 		<File RelativePath="..\camb\inifile.f90"/>
- 		<File RelativePath="..\camb\lensing.f90"/>
- 		<File RelativePath="..\camb\modules.f90"/>
- 		<File RelativePath="..\camb\power_tilt.f90"/>
- 		<File RelativePath="..\camb\recfast.f90"/>
- 		<File RelativePath="..\camb\reionization.f90"/>
- 		<File RelativePath="..\camb\subroutines.f90"/></Filter>
- 		<File RelativePath=".\bao.f90"/>
- 		<File RelativePath=".\calclike.f90"/>
- 		<File RelativePath=".\CMB_Cls_simple.f90"/>
- 		<File RelativePath=".\cmbdata.f90"/>
- 		<File RelativePath=".\cmbtypes.f90"/>
- 		<File RelativePath=".\conjgrad_wrapper.f90"/>
- 		<File RelativePath=".\driver.F90"/>
- 		<File RelativePath=".\EstCovmat.f90"/>
- 		<File RelativePath=".\HST.f90"/>
- 		<File RelativePath=".\IO.f90"/>
- 		<File RelativePath=".\lrggettheory.f90"/>
- 		<File RelativePath=".\Matrix_utils.F90"/>
- 		<File RelativePath=".\MCMC.f90"/>
- 		<File RelativePath=".\mpk.f90"/>
- 		<File RelativePath=".\paramdef.F90"/>
- 		<File RelativePath=".\ParamNames.f90"/>
- 		<File RelativePath=".\params_CMB.f90"/>
- 		<File RelativePath=".\Planck_like.f90"/>
- 		<File RelativePath=".\postprocess.f90"/>
- 		<File RelativePath=".\propose.f90"/>
- 		<File RelativePath=".\SDSSLy-a-v3.f90"/>
- 		<File RelativePath=".\settings.f90"/>
- 		<File RelativePath=".\supernovae.f90"/>
- 		<File RelativePath=".\utils.F90"/>
- 		<File RelativePath=".\WeakLen.f90"/></Filter></Files>
- 	<Globals/></VisualStudioProject>
--- 0 ----
diff -r -c -b -B -N cosmomc/source/driver.F90 cosmomc_sampler/source/driver.F90
*** cosmomc/source/driver.F90	2009-10-20 15:24:17.000000000 +0200
--- cosmomc_sampler/source/driver.F90	2009-10-28 17:24:15.272250489 +0100
***************
*** 7,25 ****
          use MonteCarlo
          use ParamDef
          use settings
-         use cmbdata
          use posthoc
-         use WeakLen
          use CalcLike
          use EstCovmatModule
          use ConjGradModule
-         use mpk
          use MatrixUtils
          use IO
          use ParamNames
! #ifdef WMAP_PARAMS
!         use WMAP_OPTIONS
! #endif
          implicit none 
          
          character(LEN=Ini_max_string_len) InputFile, LogFile
--- 7,20 ----
          use MonteCarlo
          use ParamDef
          use settings
          use posthoc
          use CalcLike
          use EstCovmatModule
          use ConjGradModule
          use MatrixUtils
          use IO
          use ParamNames
! 
          implicit none 
          
          character(LEN=Ini_max_string_len) InputFile, LogFile
***************
*** 27,34 ****
          logical bad, est_bfp_before_covmat
          integer numsets, nummpksets, i, numtoget, action
          character(LEN=Ini_max_string_len) baseroot, filename(100), &
!          mpk_filename(100),  SZTemplate(100), numstr, fname
!         real SZscale(100)
          Type(ParamSet) Params, EstParams
          integer num_points
          integer status          
--- 22,29 ----
          logical bad, est_bfp_before_covmat
          integer numsets, nummpksets, i, numtoget, action
          character(LEN=Ini_max_string_len) baseroot, filename(100), &
!         numstr, fname
!         
          Type(ParamSet) Params, EstParams
          integer num_points
          integer status          
***************
*** 89,100 ****
          checkpoint = Ini_Read_Logical('checkpoint',.false.)
          if (checkpoint) flush_write = .true.
          
! #ifdef WMAP_PARAMS
!         use_TT_beam_ptsrc = Ini_read_Logical('use_TT_beam_ptsrc')
!         use_TE = Ini_read_Logical('use_TE')
!         use_TT = Ini_Read_Logical('use_TT')
!         print *, 'WMAP beam TE TT', use_TT_beam_ptsrc, use_TE, use_TT
! #endif
  
  #ifdef MPI 
          
--- 84,90 ----
          checkpoint = Ini_Read_Logical('checkpoint',.false.)
          if (checkpoint) flush_write = .true.
          
! 
  
  #ifdef MPI 
          
***************
*** 184,224 ****
            call InitRandom()
          end if
  
-         use_nonlinear = Ini_Read_Logical('nonlinear_pk',.false.)
-         pivot_k = Ini_Read_Real('pivot_k',0.05)
-         inflation_consistency = Ini_read_Logical('inflation_consistency',.false.)
- 
-         w_is_w = Ini_Read_Logical ('w_is_w',.true.)     
          oversample_fast = Ini_Read_Int('oversample_fast',1)
          use_fast_slow = Ini_read_Logical('use_fast_slow',.true.)
   
          if (Ini_Read_Logical('cmb_hyperparameters', .false.)) &
              call DoStop( 'Hyperparameters not supported any more')
  
-         if (Ini_Read_String('use_2dF') /= '') stop 'use_2dF now replaced with use_mpk'
-         Use_Clusters = Ini_Read_Logical('use_clusters',.false.)
-         Use_mpk = Ini_Read_Logical('use_mpk',.false.) ! matter power spectrum, incl 2dF
-         Use_HST = Ini_Read_Logical('use_HST',.true.)
-         Use_BBN = Ini_Read_Logical('use_BBN',.false.)
-         Use_Age_Tophat_Prior= Ini_Read_Logical('use_Age_Tophat_Prior',.true.)
-         Use_SN = Ini_Read_Logical('use_SN',.false.)
-         if (Use_SN) SN_filename = Ini_Read_String('SN_filename')
-         Use_BAO = Ini_Read_Logical('use_BAO',.false.)
-         Use_CMB = Ini_Read_Logical('use_CMB',.true.)
-         Use_WeakLen = Ini_Read_Logical('use_WeakLen',.false.)
-         Use_min_zre = Ini_Read_Double('use_min_zre',0.d0) 
-         Use_Lya = Ini_Read_logical('use_lya',.false.)
-        
-         if (Ini_HasKey('DataDir')) DataDir=Ini_Read_String('data_dir') 
- 
-         if (Use_Lya .and. use_nonlinear) &
-              call DoStop('Lya.f90 assumes LINEAR power spectrum input')
- 
-         !flag to force getting sigma8 even if not using LSS data 
-         use_LSS = Ini_Read_Logical('get_sigma8',.false.)
-         ! use_LSS = Use_2dF .or. Use_Clusters .or. Use_WeakLen
-         use_LSS = Use_LSS .or. Use_mpk .or. Use_Clusters .or. Use_WeakLen .or. Use_Lya
- 
          Temperature = Ini_Read_Real('temperature',1.)
          
          num_threads = Ini_Read_Int('num_threads',0)
--- 174,185 ----
***************
*** 236,277 ****
  
          Ini_fail_on_not_found = .true.
  
-         numsets = Ini_Read_Int('cmb_numdatasets')
          num_points = 0
          nuisance_params_used = 0
-         if (Use_CMB) then
-          do i= 1, numsets
-           filename(i) = Ini_Read_String(numcat('cmb_dataset',i)) 
-           call ReadDataset(filename(i))
-           num_points = num_points + datasets(i)%num_points
-           SZTemplate(i) = Ini_Read_String(numcat('cmb_dataset_SZ',i), .false.) 
-           if (SZTemplate(i)/='') then
-            SZScale(i) = Ini_read_Real(numcat('cmb_dataset_SZ_scale',i),1.0)
-            call ReadSZTemplate(datasets(i), SZTemplate(i),SZScale(i))
-           end if
-           nuisance_params_used = nuisance_params_used + datasets(i)%nuisance_parameters
-          end do
-          if (Feedback > 1) write (*,*) 'read datasets'
-         end if
  
!         Ini_fail_on_not_found = .true.
          
!         nummpksets = Ini_Read_Int('mpk_numdatasets',0)
!         if (Use_mpk) then
!          do i= 1, nummpksets
!           mpk_filename(i) = Ini_Read_String(numcat('mpk_dataset',i)) 
!           call ReadMpkDataset(mpk_filename(i))
!          end do
!          if (Feedback>1) write(*,*) 'read mpk datasets'
!         end if
  
-         if(Use_BAO .and. use_dr7lrg) &
-          call MpiStop('DR7 LRG and BAO are based on the same dataset. You cannot use both.')
  
          numtoget = Ini_Read_Int('samples')
  
-         call Initialize(Params)
- 
          call Ini_Close
  
          if (MpiRank==0 .and. action==0 .and. NameMapping%nnames/=0) &
--- 197,212 ----
  
          Ini_fail_on_not_found = .true.
  
          num_points = 0
          nuisance_params_used = 0
  
!         call Initialize(Params)
  
!         Ini_fail_on_not_found = .true.
  
  
          numtoget = Ini_Read_Int('samples')
  
          call Ini_Close
  
          if (MpiRank==0 .and. action==0 .and. NameMapping%nnames/=0) &
diff -r -c -b -B -N cosmomc/source/EstCovmat.f90 cosmomc_sampler/source/EstCovmat.f90
*** cosmomc/source/EstCovmat.f90	2009-10-02 12:17:10.000000000 +0200
--- cosmomc_sampler/source/EstCovmat.f90	2009-10-28 17:24:35.960789626 +0100
***************
*** 12,17 ****
--- 12,18 ----
   use CalcLike
   use settings
   use Matrixutils
+  use wrapper
   implicit none
  
   real, dimension(:,:,:,:), allocatable :: Lgrid
diff -r -c -b -B -N cosmomc/source/getdist.dsp cosmomc_sampler/source/getdist.dsp
*** cosmomc/source/getdist.dsp	2008-02-26 21:47:26.000000000 +0100
--- cosmomc_sampler/source/getdist.dsp	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,140 ****
- # Microsoft Developer Studio Project File - Name="GetDist" - Package Owner=<4>
- # Microsoft Developer Studio Generated Build File, Format Version 6.00
- # ** DO NOT EDIT **
- 
- # TARGTYPE "Win32 (x86) Console Application" 0x0103
- 
- CFG=GetDist - Win32 Debug
- !MESSAGE This is not a valid makefile. To build this project using NMAKE,
- !MESSAGE use the Export Makefile command and run
- !MESSAGE 
- !MESSAGE NMAKE /f "GetDist.mak".
- !MESSAGE 
- !MESSAGE You can specify a configuration when running NMAKE
- !MESSAGE by defining the macro CFG on the command line. For example:
- !MESSAGE 
- !MESSAGE NMAKE /f "GetDist.mak" CFG="GetDist - Win32 Debug"
- !MESSAGE 
- !MESSAGE Possible choices for configuration are:
- !MESSAGE 
- !MESSAGE "GetDist - Win32 Release" (based on "Win32 (x86) Console Application")
- !MESSAGE "GetDist - Win32 Debug" (based on "Win32 (x86) Console Application")
- !MESSAGE 
- 
- # Begin Project
- # PROP AllowPerConfigDependencies 0
- # PROP Scc_ProjName ""
- # PROP Scc_LocalPath ""
- CPP=cl.exe
- F90=df.exe
- RSC=rc.exe
- 
- !IF  "$(CFG)" == "GetDist - Win32 Release"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 0
- # PROP BASE Output_Dir "Release"
- # PROP BASE Intermediate_Dir "Release"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 0
- # PROP Output_Dir "Release"
- # PROP Intermediate_Dir "Release"
- # PROP Target_Dir ""
- # ADD BASE F90 /compile_only /nologo /warn:nofileopt
- # ADD F90 /compile_only /nologo /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
- # ADD BASE RSC /l 0x809 /d "NDEBUG"
- # ADD RSC /l 0x809 /d "NDEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
- 
- !ELSEIF  "$(CFG)" == "GetDist - Win32 Debug"
- 
- # PROP BASE Use_MFC 0
- # PROP BASE Use_Debug_Libraries 1
- # PROP BASE Output_Dir "GetDist_Debug"
- # PROP BASE Intermediate_Dir "GetDist_Debug"
- # PROP BASE Target_Dir ""
- # PROP Use_MFC 0
- # PROP Use_Debug_Libraries 1
- # PROP Output_Dir "GetDist_Debug"
- # PROP Intermediate_Dir "GetDist_Debug"
- # PROP Ignore_Export_Lib 0
- # PROP Target_Dir ""
- # ADD BASE F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD F90 /check:bounds /compile_only /dbglibs /debug:full /define:"MATRIX_SINGLE" /define:"NOWMAP" /define:"DECONLY" /fpp /nologo /traceback /warn:argument_checking /warn:nofileopt
- # ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
- # ADD BASE RSC /l 0x809 /d "_DEBUG"
- # ADD RSC /l 0x809 /d "_DEBUG"
- BSC32=bscmake.exe
- # ADD BASE BSC32 /nologo
- # ADD BSC32 /nologo
- LINK32=link.exe
- # ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
- # ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"../GetDist.exe" /pdbtype:sept
- # SUBTRACT LINK32 /pdb:none
- 
- !ENDIF 
- 
- # Begin Target
- 
- # Name "GetDist - Win32 Release"
- # Name "GetDist - Win32 Debug"
- # Begin Group "Source Files"
- 
- # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
- # Begin Source File
- 
- SOURCE=.\GetDist.f90
- NODEP_F90_GETDI=\
- 	".\GetDist_Debug\IniFile.mod"\
- 	".\GetDist_Debug\Random.mod"\
- 	".\GetDist_Debug\settings.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=..\camb\inifile.f90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\Matrix_utils.F90
- # End Source File
- # Begin Source File
- 
- SOURCE=.\settings.f90
- DEP_F90_SETTI=\
- 	".\GetDist_Debug\AMLutils.mod"\
- 	".\GetDist_Debug\IniFile.mod"\
- 	".\GetDist_Debug\Random.mod"\
- 	
- # End Source File
- # Begin Source File
- 
- SOURCE=.\utils.F90
- NODEP_F90_UTILS=\
- 	".\GetDist_Debug\F90_UNIX.mod"\
- 	".\GetDist_Debug\mpif.h"\
- 	".\xml_dll_use.mod"\
- 	".\XML_INCLUDE.F90"\
- 	".\xml_static_use.mod"\
- 	
- # End Source File
- # End Group
- # Begin Group "Header Files"
- 
- # PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
- # End Group
- # Begin Group "Resource Files"
- 
- # PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
- # End Group
- # End Target
- # End Project
--- 0 ----
diff -r -c -b -B -N cosmomc/source/GetDist.vfproj cosmomc_sampler/source/GetDist.vfproj
*** cosmomc/source/GetDist.vfproj	2009-09-17 18:33:58.000000000 +0200
--- cosmomc_sampler/source/GetDist.vfproj	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,34 ****
- <?xml version="1.0" encoding="UTF-8"?>
- <VisualStudioProject ProjectCreator="Intel Fortran" Keyword="Console Application - Converted from CVF" Version="11.0" ProjectIdGuid="{573A6A6A-BD92-4FF0-BD64-E101E2496178}">
- 	<Platforms>
- 		<Platform Name="Win32"/></Platforms>
- 	<Configurations>
- 		<Configuration Name="Debug|Win32" OutputDirectory="GetDist_Debug" IntermediateDirectory="GetDist_Debug" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.exe;$(TargetPath)">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" DebugInformationFormat="debugEnabled" Optimization="optimizeDisabled" Preprocess="preprocessYes" PreprocessorDefinitions="MATRIX_SINGLE,RUNIDLE" LocalVariableStorage="localStorageSave" CallingConvention="callConventionCVF" ModulePath="GetDist_Debug/" ObjectFile="$(INTDIR)/" AssemblerListingLocation="$(INTDIR)/" Traceback="true" BoundsCheck="true" RuntimeLibrary="rtMultiThreadedDebug"/>
- 				<Tool Name="VFLinkerTool" AdditionalOptions="/MACHINE:I386" OutputFile="../GetDist.exe" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" AdditionalLibraryDirectories="C:\Program Files\Intel\MKL\9.1.027\ia32\lib" GenerateDebugInformation="true" ProgramDatabaseFile="GetDist_Debug/GetDist.pdb" SubSystem="subSystemConsole" ImportLibrary="" AdditionalDependencies="kernel32.lib mkl_s.lib libguide.lib"/>
- 				<Tool Name="VFResourceCompilerTool" PreprocessorDefinitions="_DEBUG" Culture="rcEnglishBritain" ResourceOutputFileName="$(INTDIR)/$(InputName).res"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="" DLLDataFileName="" TypeLibraryName="$(OUTDIR)/GetDist.tlb"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration>
- 		<Configuration Name="Release|Win32" OutputDirectory="Release" IntermediateDirectory="Release" DeleteExtensionsOnClean="*.obj;*.mod;*.pdb;*.asm;*.map;*.dyn;*.dpi;*.tmp;*.log;*.ilk;*.exe;$(TargetPath)">
- 				<Tool Name="VFFortranCompilerTool" SuppressStartupBanner="true" LocalVariableStorage="localStorageSave" CallingConvention="callConventionCVF" ModulePath="$(INTDIR)/" ObjectFile="$(INTDIR)/" AssemblerListingLocation="$(INTDIR)/"/>
- 				<Tool Name="VFLinkerTool" AdditionalOptions="/MACHINE:I386" OutputFile="$(OUTDIR)/GetDist.exe" LinkIncremental="linkIncrementalNo" SuppressStartupBanner="true" ProgramDatabaseFile="$(OUTDIR)/GetDist.pdb" SubSystem="subSystemConsole" ImportLibrary="" AdditionalDependencies="kernel32.lib"/>
- 				<Tool Name="VFResourceCompilerTool" PreprocessorDefinitions="NDEBUG" Culture="rcEnglishBritain" ResourceOutputFileName="$(INTDIR)/$(InputName).res"/>
- 				<Tool Name="VFMidlTool" SuppressStartupBanner="true" HeaderFileName="" DLLDataFileName="" TypeLibraryName="$(OUTDIR)/GetDist.tlb"/>
- 				<Tool Name="VFCustomBuildTool"/>
- 				<Tool Name="VFPreLinkEventTool"/>
- 				<Tool Name="VFPreBuildEventTool"/>
- 				<Tool Name="VFPostBuildEventTool"/></Configuration></Configurations>
- 	<Files>
- 		<Filter Name="Header Files" Filter="h;hpp;hxx;hm;inl;fi;fd"/>
- 		<Filter Name="Resource Files" Filter="ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"/>
- 		<Filter Name="Source Files" Filter="cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp">
- 		<File RelativePath=".\GetDist.f90"/>
- 		<File RelativePath="..\camb\inifile.f90"/>
- 		<File RelativePath=".\Matrix_utils.F90"/>
- 		<File RelativePath=".\ParamNames.f90"/>
- 		<File RelativePath=".\settings.f90"/>
- 		<File RelativePath=".\utils.F90"/></Filter></Files>
- 	<Globals/></VisualStudioProject>
--- 0 ----
diff -r -c -b -B -N cosmomc/source/HST.f90 cosmomc_sampler/source/HST.f90
*** cosmomc/source/HST.f90	2009-10-20 15:24:54.000000000 +0200
--- cosmomc_sampler/source/HST.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,27 ****
- !HST from http://arxiv.org/abs/0905.0695
- !Thanks to Beth Reid, minor mods by AL, Oct 09
- module HST
- use cmbtypes
- use CAMB, only : AngularDiameterDistance  !!physical angular diam distance also in Mpc no h units
- use constants
- implicit none
- 
- ! angdistinveffh0 is the inverse of the angular diameter distance at z = 0.04 for H_0 = 74.2
- ! and a fiducial cosmology (omega_k = 0, omega_lambda = 0.7, w = -1); this is proportional to 
- !H_0 but includes the tiny cosmological dependence of the measurement (primarily on w) correctly.
- ! angdistinveffh0err = 3.6 / DL(0.04)
- real(dl), parameter :: angdistinvzeffh0 = 6.49405e-3, zeffh0 = 0.04, &
-                        angdistinvzeffh0errsqr = 9.93e-8
- 
- contains
- 
- real(dl) function HST_LnLike(CMB)
-   type(CMBParams) CMB
-   real(dl) :: theoryval
- 
-   theoryval = 1.0/AngularDiameterDistance(zeffh0)
-   HST_LnLike = (theoryval - angdistinvzeffh0)**2/(2*angdistinvzeffh0errsqr)
-   if (Feedback > 1) print *,'HST_LnLike like: ',HST_LnLike
- end function  HST_LnLike
- 
- end module HST
--- 0 ----
diff -r -c -b -B -N cosmomc/source/inifile.f90 cosmomc_sampler/source/inifile.f90
*** cosmomc/source/inifile.f90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_sampler/source/inifile.f90	2009-10-28 17:53:34.280467989 +0100
***************
*** 0 ****
--- 1,671 ----
+ !Module to read in name/value pairs from a file, with each line of the form line 'name = value'
+ !Should correctly interpret FITS headers
+ !Antony Lewis (http://cosmologist.info/). Released to the public domain.
+ !This version Oct 2009.
+ 
+ module IniFile
+  implicit none
+  public
+ 
+   integer, parameter :: Ini_max_name_len = 128
+ 
+   integer, parameter :: Ini_max_string_len = 1024
+   logical :: Ini_fail_on_not_found = .false.
+ 
+   logical :: Ini_Echo_Read = .false.
+ 
+   type TNameValue
+    !no known way to make character string pointers..
+     character(Ini_max_name_len)  :: Name
+     character(Ini_max_string_len):: Value
+   end type TNameValue
+ 
+   type TNameValue_pointer
+      Type(TNameValue), pointer :: P
+   end type TNameValue_pointer
+ 
+   Type TNameValueList
+     integer Count
+     integer Delta
+     integer Capacity
+     type(TNameValue_pointer), dimension(:), pointer :: Items
+   end Type TNameValueList
+ 
+   Type TIniFile
+    logical SlashComments
+    Type (TNameValueList) :: L, ReadValues
+   end Type TIniFile
+  
+   Type(TIniFile) :: DefIni
+ 
+ contains
+ 
+    subroutine TNameValueList_Init(L)
+     Type (TNameValueList) :: L
+     
+      L%Count = 0
+      L%Capacity = 0
+      L%Delta = 128
+      nullify(L%Items)
+ 
+    end subroutine TNameValueList_Init
+ 
+    subroutine TNameValueList_Clear(L)
+     Type (TNameValueList) :: L
+     integer i, status
+      
+     do i=L%count,1,-1
+      deallocate (L%Items(i)%P, stat = status)
+     end do
+     deallocate (L%Items, stat = status)
+     call TNameValueList_Init(L)
+ 
+    end subroutine TNameValueList_Clear
+ 
+    subroutine TNameValueList_ValueOf(L, AName, AValue)
+      Type (TNameValueList), intent(in) :: L
+      character(LEN=*), intent(in) :: AName
+      CHARACTER(LEN=*), intent(out) :: AValue
+      integer i
+ 
+      do i=1, L%Count
+        if (L%Items(i)%P%Name == AName) then
+           AValue = L%Items(i)%P%Value 
+           return
+        end if
+      end do
+      AValue = ''
+ 
+    end subroutine TNameValueList_ValueOf
+ 
+    function TNameValueList_HasKey(L, AName) result (AValue)
+      Type (TNameValueList), intent(in) :: L
+      character(LEN=*), intent(in) :: AName
+      logical :: AValue
+      integer i
+ 
+      do i=1, L%Count
+        if (L%Items(i)%P%Name == AName) then
+           AValue = .true.
+           return
+        end if
+      end do
+      AValue = .false.
+      
+    end function TNameValueList_HasKey
+     
+    subroutine TNameValueList_Add(L, AName, AValue)
+     Type (TNameValueList) :: L
+     character(LEN=*), intent(in) :: AName, AValue
+ 
+     if (L%Count == L%Capacity) call TNameValueList_SetCapacity(L, L%Capacity + L%Delta)
+     L%Count = L%Count + 1
+     allocate(L%Items(L%Count)%P)
+     L%Items(L%Count)%P%Name = AName
+     L%Items(L%Count)%P%Value = AValue
+ 
+    end subroutine TNameValueList_Add
+ 
+    subroutine TNameValueList_SetCapacity(L, C)
+     Type (TNameValueList) :: L
+     integer C
+     type(TNameValue_pointer), dimension(:), pointer :: TmpItems
+     
+     if (L%Count > 0) then
+       if (C < L%Count) stop 'TNameValueList_SetCapacity: smaller than Count'
+       allocate(TmpItems(L%Count))
+       TmpItems = L%Items(1:L%Count)
+       deallocate(L%Items)
+       allocate(L%Items(C))
+       L%Items(1:L%Count) = TmpItems
+       deallocate(TmpItems)
+     else
+      allocate(L%Items(C))
+     end if  
+     L%Capacity = C
+   
+    end subroutine TNameValueList_SetCapacity
+ 
+    subroutine TNameValueList_Delete(L, i)
+     Type (TNameValueList) :: L
+     integer, intent(in) :: i
+      
+      deallocate(L%Items(i)%P)
+      if (L%Count > 1) L%Items(i:L%Count-1) = L%Items(i+1:L%Count)
+      L%Count = L%Count -1
+      
+    end subroutine TNameValueList_Delete
+ 
+   subroutine Ini_NameValue_Add(Ini,AInLine)
+     Type(TIniFile) :: Ini
+     character (LEN=*), intent(IN) :: AInLine
+     integer EqPos, slashpos, lastpos
+     character (LEN=len(AInLine)) :: AName, S, InLine
+ 
+       InLine=trim(adjustl(AInLine))
+       EqPos = scan(InLine,'=')
+       if (EqPos/=0 .and. InLine(1:1)/='#' .and. InLine(1:7) /= 'COMMENT' ) then
+    
+          AName = trim(InLine(1:EqPos-1))
+          
+          S = adjustl(InLine(EqPos+1:)) 
+            if (Ini%SlashComments) then
+            slashpos=scan(S,'/')
+            if (slashpos /= 0) then
+               S  = S(1:slashpos-1)
+            end if
+          end if
+          lastpos=len_trim(S)
+          if (lastpos>1) then
+           if (S(1:1)=='''' .and. S(lastpos:lastpos)=='''') then
+            S = S(2:lastpos-1)
+           end if
+          end if
+          call TNameValueList_Add(Ini%L, AName, S)
+ 
+       end if
+ 
+   end subroutine Ini_NameValue_Add
+ 
+   subroutine Ini_Open(filename, unit_id,  error, slash_comments)
+      character (LEN=*), intent(IN) :: filename
+      integer, intent(IN) :: unit_id
+      logical, optional, intent(OUT) :: error
+      logical, optional, intent(IN) :: slash_comments
+      logical aerror
+ 
+      call TNameValueList_Init(DefIni%L)
+      call TNameValueList_Init(DefIni%ReadValues)
+           
+      if (present(slash_comments)) then
+       call Ini_Open_File(DefIni,filename,unit_id,aerror,slash_comments)
+      else
+       call Ini_Open_File(DefIni,filename,unit_id,aerror)
+      end if
+ 
+      if (present(error)) then
+        error = aerror
+      else
+       if (aerror) then
+         write (*,*) 'Ini_Open: Error opening file ' // trim(filename)
+         stop
+       end if
+      end if
+ 
+   end subroutine Ini_Open
+ 
+ 
+ 
+   subroutine Ini_Open_File(Ini, filename, unit_id,  error, slash_comments)
+      Type(TIniFile) :: Ini
+ 
+      character (LEN=*), intent(IN) :: filename
+      integer, intent(IN) :: unit_id
+      logical, intent(OUT) :: error
+      logical, optional, intent(IN) :: slash_comments
+      character (LEN=120) :: InLine
+     
+ 
+     call TNameValueList_Init(Ini%L)
+     call TNameValueList_Init(Ini%ReadValues)
+ 
+     if (present(slash_comments)) then
+      Ini%SlashComments = slash_comments
+     else
+      Ini%SlashComments = .false.
+     end if
+          
+     open(unit=unit_id,file=filename,form='formatted',status='old', err=500)
+    
+     do 
+       read (unit_id,'(a)',end=400) InLine
+       if (InLine == 'END') exit;
+       if (InLine /= '') call Ini_NameValue_Add(Ini,InLine) 
+     end do
+ 
+ 400 close(unit_id)
+     error=.false.
+     return
+ 
+ 500 error=.true.
+ 
+   end subroutine Ini_Open_File
+ 
+   subroutine Ini_Open_Fromlines(Ini, Lines, NumLines, slash_comments)
+     Type(TIniFile) :: Ini
+ 
+     integer, intent(IN) :: NumLines
+     character (LEN=*), dimension(NumLines), intent(IN) :: Lines
+     logical, intent(IN) :: slash_comments
+     integer i
+ 
+     call TNameValueList_Init(Ini%L)
+     call TNameValueList_Init(Ini%ReadValues)
+ 
+     Ini%SlashComments = slash_comments
+ 
+     do i=1,NumLines
+        call Ini_NameValue_Add(Ini,Lines(i))
+     end do
+ 
+   end  subroutine Ini_Open_Fromlines
+ 
+   subroutine Ini_Close
+ 
+     call Ini_close_File(DefIni)
+ 
+   end subroutine Ini_Close
+ 
+ 
+   subroutine Ini_Close_File(Ini)
+     Type(TIniFile) :: Ini
+    
+     call TNameValueList_Clear(Ini%L)
+     call TNameValueList_Clear(Ini%ReadValues)
+ 
+   end  subroutine Ini_Close_File
+   
+ 
+ 
+   function Ini_Read_String(Key, NotFoundFail) result(AValue)
+    character (LEN=*), intent(IN) :: Key
+    logical, optional, intent(IN) :: NotFoundFail
+    character(LEN=Ini_max_string_len) :: AValue
+ 
+      if (present(NotFoundFail)) then
+       AValue = Ini_Read_String_File(DefIni, Key, NotFoundFail)
+      else
+       AValue = Ini_Read_String_File(DefIni, Key)
+      end if
+ 
+   end function Ini_Read_String
+ 
+ 
+   function Ini_Read_String_File(Ini, Key, NotFoundFail) result(AValue)
+    Type(TIniFile) :: Ini
+    character (LEN=*), intent(IN) :: Key
+    logical, optional, intent(IN) :: NotFoundFail
+    character(LEN=Ini_max_string_len) :: AValue
+ 
+    call TNameValueList_ValueOf(Ini%L, Key, AValue)
+ 
+    if (AValue/='') then
+ 
+     call  TNameValueList_Add(Ini%ReadValues, Key, AValue)
+     if (Ini_Echo_Read) write (*,*) trim(Key)//' = ',trim(AValue)
+     return
+ 
+    end if
+    if (present(NotFoundFail)) then
+       if (NotFoundFail) then
+          write(*,*) 'key not found : '//trim(Key)
+          stop
+       end if
+    else if (Ini_fail_on_not_found) then
+       write(*,*) 'key not found : '//trim(Key)
+       stop
+    end if
+ 
+   end function Ini_Read_String_File
+   function Ini_HasKey(Key) result(AValue)
+    character (LEN=*), intent(IN) :: Key
+    logical AValue
+ 
+    AValue = Ini_HasKey_File(DefIni, Key)
+ 
+   end function Ini_HasKey
+ 
+   function Ini_HasKey_File(Ini, Key) result(AValue)
+    type(TIniFile), intent(in) :: Ini
+    character (LEN=*), intent(IN) :: Key
+    logical AValue
+ 
+       Avalue = TNameValueList_HasKey(Ini%L, Key)
+       
+   end function Ini_HasKey_File
+ 
+  function Ini_Key_To_Arraykey(Key, index)  result(AValue)
+     character (LEN=*), intent(IN) :: Key
+     integer, intent(in) :: index
+     character(LEN=Ini_max_string_len) :: AValue
+     
+     character(LEN=32) :: numstr
+     write (numstr,*) index 
+     numstr=adjustl(numstr)
+     AValue = trim(Key) // '(' // trim(numStr) // ')' 
+  
+  end function Ini_Key_To_Arraykey
+ 
+   function Ini_Read_String_Array(Key, index, NotFoundFail) result(AValue)
+    character (LEN=*), intent(IN) :: Key
+    integer, intent(in) :: index
+    logical, optional, intent(IN) :: NotFoundFail
+    character(LEN=Ini_max_string_len) :: AValue
+ 
+      if (present(NotFoundFail)) then
+       AValue = Ini_Read_String_Array_File(DefIni, Key, index, NotFoundFail)
+      else
+       AValue = Ini_Read_String_Array_File(DefIni, Key, index)
+      end if
+ 
+   end function Ini_Read_String_Array
+ 
+   function Ini_Read_String_Array_File(Ini, Key, index, NotFoundFail) result(AValue)
+    Type(TIniFile) :: Ini
+    integer, intent(in) :: index
+    character (LEN=*), intent(IN) :: Key
+    logical, optional, intent(IN) :: NotFoundFail
+    character(LEN=Ini_max_string_len) :: AValue
+    character(LEN=Ini_max_string_len) :: ArrayKey
+    
+      ArrayKey = Ini_Key_To_Arraykey(Key,index)
+      if (present(NotFoundFail)) then
+       AValue = Ini_Read_String_File(Ini, ArrayKey, NotFoundFail)
+      else
+       AValue = Ini_Read_String_File(Ini, ArrayKey)
+      end if
+    
+   end function Ini_Read_String_Array_File
+ 
+   function Ini_Read_Int_Array(Key, index, Default)
+      integer, optional, intent(IN) :: Default
+      integer, intent(in) :: index
+      character (LEN=*), intent(IN) :: Key
+      integer Ini_Read_Int_Array
+ 
+      if (present(Default)) then
+       Ini_Read_Int_Array = Ini_Read_Int_Array_File(DefIni, Key, index, Default)
+      else
+       Ini_Read_Int_Array = Ini_Read_Int_Array_File(DefIni, Key, index)
+      end if
+      
+    end function Ini_Read_Int_Array
+ 
+   function Ini_Read_Int_Array_File(Ini,Key, index, Default)
+   !Reads Key(1), Key(2), etc.
+    Type(TIniFile) :: Ini
+    integer Ini_Read_Int_Array_File 
+    integer, optional, intent(IN) :: Default
+    integer, intent(in) :: index
+    character (LEN=*), intent(IN) :: Key
+    character(LEN=Ini_max_string_len) :: ArrrayKey
+      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
+      if (present(Default)) then
+       Ini_Read_Int_Array_File = Ini_Read_Int_File(Ini, ArrrayKey, Default)
+      else
+       Ini_Read_Int_Array_File = Ini_Read_Int_File(Ini, ArrrayKey)
+      end if
+   end function Ini_Read_Int_Array_File
+ 
+ 
+   function Ini_Read_Int(Key, Default)
+      integer, optional, intent(IN) :: Default
+      character (LEN=*), intent(IN) :: Key
+      integer Ini_Read_Int
+ 
+      if (present(Default)) then
+       Ini_Read_Int = Ini_Read_Int_File(DefIni, Key, Default)
+      else
+       Ini_Read_Int = Ini_Read_Int_File(DefIni, Key)
+      end if
+   end function Ini_Read_Int
+ 
+   function Ini_Read_Int_File(Ini, Key, Default)
+    Type(TIniFile) :: Ini
+    integer Ini_Read_Int_File
+    integer, optional, intent(IN) :: Default
+    character  (LEN=*), intent(IN) :: Key
+    character(LEN=Ini_max_string_len) :: S
+    
+    S = Ini_Read_String_File(Ini, Key,.not. present(Default))
+    if (S == '') then
+       if (.not. present(Default)) then
+         write(*,*) 'no value for key: '//Key
+         stop
+       end if
+       Ini_Read_Int_File = Default
+       write (S,*) Default
+       call  TNameValueList_Add(Ini%ReadValues, Key, S)
+    else
+     if (verify(trim(S),'-+0123456789') /= 0) goto 10
+     read (S,*, err = 10) Ini_Read_Int_File
+    end if
+   return
+ 10 write (*,*) 'error reading integer for key: '//Key
+    stop
+   
+   end function Ini_Read_Int_File
+ 
+   function Ini_Read_Double(Key, Default)
+      double precision, optional, intent(IN) :: Default
+      character (LEN=*), intent(IN) :: Key
+      double precision Ini_Read_Double
+ 
+      if (present(Default)) then
+       Ini_Read_Double = Ini_Read_Double_File(DefIni, Key, Default)
+      else
+       Ini_Read_Double = Ini_Read_Double_File(DefIni, Key)
+      end if
+   
+   end function Ini_Read_Double
+ 
+   function Ini_Read_Double_File(Ini,Key, Default)
+    Type(TIniFile) :: Ini
+    double precision Ini_Read_Double_File 
+    double precision, optional, intent(IN) :: Default
+    character (LEN=*), intent(IN) :: Key
+    character(LEN=Ini_max_string_len) :: S
+    
+    S = Ini_Read_String_File(Ini,Key,.not. present(Default))
+    if (S == '') then
+       if (.not. present(Default)) then
+         write(*,*) 'no value for key: '//Key
+         stop
+       end if
+       Ini_Read_Double_File = Default
+       write (S,*) Default
+ 
+       call  TNameValueList_Add(Ini%ReadValues, Key, S)
+ 
+    else
+     read (S,*, err=10) Ini_Read_Double_File
+    end if
+ 
+   return
+ 
+ 10 write (*,*) 'error reading double for key: '//Key
+    stop
+ 
+   end function Ini_Read_Double_File
+ 
+ 
+ 
+     function Ini_Read_Double_Array(Key, index, Default)
+      double precision, optional, intent(IN) :: Default
+      integer, intent(in) :: index
+      character (LEN=*), intent(IN) :: Key
+      double precision Ini_Read_Double_Array
+ 
+      if (present(Default)) then
+       Ini_Read_Double_Array = Ini_Read_Double_Array_File(DefIni, Key, index, Default)
+      else
+       Ini_Read_Double_Array = Ini_Read_Double_Array_File(DefIni, Key, index)
+      end if
+      
+     end function Ini_Read_Double_Array
+ 
+ 
+   function Ini_Read_Double_Array_File(Ini,Key, index, Default)
+ 
+   !Reads Key(1), Key(2), etc.
+ 
+    Type(TIniFile) :: Ini
+ 
+    double precision Ini_Read_Double_Array_File 
+    double precision, optional, intent(IN) :: Default
+    integer, intent(in) :: index
+    character (LEN=*), intent(IN) :: Key
+    character(LEN=Ini_max_string_len) ::  ArrrayKey
+ 
+      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
+      if (present(Default)) then
+ 
+       Ini_Read_Double_Array_File = Ini_Read_Double_File(Ini, ArrrayKey, Default)
+      else
+       Ini_Read_Double_Array_File = Ini_Read_Double_File(Ini, ArrrayKey)
+      end if
+   end function Ini_Read_Double_Array_File
+ 
+     function Ini_Read_Real(Key, Default)
+      real, optional, intent(IN) :: Default
+      character (LEN=*), intent(IN) :: Key
+      real Ini_Read_Real
+ 
+      if (present(Default)) then
+       Ini_Read_Real = Ini_Read_Real_File(DefIni, Key, Default)
+      else
+       Ini_Read_Real = Ini_Read_Real_File(DefIni, Key)
+      end if
+ 
+     end function Ini_Read_Real
+ 
+     function Ini_Read_Real_File(Ini,Key, Default)
+     Type(TIniFile) :: Ini
+     real Ini_Read_Real_File 
+     real, optional, intent(IN) :: Default
+     character (LEN=*), intent(IN) :: Key
+     character(LEN=Ini_max_string_len) :: S
+    
+     S = Ini_Read_String_File(Ini,Key,.not. present(Default))
+     if (S == '') then
+       if (.not. present(Default)) then
+         write(*,*) 'no value for key: '//Key
+         stop
+       end if
+       Ini_Read_Real_File = Default
+       write (S,*) Default
+       call  TNameValueList_Add(Ini%ReadValues, Key, S)
+ 
+    else
+     read (S,*, err=10) Ini_Read_Real_File
+    end if
+ 
+   return
+ 
+ 10 write (*,*) 'error reading double for key: '//Key
+    stop
+ 
+   end function Ini_Read_Real_File
+ 
+ 
+ 
+    function Ini_Read_Real_Array(Key, index, Default)
+      real, optional, intent(IN) :: Default
+      integer, intent(in) :: index
+      character (LEN=*), intent(IN) :: Key
+      real Ini_Read_Real_Array
+ 
+      if (present(Default)) then
+       Ini_Read_Real_Array = Ini_Read_Real_Array_File(DefIni, Key, index, Default)
+      else
+       Ini_Read_Real_Array = Ini_Read_Real_Array_File(DefIni, Key, index)
+      end if
+    end function Ini_Read_Real_Array
+ 
+   function Ini_Read_Real_Array_File(Ini,Key, index, Default)
+   !Reads Key(1), Key(2), etc.
+    Type(TIniFile) :: Ini
+    real Ini_Read_Real_Array_File 
+    real, optional, intent(IN) :: Default
+    integer, intent(in) :: index
+    character (LEN=*), intent(IN) :: Key
+    character(LEN=Ini_max_string_len) :: ArrrayKey
+    
+      ArrrayKey = Ini_Key_To_Arraykey(Key,index)
+      if (present(Default)) then
+       Ini_Read_Real_Array_File = Ini_Read_Real_File(Ini, ArrrayKey, Default)
+      else
+       Ini_Read_Real_Array_File = Ini_Read_Real_File(Ini, ArrrayKey)
+      end if
+   end function Ini_Read_Real_Array_File
+ 
+   function Ini_Read_Logical(Key, Default)
+      Logical, optional, intent(IN) :: Default
+      character (LEN=*), intent(IN) :: Key
+     logical Ini_Read_Logical
+ 
+      if (present(Default)) then
+       Ini_Read_Logical = Ini_Read_Logical_File(DefIni, Key, Default)
+      else
+       Ini_Read_Logical = Ini_Read_Logical_File(DefIni, Key)
+      end if
+   end function Ini_Read_Logical
+ 
+   function Ini_Read_Logical_File(Ini, Key, Default)
+    Type(TIniFile) :: Ini
+ 
+    logical Ini_Read_Logical_File
+    logical, optional, intent(IN) :: Default
+    character  (LEN=*), intent(IN) :: Key
+   
+    character(LEN=Ini_max_string_len) :: S
+    
+    S = Ini_Read_String_File(Ini,Key,.not. present(Default))
+    if (S == '') then
+       if (.not. present(Default)) then
+         write(*,*) 'no value for key: '//Key
+         stop
+       end if
+       Ini_Read_Logical_File = Default
+       write (S,*) Default
+ 
+       call  TNameValueList_Add(Ini%ReadValues, Key, S)
+ 
+    else
+ 
+     if (verify(trim(S),'10TF') /= 0) goto 10  
+     read (S,*, err = 10) Ini_Read_Logical_File
+    end if
+ 
+   return
+ 
+ 10 write (*,*) 'error reading logical for key: '//Key
+    stop
+   end function Ini_Read_Logical_File
+ 
+ 
+ 
+   subroutine Ini_SaveReadValues(afile,unit_id)
+    character(LEN=*)  :: afile
+    integer, intent(in) :: unit_id
+ 
+    call Ini_SaveReadValues_File(DefIni, afile, unit_id)
+ 
+   end subroutine Ini_SaveReadValues
+ 
+ 
+ 
+   subroutine Ini_SaveReadValues_File(Ini, afile, unit_id)
+    Type(TIniFile) :: Ini
+    character(LEN=*), intent(in) :: afile
+    integer, intent(in) :: unit_id
+    integer i
+ 
+    open(unit=unit_id,file=afile,form='formatted',status='replace', err=500)
+ 
+    do i=1, Ini%ReadValues%Count
+ 
+     write (unit_id,'(a)') trim(Ini%ReadValues%Items(i)%P%Name) // ' = ' &
+                         //trim(Ini%ReadValues%Items(i)%P%Value)
+ 
+    end do
+ 
+    close(unit_id)
+    return
+ 
+ 500 write(*,*) 'Ini_SaveReadValues_File: Error creating '//trim(afile)
+ 
+   end subroutine Ini_SaveReadValues_File
+ 
+ end module IniFile
+ 
diff -r -c -b -B -N cosmomc/source/lrggettheory.f90 cosmomc_sampler/source/lrggettheory.f90
*** cosmomc/source/lrggettheory.f90	2009-10-27 00:48:14.000000000 +0100
--- cosmomc_sampler/source/lrggettheory.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,189 ****
- !!! moved this routine from modules.f90 in CAMB here by preference of Antony.
- !!! needs to be separate from Pktheory.f90 because that file depends on CMB_Cls somehow
- 
- module lrggettheory
- use precision
- use Transfer
- implicit none
- 
- real(dl), parameter ::  aNEAR = 0.809717d0, aMID = 0.745156d0, aFAR = 0.70373d0
- real(dl), parameter ::  z0 = 0.0d0, zNEAR = 0.235d0, zMID = 0.342d0, zFAR = 0.421d0
- real(dl), parameter ::  sigma2BAONEAR = 86.9988, sigma2BAOMID = 85.1374, sigma2BAOFAR = 84.5958
- real(dl), parameter :: zeffDR7 = 0.312782  !! effective redshift of the LRG sample
- real(dl), dimension(4) :: transferscalefid  !! this is set in LRGinfo_init
- real(dl), dimension(4) :: powerscaletoz0  
-  !! this is to scale the amplitude of the redshift slices power spectra to the z=0 amplitude; 
-  !this is the assumption of the model.
- real(dl), parameter :: kmindata = 0.02 
-  !! in h/Mpc.  they are needed for normalizing nowiggs power spectrum. 
- ! Hard coded for the SDSS DR7 values.
- integer :: iz0lrg, izNEARlrg, izMIDlrg, izFARlrg
- logical :: use_dr7lrg = .false.  
- 
- contains
- 
-         subroutine Transfer_GetMatterPowerAndNW(MTrans,outpower, itf, in, minkh, dlnkh, &
-                 npoints, kmindata, getabstransferscale, outpowernw, outpowerrationwhalofit)
- 
-           !Allows for non-smooth priordial spectra
-           !if CP%Nonlinear/ = NonLinear_none includes non-linear evolution
-           !Get total matter power spectrum at logarithmically equal intervals dlnkh of k/h starting at minkh
-           !in units of (h Mpc^{-1})^3.
-           !Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
-           !We are assuming that Cls are generated so any baryonic wiggles are well sampled and that matter power
-           !sepctrum is generated to beyond the CMB k_max
-           Type(MatterTransferData), intent(in) :: MTrans
-           Type(MatterPowerData) :: PKnw
- 
-           integer, intent(in) :: itf, in, npoints 
-           real, intent(out) :: outpower(npoints)
-           real, intent(out) :: outpowernw(npoints), outpowerrationwhalofit(npoints)
-           real, intent(in) :: minkh, dlnkh
-           real(dl), intent(in) :: kmindata
-           real(dl), intent(out) :: getabstransferscale
-           real(dl), parameter :: cllo=1.e30_dl,clhi=1.e30_dl
-           integer ik, llo,il,lhi,lastix
-           real(dl) matpower(MTrans%num_q_trans), kh, kvals(MTrans%num_q_trans), ddmat(MTrans%num_q_trans)
-           real(dl) atransfer,xi, a0, b0, ho, logmink,k, h, fbaryon,omegam
-           real(dl) matpowernw(MTrans%num_q_trans), matpowernwhalofit(MTrans%num_q_trans), &
-           & atransfernw, atransfernwhalofit, &
-           &ddmatnw(MTrans%num_q_trans), ddmatnwhalofit(MTrans%num_q_trans)
- 
-           !!added for splining.
-           real(dl) :: mykvals(MTrans%num_q_trans),mylnpklinear(MTrans%num_q_trans),mylnpksmooth(MTrans%num_q_trans)
- 
-           integer :: nwi,tempi, setabs
-           Type(MatterTransferData) :: MTransnw
- 
-           MTransnw%num_q_trans = MTrans%num_q_trans
-           allocate(MTransnw%q_trans(MTransnw%num_q_trans))
-           allocate(MTransnw%TransferData(Transfer_max,MTransnw%num_q_trans,CP%Transfer%num_redshifts))
-           allocate(MTransnw%sigma_8(CP%Transfer%num_redshifts, CP%InitPower%nn))
- 
- 
-           h = CP%H0/100
-           do nwi = 1, MTransnw%num_q_trans
-             MTransnw%q_trans(nwi) = MTrans%q_trans(nwi)  !! not ever referenced.
-             MTransnw%TransferData(Transfer_kh,nwi,1) = MTrans%TransferData(Transfer_kh,nwi,1)
-             kh = MTrans%TransferData(Transfer_kh,nwi,1)
-             k = kh*h
-             do tempi=2,Transfer_tot
-               MTransnw%TransferData(tempi,nwi,1) = 0.0d0
-             end do
-             mykvals(nwi) = k
-             atransfer=MTrans%TransferData(transfer_power_var,nwi,itf)
-             mylnpklinear(nwi) = log(atransfer**2*k*pi*twopi*h**3*ScalarPower(k,in))
-           end do
- 
- #ifdef DR71RG
-           call dopksmoothbspline(mykvals,mylnpklinear,mylnpksmooth, MTrans%num_q_trans)
- #else
-          call MpiStop('mpk: edit makefile to have "EXTDATA = LRG" to inlude LRGs')
- #endif
-           setabs = 0
-           do nwi = 1, MTransnw%num_q_trans
-             kh = MTrans%TransferData(Transfer_kh,nwi,1)
-             if(kh > kmindata .and. setabs == 0) then
-               getabstransferscale = sqrt(exp(mylnpklinear(nwi)))
-               setabs = 1
-            end if
-             k = kh*h
-             MTransnw%TransferData(transfer_power_var,nwi,1) = sqrt(exp(mylnpksmooth(nwi))/(k*pi*twopi*h**3*ScalarPower(k,in)))
-           end do
-           if (npoints < 2) stop 'Need at least 2 points in Transfer_GetMatterPower'
-           if (minkh*exp((npoints-1)*dlnkh) > MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf) &
-                 .and. FeedbackLevel > 0 ) &
-                     write(*,*) 'Warning: extrapolating matter power in Transfer_GetMatterPower'
- 
-           !! get nonlinear on Pnw
-           call Transfer_GetMatterPowerData(MTransnw,PKnw, in, 1)
-           Pknw%redshifts(1) = CP%Transfer%Redshifts(itf)
-           call NonLinear_GetRatios(Pknw)
- 
-           h = CP%H0/100
-           logmink = log(minkh)
-           do ik=1,MTrans%num_q_trans
-              kh = MTrans%TransferData(Transfer_kh,ik,itf)
-              k = kh*h
-              kvals(ik) = log(kh)
-              atransfer=MTrans%TransferData(transfer_power_var,ik,itf)
-              atransfernw=MTransnw%TransferData(transfer_power_var,ik,1)
-              atransfernwhalofit=MTransnw%TransferData(transfer_power_var,ik,1)
-              atransfernwhalofit = atransfernwhalofit * PKnw%nonlin_ratio(ik,1)
-              matpower(ik) = log(atransfer**2*k*pi*twopi*h**3)
-                  !Put in power spectrum later: transfer functions should be smooth, initial power may not be
- 
-              matpowernw(ik) = log(atransfernw**2*k*pi*twopi*h**3)
-              matpowernwhalofit(ik) = log(atransfernwhalofit**2*k*pi*twopi*h**3)
-           end do
-           call spline(kvals,matpower,MTrans%num_q_trans,cllo,clhi,ddmat)
-           call spline(kvals,matpowernw,MTrans%num_q_trans,cllo,clhi,ddmatnw)
-           call spline(kvals,matpowernwhalofit,MTrans%num_q_trans,cllo,clhi,ddmatnwhalofit)
- 
- 
-             llo=1
-             lastix = npoints + 1
-             do il=1, npoints
-                xi=logmink + dlnkh*(il-1)
-                if (xi < kvals(1)) then
-                  outpower(il)=-30.
-                  outpowernw(il)=-30.
-                  outpowerrationwhalofit(il)=-30.
-                  cycle
-                end if
-                do while ((xi > kvals(llo+1)).and.(llo < MTrans%num_q_trans))
-                   llo=llo+1
-                   if (llo >= MTrans%num_q_trans) exit
-                end do
-                if (llo == MTrans%num_q_trans) then
-                    lastix = il
-                    exit
-                end if
-                lhi=llo+1
-                ho=kvals(lhi)-kvals(llo)
-                a0=(kvals(lhi)-xi)/ho
-                b0=(xi-kvals(llo))/ho
- 
-                outpower(il) = a0*matpower(llo)+ b0*matpower(lhi)+((a0**3-a0)* ddmat(llo) &
-                        +(b0**3-b0)*ddmat(lhi))*ho**2/6
-                outpowernw(il) = a0*matpowernw(llo)+ b0*matpowernw(lhi)+((a0**3-a0)* ddmatnw(llo) &
-                        +(b0**3-b0)*ddmatnw(lhi))*ho**2/6
-                outpowerrationwhalofit(il) = a0*matpowernwhalofit(llo)+ b0*matpowernwhalofit(lhi)+((a0**3-a0)* ddmatnwhalofit(llo) &
-                        +(b0**3-b0)*ddmatnwhalofit(lhi))*ho**2/6
- 
-             end do
- 
-             do while (lastix <= npoints)
-                !Do linear extrapolation in the log
-                !Obviouly inaccurate, non-linear etc, but OK if only using in tails of window functions
-                outpower(lastix) = 2*outpower(lastix-1) - outpower(lastix-2)
-                outpowernw(lastix) = 2*outpowernw(lastix-1) - outpowernw(lastix-2)
-                outpowerrationwhalofit(lastix) = 2*outpowerrationwhalofit(lastix-1)&
-                          - outpowerrationwhalofit(lastix-2)
-                lastix = lastix+1
-             end do
- 
-             outpower = exp(max(-30.,outpower))
-             outpowernw = exp(max(-30.,outpowernw))
-             outpowerrationwhalofit = exp(max(-30.,outpowerrationwhalofit))
- 
- 
-             do il = 1, npoints
-                k = exp(logmink + dlnkh*(il-1))*h
-                outpower(il) = outpower(il) * ScalarPower(k,in)
-                outpowerrationwhalofit(il) = outpowerrationwhalofit(il)/outpowernw(il) 
-                 !! do this first because the ScalarPower calls cancel.
-                outpowernw(il) = outpowernw(il) * ScalarPower(k,in)
-                !print *,k/h,outpower(il),outpowernw(il)
-                !print *,k/h,outpowerrationwhalofit(il)
-             end do
- 
-           call MatterPowerdata_Free(PKnw)
-           deallocate(MTransnw%q_trans)
-           deallocate(MTransnw%TransferData)
-           deallocate(MTransnw%sigma_8)
- 
-         end subroutine Transfer_GetMatterPowerAndNW
- 
- 
- end module
--- 0 ----
diff -r -c -b -B -N cosmomc/source/lya.f90 cosmomc_sampler/source/lya.f90
*** cosmomc/source/lya.f90	2006-04-20 22:14:30.000000000 +0200
--- cosmomc_sampler/source/lya.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,182 ****
-  !Module for using Viel et al. Lyman-alpha data 
- !J.Lesgourgues,29/10/04
- !AL modification to integrate over calibration numerically,
- !   reject models with weird high om_m that probe v small scales
- !April 2006: Fixed major bug (introduced by AL) 
- !            removed unsafe OPENMP; CROFT on by default
- 
- module lya
- use settings
- use cmbtypes
- implicit none
- 
-  integer, parameter :: lya_points = 9
-  real :: lya_k(lya_points)
- 
-  ! for LUQAS:
-  real :: lya_P1(lya_points), lya_dP1(lya_points)
-  logical :: use_LUQAS = .true. 
- 
-  ! for CROFT:
-  real :: lya_P2(lya_points), lya_dP2(lya_points)
-  logical :: use_CROFT = .true. 
- 
-  real :: lya_kmax = 6.
-  logical :: do_lya_init  = .true.
-  logical :: Use_lya = .false.
- 
- contains
- 
-  subroutine lya_init
-    integer i
-    
-     if (Feedback > 0) write(*,*) 'reading: Lyman-alpha data'
-     call OpenTxtFile('data/lyman_alpha.dat', tmp_file_unit)
- 
-     do i =1, lya_points
-       read (tmp_file_unit,*, end = 200, err=200) &
-            lya_k(i), lya_P1(i), lya_dP1(i), lya_P2(i), lya_dP2(i)
-     end do
-     close(tmp_file_unit)
- 
-     do_lya_init = .false.
- 
-     goto 300
- 
- 200 stop 'Error reading Lyman-alpha file'
-      
- 300 return
- 
-  end subroutine lya_init
- 
-  function LSS_lyalike(CMB, Theory)
-     Type (CMBParams) CMB
-    Type (CosmoTheory) Theory
-    real LSS_lyalike
-    real  omegam, g2, omegam_z, omegav_z, th, chisq, minchisq
-    real z, z1, z2, coef, D_ratio, acal
-    integer, parameter :: ncal=12
-    real dif2(-ncal:ncal)
-    real, parameter :: dcal= 0.25
-    real calweights(-ncal:ncal)
-    real, parameter :: cal_sigma = 0.29
-    integer i, ical
-    
-     if (do_lya_init) call lya_init
- 
-     if (CMB%W /= -1. .or. CMB%omnu/=0.) then
-       write (*,*) 'Lya.f90 not tested for extended models'
-       stop
-     end if
-    
- 
-     z1=2.125
-     z2=2.72
-     omegam=1.-CMB%omv-CMB%omk
- 
-     dif2 = 0
- 
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- 
-     ! compute chi2 for LUQAS
- 
-     if (use_LUQAS) then
- 
-        z=z1
-     
-     ! coefficient from h/Mpc to s/km
-        g2=omegam*(1.+z)**3+CMB%omk*(1.+z)**2+CMB%omv
-        coef = 100. * sqrt(g2) / (1.+z)
-     ! growth factor
-        omegam_z= omegam*(1.+z)**3/g2
-        omegav_z= CMB%omv/g2
-        D_ratio = omegam_z/(1.+z)/(exp(4./7.*log(omegam_z))-omegav_z &
-          +(1.+omegam_z/2.)*(1.+omegav_z/70.)) &
-          /omegam*(exp(4./7.*log(omegam))-CMB%omv &
-          +(1.+omegam/2.)*(1.+CMB%omv/70.))
- 
- 
-       if (lya_k(lya_points)*coef > &
-         exp(log(matter_power_minkh) + (num_matter_power-1)*matter_power_dlnkh)) then
-          !Just thow out if way-off model
-           LSS_lyalike = LogZero
-           return 
-        end if
- 
-        do i=1, lya_points
-          
-          th = MatterPowerAt(Theory,lya_k(i)*coef) *coef**3 &
-                *(D_ratio)**2 &
-                *(1.+1.4*exp(0.6*log(omegam_z)))/2.4
- 
-          do ical=-ncal,ncal
-            acal = 1+ical*cal_sigma*dcal 
- 
-            dif2(ical) = dif2(ical) +  ((th-lya_P1(i)*0.93*acal)**2/ &
-                       (lya_dP1(i)*0.93*acal)**2)
-          end do
-  
-        end do
- 
-     end if
- 
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- 
-     ! compute chi2 for z=z1
- 
-     if (use_CROFT) then
- 
-        z=z2
-     
-     ! coefficient from h/Mpc to s/km
-        g2=omegam*(1.+z)**3+CMB%omk*(1.+z)**2+CMB%omv
-        coef = 100. * sqrt(g2) / (1.+z)
-     ! growth factor
-        omegam_z= omegam*(1.+z)**3/g2
-        omegav_z= CMB%omv/g2
-        D_ratio = omegam_z/(1.+z)/(exp(4./7.*log(omegam_z))-omegav_z &
-          +(1.+omegam_z/2.)*(1.+omegav_z/70.)) &
-          /omegam*(exp(4./7.*log(omegam))-CMB%omv &
-          +(1.+omegam/2.)*(1.+CMB%omv/70.))
- 
- 
-        do i=1, lya_points
-          
-          th = MatterPowerAt(Theory,lya_k(i)*coef) *coef**3 &
-                *(D_ratio)**2 &
-                *(1.+1.4*exp(0.6*log(omegam_z)))/2.4
- 
-          do ical=-ncal,ncal
-            acal = 1+ical*cal_sigma*dcal 
- 
-            dif2(ical) = dif2(ical) +  ((th-lya_P2(i)*0.93*acal)**2/ &
-                       (lya_dP2(i)*0.93*acal)**2)
-          end do
-  
-        end do
- 
-     end if
- 
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- 
-     do i=-ncal,ncal
-       acal = 1+i*cal_sigma*dcal
-       calweights(i) = exp(-(1-acal)**2/cal_sigma**2/2)
-     end do
- 
-     minchisq = minval(dif2) 
-     chisq = sum(exp(-(dif2-minchisq)/2)*calweights)/sum(calweights)
- 
-     if (chisq == 0) then
-      chisq = 2*LogZero
-     else
-      chisq =  -2*log(chisq) + minchisq
-     end if
- 
-     if (Feedback>1) write(*,*) 'Lyman-alpha chi-sq: ', chisq
- 
-     LSS_lyalike = chisq/2.
-    
-  end function LSS_lyalike
- 
- end module lya
--- 0 ----
diff -r -c -b -B -N cosmomc/source/Makefile cosmomc_sampler/source/Makefile
*** cosmomc/source/Makefile	2009-10-27 16:42:57.000000000 +0100
--- cosmomc_sampler/source/Makefile	2009-10-28 17:56:08.384509654 +0100
***************
*** 1,195 ****
! #You may need to edit the library paths for MKL for Intel
! #Beware of using optmizations that lose accuracy - may give errors when running
  
! ##Uncomment the next line to include dr7 LRG
! EXTDATA = 
! #EXTDATA = LRG
! 
! #set WMAP empty not to compile with WMAP
! WMAP = /home/aml1005/WMAP5/likelihood_v3
! 
! #Only needed for WMAP
! cfitsio = /usr/local/cfitsio/intel10/64/3.040
! 
! #GSL only needed for DR7 LRG
! GSLPATH = /home/aml1005/libs/gsl
! 
! IFLAG = -I
! INCLUDE=
! 
! #Intel MPI (assuming mpif77 set to point to ifort)
! #change -lmkl_ia32 to -lmkl_p3 for MKL versions earlier than 6 (6 needed for ifc 8+) 
! F90C     = mpif90
! FFLAGS = -O2 -ip -W0 -WB -openmp -fpp -DMPI -vec_report0
! LAPACKL = -L/usr/local/intel/mkl/9.1/lib/em64t -lmkl_lapack -lmkl_em64t -lguide -lpthread
! 
! #HPCF settings. Use Inteal 9 or 10.1+, not 10.0
! #F90C     = mpif90
! #FFLAGS = -O2 -Vaxlib -W0 -WB -openmp -fpp -DMPI -vec_report0
! #LAPACKL = -L/usr/local/Cluster-Apps/intel/mkl/10.2.2.025/lib/em64t -lmkl_lapack -lmkl -lguide -lpthread
! #GSLPATH = /usr/local/Cluster-Apps/gsl/1.9
! #cfitsio = /usr/local/Cluster-Users/cpac/cmb/2.1.0/cfitsio
! #INCLUDE=
! 
! #COSMOS: use "module load cosmolib" "module load latest" "module load gsl.stable"
! #use "runCosmomc" (globally installed) to run, defining required memory usage
! ifeq ($(COSMOHOST),cosmos)
! F90C = ifort
! FFLAGS = -openmp -O3 -w -fpp2 -DMPI
! LAPACKL = -mkl=sequential -lmkl_lapack -lmpi
! cfitsio = $(CFITSIO)
! WMAP = /home/cosmos/share-ia64/likelihood_v3
! GSLPATH = $(GSL_ROOT)
  endif
  
! #Intel fortran 8, check you have the latest update from the Intel web pages
! #See Makefile_intel for ifc 7.1 or lower (some versions have problems)
! #F90C     = ifort
! #FFLAGS = -O2 -Vaxlib -ip -W0 -WB -openmp -fpp
! #LAPACKL = -L/opt/intel/mkl61/lib/32 -lmkl_lapack -lmkl_ia32 -lguide -lpthread
! 
! #G95; make sure LAPACK and MPI libs also compiled with g95
! #F90C     = mpif90
! #FFLAGS = -O2 -DMPI
! #LAPACKL = /LAPACK/lapack_LINUX.a /LAPACK/blas_LINUX.a
! 
! #GFortran: if pre v4.3 add -D__GFORTRAN__
! #F90C     = gfortran
! #FFLAGS = -O2 -ffree-form -x f95-cpp-input 
! #LAPACKL = -Wl,-framework -Wl,accelerate
! 
! #SGI, -mp toggles multi-processor. Use -O2 if -Ofast gives problems.
! #Not various versions of the compiler are buggy giving erroneous seg faults with -mp.
! #Version 7.3 is OK, currently version 7.4 is bugged, as are some earlier versions.
! #F90C     = f90
! #LAPACKL = -lcomplib.sgimath
! #FFLAGS  = -Ofast -mp
! 
! #Digital/Compaq fortran, -omp toggles multi-processor
! #F90C    = f90
! #FFLAGS  = -omp -O4 -arch host -math_library fast -tune host -fpe1
! #LAPACKL  = -lcxml
! 
! #Absoft ProFortran, single processor, set -cpu:[type] for your local system 
! #F90C     = f95
! #FFLAGS = -O2 -s -cpu:athlon -lU77 -w -YEXT_NAMES="LCS" -YEXT_SFX="_" 
! #LAPACKL =  -llapack -lblas -lg2c 
! #IFLAG = -p
! 
! #NAGF95, single processor:
! #F90C     = f95
! #FFLAGS = -DNAGF95 -O3
! #LAPACKL = -llapack -lblas -lg2c
! 
! #PGF90
! #F90C = pgf90
! #FFLAGS = -O2 -DESCAPEBACKSLASH
! #LAPACKL = -llapack -lblas
! 
! 
! #Sun, single processor:
! #F90C     = f90
! #FFLAGS = -fast -ftrap=%none
! #LAPACKL = -lsunperf -lfsu
! #LAPACKL = -lsunperf -lfsu -lsocket -lm
! #IFLAG = -M
! 
! #Sun MPI
! #F90C = mpf90
! #FFLAGS =  -O4 -openmp -ftrap=%none -dalign -DMPI
! #LAPACKL = -lsunperf -lfsu -lmpi_mt
! #IFLAG = -M
! 
! #Sun parallel enterprise:
! #F90C     = f95
! #FFLAGS =  -O4 -xarch=native64 -openmp -ftrap=%none
! #LAPACKL = -lsunperf -lfsu
! #IFLAG = -M
! 
! 
! #IBM XL Fortran, multi-processor (run "module load lapack" then run "gmake")
! # See also http://cosmocoffee.info/viewtopic.php?t=326
! #F90C     = xlf90_r $(LAPACK)
! #FFLAGS  = -WF,-DIBMXL -qsmp=omp -qsuffix=f=f90:cpp=F90 -O3 -qstrict -qarch=pwr3 -qtune=pwr3
! #INCLUDE = -lessl
! #LAPACKL =
  
! PROPOSE = propose.o
! CLSFILE = CMB_Cls_simple.o
  
! #Can use params_H if you prefer more generic parameters
! PARAMETERIZATION = params_CMB.o
  
! F90FLAGS = -DMATRIX_SINGLE $(FFLAGS) $(IFLAG)../camb $(INCLUDE)
! LINKFLAGS = -L../camb -lcamb $(LAPACKL) 
  
- DISTFILES = utils.o ParamNames.o Matrix_utils.o settings.o GetDist.o
  
! OBJFILES= utils.o ParamNames.o Matrix_utils.o settings.o IO.o cmbtypes.o Planck_like.o \
! 	cmbdata.o WeakLen.o bao.o lrggettheory.o mpk.o supernovae.o HST.o SDSSLy-a-v3.o \
! 	$(CLSFILE) paramdef.o $(PROPOSE) $(PARAMETERIZATION) calclike.o \
! 	conjgrad_wrapper.o EstCovmat.o postprocess.o MCMC.o driver.o
  
  
! ifeq ($(EXTDATA),LRG)
! F90FLAGS += -DDR71RG
! OBJFILES += bsplinepk.o
! GSLINC = -I$(GSLPATH)/include
! LINKFLAGS += -L$(GSLPATH)/lib -lgsl -lgslcblas
! endif
  
! ifneq ($(WMAP),)
! F90FLAGS += $(IFLAG)$(cfitsio)/include $(IFLAG)$(WMAP)
! LINKFLAGS +=  -L$(cfitsio)/lib -L$(WMAP) -lcfitsio
! OBJFILES += $(WMAP)/read_archive_map.o \
! 	$(WMAP)/read_fits.o \
! 	$(WMAP)/WMAP_5yr_options.o \
! 	$(WMAP)/WMAP_5yr_util.o \
! 	$(WMAP)/WMAP_5yr_tt_pixlike.o \
! 	$(WMAP)/WMAP_5yr_teeebb_pixlike.o \
! 	$(WMAP)/WMAP_5yr_likelihood.o \
! 	$(WMAP)/WMAP_5yr_gibbs.o \
! 	$(WMAP)/WMAP_5yr_tt_beam_ptsrc_chisq.o \
! 	$(WMAP)/br_mod_dist.o 
! else
! F90FLAGS += -DNOWMAP
! endif
  
! default: cosmomc
  
! all : cosmomc getdist
  
! utils.o: ../camb/libcamb.a
! settings.o: utils.o
! cmbtypes.o: settings.o
! Planck_like.o: cmbtypes.o
! cmbdata.o: Planck_like.o $(WMAPOBJS)
! WeakLen.o: cmbtypes.o
! bao.o: cmbtypes.o
! mpk.o: cmbtypes.o lrggettheory.o
! HST.o: cmbtypes.o
! supernovae.o: cmbtypes.o
! SDSSLy-a-v3.o: cmbtypes.o
! $(CLSFILE): cmbtypes.o mpk.o HST.o bao.o IO.o
! paramdef.o: $(CLSFILE)
! $(PROPOSE): paramdef.o
! $(PARAMETERIZATION): paramdef.o
! calclike.o: $(PARAMETERIZATION)
! conjgrad_wrapper.o: calclike.o
! EstCovmat.o: conjgrad_wrapper.o
! postprocess.o: calclike.o
! MCMC.o: calclike.o
! driver.o: MCMC.o
  
! export FFLAGS
! export F90C
  
  .f.o:
  	f77 $(F90FLAGS) -c $<
  
- %.o: %.c
- 	$(CC) $(GSLINC) -c $*.c
- 
  %.o: %.f90
  	$(F90C) $(F90FLAGS) -c $*.f90
  
--- 1,70 ----
! # >>> DESIGNED FOR GMAKE <<<
  
! # Unified Systems makefile for GENEMC
! # Add FLAGS -DMPI for using MPI
! 
! ext=$(shell uname | cut -c1-3)
! 
! ifeq ($(ext),IRI)
! F90C= f90
! FFLAGS= -Ofast -mp -n32 -LANG:recursive=ON -lmpi -DMPI
! LAPACKL = -lcomplib.sgimath_mp
! INCLUDE = 
  endif
  
! ifeq ($(ext),Lin)
! F90C=gfortran
! FFLAGS= -O -fopenmp 
! #LAPACKL = -L/opt/intel/mkl/10.1.2.024/lib/em64t -lmkl -lmkl_lapack
! LAPACKL = -llapack
! INCLUDE = -I/usr/include 
! endif 
  
! ifeq ($(ext),OSF)
! F90C=f90
! FFLAGS= -omp -O -arch host -math_library fast -tune host -fpe1
! WMAPFLAGS= $(FFLAGS)
! LAPACKL  = -lcxml
! INCLUDE = 
! endif
  
! ifeq ($(ext),Sun)
! F90C=f90
! FFLAGS= -O4 -xarch=native64 -openmp -ftrap=%none
! WMAPFLAGS= $(FFLAGS)
! LAPACKL = -lsunperf -lfsu
! INCLUDE =
! endif
  
! ifeq ($(ext),AIX)
! F90C    = mpxlf90_r
! FFLAGS  = -O4 -WF,-DIBMXL,-DMPI -qstrict -qsmp=omp -qmaxmem=-1 -qsuffix=f=f90:cpp=F90
! LAPACKL = -lessl
! INCLUDE = 
! endif
  
  
! PROPOSE = propose.o
  
+ PARAMETERIZATION = params_EXT.o
  
! MCMCLIB = $(LAPACKL)
  
! F90FLAGS = -DMATRIX_SINGLE $(FFLAGS) $(INCLUDE)
  
! DISTFILES = utils.o ParamNames.o Matrix_utils.o settings.o GetDist.o
  
! OBJFILES= inifile.o utils.o ParamNames.o Matrix_utils.o  settings.o IO.o \
! 	paramdef.o wrapper.o $(PROPOSE) $(PARAMETERIZATION) calclike.o \
! 	conjgrad_wrapper.o EstCovmat.o postprocess.o MCMC.o driver.o
  
! default: genemc.$(ext)
  
! all : genemc.$(ext) getdist.$(ext)
  
  .f.o:
  	f77 $(F90FLAGS) -c $<
  
  %.o: %.f90
  	$(F90C) $(F90FLAGS) -c $*.f90
  
***************
*** 197,215 ****
  	$(F90C) $(F90FLAGS) -c $*.F90
  
  
! cosmomc: camb $(OBJFILES)
! 	$(F90C) -o ../cosmomc $(OBJFILES) $(LINKFLAGS) $(F90FLAGS)
  
! 
! clean: cleancosmomc
! 	rm -f ../camb/*.o ../camb/*.obj
! 
! cleancosmomc:
  	rm -f *.o *.mod *.d *.pc *.obj ../core 
  
! 
! getdist: camb $(DISTFILES)
! 	$(F90C) -o ../getdist $(DISTFILES) $(LINKFLAGS) $(F90FLAGS) 
! 
! camb:
! 	cd ../camb && $(MAKE) --file=Makefile_main libcamb.a
--- 72,82 ----
  	$(F90C) $(F90FLAGS) -c $*.F90
  
  
! genemc.$(ext): $(OBJFILES)
! 	$(F90C) -o ../$@ $(OBJFILES) $(MCMCLIB) $(F90FLAGS)
  
! clean:
  	rm -f *.o *.mod *.d *.pc *.obj ../core
  
! getdist.$(ext): $(DISTFILES)
! 	$(F90C) -o ../$@ $(DISTFILES) $(CLSLIB) $(F90FLAGS) 
diff -r -c -b -B -N cosmomc/source/MCMC.f90 cosmomc_sampler/source/MCMC.f90
*** cosmomc/source/MCMC.f90	2009-09-18 18:32:05.000000000 +0200
--- cosmomc_sampler/source/MCMC.f90	2009-10-28 17:29:14.528217970 +0100
***************
*** 8,13 ****
--- 8,14 ----
   use CalcLike
   use Random
   use propose
+  use wrapper
   use IO
   implicit none
  
diff -r -c -b -B -N cosmomc/source/mpk.f90 cosmomc_sampler/source/mpk.f90
*** cosmomc/source/mpk.f90	2009-10-23 10:48:04.000000000 +0200
--- cosmomc_sampler/source/mpk.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,1148 ****
- !Module storing observed matter power spectrum datasets, their points and window functions
- !and routines for computing the likelihood
- 
- !This code is based on that in cmbdata.f90 
- !and on Sam Leach's incorporation of Max Tegmark's SDSS code
- !
- !Originally SLB Sept 2004
- !AL April 2006: added covariance matrix support (following 2df 2005)
- !LV_06 : incorporation of LRG DR4 from Tegmark et al . astroph/0608632 
- !AL: modified LV SDSS to do Q and b^2 or b^2*Q marge internally as for 2df
- !BR09: added model LRG power spectrum.
- !AL Oct 20: switch to Ini_Read_xxx_File; fortran compatibility changes
- 
- 
- module LRGinfo
- use settings
- use cmbtypes
- use Precision
- use lrggettheory
- 
- !use CMB_Cls
- 
- implicit none
- 
- !! these are the LRG redshift subsample weights.
- real(dl), parameter :: w0 = 0.0d0, wNEAR = 0.395d0, wMID = 0.355d0, wFAR = 0.250d0
- 
- !in CAMB: 4=now (z=0), 3=NEAR, 2=MID, 1=FAR; opposite order in matter_power
- !! now generalized indices iz0lrg, izNEARlrg, izMIDlrg, izFARlrg
- real(dl), dimension(4) :: zeval, zweight, sigma2BAOfid, sigma2BAO
- 
- real(dl) om_val, ol_val, ok_check, wval  ! passed in from CMBparams CMB
- 
- ! power spectra evaluated at fiducial cosmological theory (WMAP5 recommended values)
- real, allocatable :: ratio_power_nw_nl_fid(:,:)
- !real,dimension(num_matter_power,matter_power_lnzsteps) :: ratio_power_nw_nl_fid
- !make allocatable to avoid compile-time range errors when matter_power_lnzsteps<4
- 
- contains
- 
- subroutine LRGinfo_init()
-   integer :: iopb, i, ios
-   real(dl) :: omegakdummy,omegavdummy,wdummy,getabstransferscalefiddummy
-   real(dl) :: kval, plin, psmooth, rationwhalofit
- 
-   !!BR09 only needed for LRGs, so only 4 redshifts no matter what matter_power_lnzsteps is
-   allocate(ratio_power_nw_nl_fid(num_matter_power,4))
- 
-   sigma2BAOfid(1) = 1.0e-5  !! don't do any smearing at z=0; this won't be used anyway.
-   sigma2BAOfid(2) = sigma2BAONEAR
-   sigma2BAOfid(3) = sigma2BAOMID
-   sigma2BAOfid(4) = sigma2BAOFAR
- 
-   zeval(1) = z0
-   zeval(2) = zNEAR
-   zeval(3) = zMID
-   zeval(4) = zFAR
- 
-   zweight(1) = w0
-   zweight(2) = wNEAR
-   zweight(3) = wMID
-   zweight(4) = wFAR
- 
-   !! first read in everything needed from the CAMB output files.
-   iopb = 0 !! check later if there was an error
- 
-   open(unit=tmp_file_unit,file=trim(DataDir)//'lrgdr7fiducialmodel_matterpowerzNEAR.dat',form='formatted',err=500, iostat=ios)
-   read (tmp_file_unit,*,iostat=iopb) getabstransferscalefiddummy, omegakdummy,omegavdummy,wdummy
-   do i = 1, num_matter_power
-     read (tmp_file_unit,*,iostat=iopb) kval, plin, psmooth, rationwhalofit
-     ratio_power_nw_nl_fid(i,2) = rationwhalofit
-   end do
-   close(tmp_file_unit)
- 
-   open(unit=tmp_file_unit,file=trim(DataDir)//'lrgdr7fiducialmodel_matterpowerzMID.dat',form='formatted',err=500, iostat=ios)
-   read (tmp_file_unit,*,iostat=iopb) getabstransferscalefiddummy,omegakdummy,omegavdummy,wdummy
-   do i = 1, num_matter_power
-     read (tmp_file_unit,*,iostat=iopb) kval, plin, psmooth, rationwhalofit
-     ratio_power_nw_nl_fid(i,3) = rationwhalofit
-   end do
-   close(tmp_file_unit)
- 
-   open(unit=tmp_file_unit,file=trim(DataDir)//'lrgdr7fiducialmodel_matterpowerzFAR.dat',form='formatted',err=500,iostat=ios)
-   read (tmp_file_unit,*,iostat=iopb) getabstransferscalefiddummy,omegakdummy,omegavdummy,wdummy
-   do i = 1, num_matter_power
-     read (tmp_file_unit,*,iostat=iopb) kval, plin, psmooth, rationwhalofit
-     ratio_power_nw_nl_fid(i,4) = rationwhalofit
-   end do
-   close(tmp_file_unit)
- 
- 500 if(ios .ne. 0) stop 'Unable to open file'
-   if(iopb .ne. 0) stop 'Error reading model or fiducial theory files.'
- end subroutine LRGinfo_init
- 
- ! HARD CODING OF POLYNOMIAL FITS TO NEAR, MID, FAR SUBSAMPLES.
- subroutine LRGtoICsmooth(k,fidpolys)
-   real(dl), intent(in) :: k
-   real(dl) :: fidNEAR, fidMID, fidFAR
-   real(dl), dimension(2:4), intent(out) :: fidpolys
- 
-   if(k < 0.194055d0) then !!this is where the two polynomials are equal
-     fidNEAR = (1.0d0 - 0.680886d0*k + 6.48151d0*k**2)
-   else
-     fidNEAR = (1.0d0 - 2.13627d0*k + 21.0537d0*k**2 - 50.1167d0*k**3 + 36.8155d0*k**4)*1.04482d0
-   end if
- 
-   if(k < 0.19431) then
-     fidMID = (1.0d0 - 0.530799d0*k + 6.31822d0*k**2)
-   else
-     fidMID = (1.0d0 - 1.97873d0*k + 20.8551d0*k**2 - 50.0376d0*k**3 + 36.4056d0*k**4)*1.04384
-   end if
- 
-   if(k < 0.19148) then
-     fidFAR = (1.0d0 - 0.475028d0*k + 6.69004d0*k**2)
-   else
-     fidFAR = (1.0d0 - 1.84891d0*k + 21.3479d0*k**2 - 52.4846d0*k**3 + 38.9541d0*k**4)*1.03753
-   end if
-   fidpolys(2) = fidNEAR
-   fidpolys(3) = fidMID
-   fidpolys(4) = fidFAR
- end subroutine LRGtoICsmooth
- 
- subroutine fill_LRGTheory(Theory, minkh, dlnkh)
-   Type(CosmoTheory) Theory
-   real, intent(in) :: minkh, dlnkh
-   real(dl) :: logmink, xi, kval, expval, psmear, nlrat
-   real(dl), dimension(2:4) :: fidpolys, holdval
- 
-   integer :: iz, ik, matterpowerindx
- 
-   do iz = 1, 4
-     sigma2BAO(iz) = sigma2BAOfid(iz)
-   end do
- 
-   logmink = log(minkh)
-   do ik=1,num_matter_power
-    xi = logmink + dlnkh*(ik-1)
-    kval = exp(xi)
-    Theory%finalLRGtheoryPk(ik) = 0.
-    do iz = 2,4
-     if(iz == 2) matterpowerindx = izNEARlrg
-     if(iz == 3) matterpowerindx = izMIDlrg
-     if(iz == 4) matterpowerindx = izFARlrg
-     expval = exp(-kval**2*sigma2BAO(iz)*0.5)
-     psmear = (Theory%matter_power(ik,matterpowerindx))*expval + (Theory%mpk_nw(ik,matterpowerindx))*(1.0-expval)
-     psmear = psmear*powerscaletoz0(iz)
-     nlrat = (Theory%mpkrat_nw_nl(ik,matterpowerindx))/(ratio_power_nw_nl_fid(ik,matterpowerindx))
-     call LRGtoICsmooth(kval,fidpolys)
-     holdval(iz) = zweight(iz)*psmear*nlrat*fidpolys(iz)
-     Theory%finalLRGtheoryPk(ik) = Theory%finalLRGtheoryPk(ik) + holdval(iz)
-    end do
- 
-   end do
- 
- end subroutine fill_LRGTheory
- 
- end module
- 
- module mpk
- use precision
- use settings
- use cmbtypes
- use LRGinfo
- implicit none
- 
-  Type mpkdataset
-     logical :: use_set
-     integer :: num_mpk_points_use ! total number of points used (ie. max-min+1)
-     integer :: num_mpk_kbands_use ! total number of kbands used (ie. max-min+1)
-     character(LEN=20) :: name
-     real, pointer, dimension(:,:) :: N_inv
-     real, pointer, dimension(:,:) :: mpk_W, mpk_invcov
-     real, pointer, dimension(:) :: mpk_P, mpk_sdev, mpk_k
-     real, pointer, dimension(:) :: mpk_zerowindowfxn
-     real, pointer, dimension(:) :: mpk_zerowindowfxnsubtractdat
-     real :: mpk_zerowindowfxnsubdatnorm !!the 0th entry in windowfxnsubtract file
-     logical :: use_scaling !as SDSS_lrgDR3
-    !for Q and A see e.g. astro-ph/0501174, astro-ph/0604335
-     logical :: Q_marge, Q_flat
-     real :: Q_mid, Q_sigma, Ag
-    end Type mpkdataset
- 
-  integer :: num_mpk_datasets = 0
-  Type(mpkdataset) mpkdatasets(10)
- 
-  !Note all units are in k/h here
-  
-   integer, parameter :: mpk_d = kind(1.d0)
-  
-   logical :: use_mpk = .false.
-   
-   ! constants describing the allowed a1,a2 regions.
-   ! must check the functions below before changing these, because the shape of the space may change!
- 
-   integer, parameter :: wp = selected_real_kind(11,99)
- 
-   !!these are the 'nonconservative' nuisance parameter bounds
-   !!real(dl), parameter :: k1 = 0.1d0, k2 = 0.2d0, s1 = 0.02d0, s2 = 0.05d0, a1maxval = 0.5741d0
-   real(dl), parameter :: k1 = 0.1d0, k2 = 0.2d0, s1 = 0.04d0, s2 = 0.10d0, a1maxval = 1.1482d0
-   integer, parameter :: nptsa1 = 41, nptsa2 = 41, nptstot = 325  
-   !! but total number of points to evaluate is much smaller than 41**2 because lots of the space 
-   !is not allowed by the s1,s2 constraints.
-  
-    ! only want to compute these once. 
-    real(dl), dimension(nptstot) :: a1list, a2list
- 
- contains 
- 
-   subroutine mpk_SetTransferRedshifts(redshifts)
-    real, intent(inout) :: redshifts(*)
-    !input is default log z spacing; can change here; check for consistency with other (e.g. lya)
-          
-    !Note internal ordering in CAMB is the opposite to that used in cosmomc transfer arrays (as here)
-    !first index here must be redshift zero
-    
-       if(use_dr7lrg .and. matter_power_lnzsteps < 4) &
-        call MpiStop('For LRGs matter_power_lnzsteps should be set to at least 4 (hardcoded in cmbtypes)')
- 
-        if (matter_power_lnzsteps==1 .or. .not. use_dr7lrg) return
- 
-        !! assigning indices to LRG NEAR, MID, FAR.  If you want to reorder redshifts, just change here.
-        iz0lrg = 1  !! we use the z=0 output to normalize things; this is already assumed index 1 elsewhere 
-                     !(like in calculation of sigma8).
-        izNEARlrg = 2
-        izMIDlrg = 3
-        izFARlrg = 4
-        redshifts(izNEARlrg) = zNEAR
-        redshifts(izMIDlrg) = zMID
-        redshifts(izFARlrg) = zFAR  
-        if(iz0lrg /= 1) then
-           redshifts(iz0lrg) = 0.0d0
-        else
-           if(redshifts(1) > 0.001) call MpiStop('redshifts(1) should be at z=0!')
-        endif
-          
-   end subroutine mpk_SetTransferRedshifts
-  
-   subroutine ReadmpkDataset(gname)   
-     use MatrixUtils
-     character(LEN=*), intent(IN) :: gname
-     character(LEN=Ini_max_string_len) :: kbands_file, measurements_file, windows_file, cov_file
-     !! added for the LRG window function subtraction
-     character(LEN=Ini_max_string_len) :: zerowindowfxn_file, zerowindowfxnsubtractdat_file
- 
-     Type (mpkdataset) :: mset
- 
-     integer i,iopb
-     real keff,klo,khi,beff
-     integer :: num_mpk_points_full ! actual number of bandpowers in the infile
-     integer :: num_mpk_kbands_full ! actual number of k positions " in the infile
-     integer :: max_mpk_points_use ! in case you don't want the smallest scale modes (eg. sdss)
-     integer :: min_mpk_points_use ! in case you don't want the largest scale modes
-     integer :: max_mpk_kbands_use ! in case you don't want to calc P(k) on the smallest scales (will truncate P(k) to zero here!)
-     integer :: min_mpk_kbands_use ! in case you don't want to calc P(k) on the largest scales (will truncate P(k) to zero here!)
-     real, dimension(:,:), allocatable :: mpk_Wfull, mpk_covfull
-     real, dimension(:), allocatable :: mpk_kfull, mpk_fiducial
- 
-     real, dimension(:), allocatable :: mpk_zerowindowfxnfull
-     real, dimension(:), allocatable :: mpk_zerowindowfxnsubfull
- 
-     character(80) :: dummychar
-     logical bad
-     Type(TIniFile) :: Ini
-     integer file_unit
-     
-  
-     num_mpk_datasets = num_mpk_datasets + 1
-     if (num_mpk_datasets > 10) stop 'too many datasets'
-     file_unit = new_file_unit()
-     call Ini_Open_File(Ini, gname, file_unit, bad, .false.)
-     if (bad) then
-       write (*,*)  'Error opening dataset file '//trim(gname)
-       stop
-     end if
- 
-     mset%name = Ini_Read_String_File(Ini,'name') 
-     Ini_fail_on_not_found = .false.
-     mset%use_set =.true.
-     if (Feedback > 0) write (*,*) 'reading: '//trim(mset%name)
-     num_mpk_points_full = Ini_Read_Int_File(Ini,'num_mpk_points_full',0)
-     if (num_mpk_points_full.eq.0) write(*,*) ' ERROR: parameter num_mpk_points_full not set'
-     num_mpk_kbands_full = Ini_Read_Int_File(Ini,'num_mpk_kbands_full',0)
-     if (num_mpk_kbands_full.eq.0) write(*,*) ' ERROR: parameter num_mpk_kbands_full not set'
-     min_mpk_points_use = Ini_Read_Int_File(Ini,'min_mpk_points_use',1)
-     min_mpk_kbands_use = Ini_Read_Int_File(Ini,'min_mpk_kbands_use',1)
-     max_mpk_points_use = Ini_Read_Int_File(Ini,'max_mpk_points_use',num_mpk_points_full)
-     max_mpk_kbands_use = Ini_Read_Int_File(Ini,'max_mpk_kbands_use',num_mpk_kbands_full)
-     mset%num_mpk_points_use = max_mpk_points_use - min_mpk_points_use +1
-     mset%num_mpk_kbands_use = max_mpk_kbands_use - min_mpk_kbands_use +1
- 
-     allocate(mpk_Wfull(num_mpk_points_full,num_mpk_kbands_full))
-     allocate(mpk_kfull(num_mpk_kbands_full))
-     allocate(mset%mpk_P(mset%num_mpk_points_use))
-     allocate(mset%mpk_sdev(mset%num_mpk_points_use))  ! will need to replace with the covmat
-     allocate(mset%mpk_k(mset%num_mpk_kbands_use))
-     allocate(mset%mpk_W(mset%num_mpk_points_use,mset%num_mpk_kbands_use))
-     allocate(mset%mpk_zerowindowfxn(mset%num_mpk_kbands_use))
-     allocate(mset%mpk_zerowindowfxnsubtractdat(mset%num_mpk_points_use))
-     allocate(mpk_fiducial(mset%num_mpk_points_use))
-     allocate(mpk_zerowindowfxnsubfull(num_mpk_points_full+1)) 
-       !!need to add 1 to get the normalization held in the first (really zeroth) entry
-     allocate(mpk_zerowindowfxnfull(num_mpk_kbands_full))
- 
-     kbands_file  = ReadIniFileName(Ini,'kbands_file')
-     call ReadVector(kbands_file,mpk_kfull,num_mpk_kbands_full)
-     mset%mpk_k(1:mset%num_mpk_kbands_use)=mpk_kfull(min_mpk_kbands_use:max_mpk_kbands_use) 
-     if (Feedback > 1) then 
-        write(*,*) 'reading: ',mset%name,' data'
-        write(*,*) 'Using kbands windows between',mset%mpk_k(1),' < k/h < ',mset%mpk_k(mset%num_mpk_kbands_use)      
-     endif
-     if  (mset%mpk_k(1) < matter_power_minkh) then
-        write (*,*) 'WARNING: k_min in '//trim(mset%name)//'less than setting in cmbtypes.f90'
-        write (*,*) 'all k<matter_power_minkh will be set to matter_power_minkh' 
-     end if
- 
-     measurements_file  = ReadIniFileName(Ini,'measurements_file')
-     call OpenTxtFile(measurements_file, tmp_file_unit)
-     mset%mpk_P=0.
-     read (tmp_file_unit,*) dummychar
-     read (tmp_file_unit,*) dummychar
-     do i= 1, (min_mpk_points_use-1)
-        read (tmp_file_unit,*, iostat=iopb) keff,klo,khi,beff,beff,beff
-     end do
-     if (Feedback > 1 .and. min_mpk_points_use>1) write(*,*) 'Not using bands with keff=  ',keff,' or below'
-     do i =1, mset%num_mpk_points_use
-        read (tmp_file_unit,*, iostat=iopb) keff,klo,khi,mset%mpk_P(i),mset%mpk_sdev(i),mpk_fiducial(i)
-     end do
-     close(tmp_file_unit) 
-     if (Feedback > 1) write(*,*) 'bands truncated at keff=  ',keff
-     
-     windows_file  = ReadIniFileName(Ini,'windows_file')
-     if (windows_file.eq.'') write(*,*) 'ERROR: mpk windows_file not specified'
-     call ReadMatrix(windows_file,mpk_Wfull,num_mpk_points_full,num_mpk_kbands_full)
-     mset%mpk_W(1:mset%num_mpk_points_use,1:mset%num_mpk_kbands_use)= &
-        mpk_Wfull(min_mpk_points_use:max_mpk_points_use,min_mpk_kbands_use:max_mpk_kbands_use)
-     
-  
-     if (mset%name == 'lrg_2009') then
- #ifndef DR71RG
-         call MpiStop('mpk: edit makefile to have "EXTDATA = LRG" to inlude LRGs')
- #else
-         use_dr7lrg = .true.
-         zerowindowfxn_file  = ReadIniFileName(Ini,'zerowindowfxn_file')
-     
-         print *, 'trying to read this many points', num_mpk_kbands_full
-         if (zerowindowfxn_file.eq.'') write(*,*) 'ERROR: mpk zerowindowfxn_file not specified'
-         call ReadVector(zerowindowfxn_file,mpk_zerowindowfxnfull,num_mpk_kbands_full)
-         mset%mpk_zerowindowfxn(1:mset%num_mpk_kbands_use) = mpk_zerowindowfxnfull(min_mpk_kbands_use:max_mpk_kbands_use)
-         zerowindowfxnsubtractdat_file  = ReadIniFileName(Ini,'zerowindowfxnsubtractdat_file')
-         if (zerowindowfxnsubtractdat_file.eq.'') write(*,*) 'ERROR: mpk zerowindowfxnsubtractdat_file not specified'
-         call ReadVector(zerowindowfxnsubtractdat_file,mpk_zerowindowfxnsubfull,num_mpk_points_full+1)
-         mset%mpk_zerowindowfxnsubtractdat(1:mset%num_mpk_points_use) = &
-          mpk_zerowindowfxnsubfull(min_mpk_points_use+1:max_mpk_points_use+1)
-         mset%mpk_zerowindowfxnsubdatnorm = mpk_zerowindowfxnsubfull(1)
- #endif
-     end if
- 
-     cov_file  = ReadIniFileName(Ini,'cov_file')
-     if (cov_file /= '') then
-      allocate(mpk_covfull(num_mpk_points_full,num_mpk_points_full))
-      call ReadMatrix(cov_file,mpk_covfull,num_mpk_points_full,num_mpk_points_full)
-      allocate(mset%mpk_invcov(mset%num_mpk_points_use,mset%num_mpk_points_use))
-      mset%mpk_invcov=  mpk_covfull(min_mpk_points_use:max_mpk_points_use,min_mpk_points_use:max_mpk_points_use)
-      call Matrix_Inverse(mset%mpk_invcov)
-      deallocate(mpk_covfull)
-     else
-      nullify(mset%mpk_invcov)
-     end if
- 
-     mset%use_scaling = Ini_Read_Logical_File(Ini,'use_scaling',.false.)
- 
-     mset%Q_marge = Ini_Read_Logical_File(Ini,'Q_marge',.false.)
-     if (mset%Q_marge) then
-      mset%Q_flat = Ini_Read_Logical_File(Ini,'Q_flat',.false.)
-      if (.not. mset%Q_flat) then
-       !gaussian prior on Q
-       mset%Q_mid = Ini_Read_Real_File(Ini,'Q_mid')
-       mset%Q_sigma = Ini_Read_Real_File(Ini,'Q_sigma')
-      end if
-      mset%Ag = Ini_Read_Real_File(Ini,'Ag', 1.4)
-     end if 
-     if (iopb.ne.0) then
-        stop 'Error reading mpk file'
-     endif
-  
-    call Ini_Close_File(Ini)
-    call ClearFileUnit(file_unit)
-    
-    deallocate(mpk_Wfull, mpk_kfull,mpk_fiducial)
- 
-    mpkdatasets(num_mpk_datasets) = mset
-  
-   if (mset%name == 'lrg_2009') call LSS_LRG_mpklike_init()
- 
-   end subroutine ReadmpkDataset
- 
-  
-   function LSS_mpklike(Theory,mset,CMB) result(LnLike) ! LV_06 added CMB here
-    Type (mpkdataset) :: mset
-    Type (CosmoTheory) Theory
-    Type(CMBparams) CMB     !LV_06 added for LRGDR4
-    real LnLike
-    real, dimension(:), allocatable :: mpk_Pth, mpk_k2,mpk_lin,k_scaled !LV_06 added for LRGDR4
-    real, dimension(:), allocatable :: w
-    real, dimension(:), allocatable :: mpk_WPth, mpk_WPth_k2
-    real :: covdat(mset%num_mpk_points_use), covth(mset%num_mpk_points_use),  covth_k2(mset%num_mpk_points_use)
-    real :: normV, Q, minchisq
-    real :: a_scl  !LV_06 added for LRGDR4
-    integer :: i, iQ
-    logical :: do_marge
-    integer, parameter :: nQ=6
-    real :: tmp, dQ = 0.4
-    real chisq(-nQ:nQ)
-    real calweights(-nQ:nQ)
-    real vec2(2),Mat(2,2)
-    
-    allocate(mpk_lin(mset%num_mpk_kbands_use) ,mpk_Pth(mset%num_mpk_kbands_use))
-    allocate(mpk_WPth(mset%num_mpk_points_use))
-    allocate(k_scaled(mset%num_mpk_kbands_use))!LV_06 added for LRGDR4
-    allocate(w(mset%num_mpk_points_use))
- 
-    chisq = 0
- 
-    if (.not. mset%use_set) then
-       LnLike = 0
-       return
-    end if
- 
-    ! won't actually want to do this multiple times for multiple galaxy pk data sets?..
- 
-    IF(mset%use_scaling) then   
-       call compute_scaling_factor(dble(CMB%omk),dble(CMB%omv),dble(CMB%w),a_scl)      
-    else
-      a_scl = 1
-    end if
-       
- 
-    do i=1, mset%num_mpk_kbands_use 
-      !Errors from using matter_power_minkh at lower end should be negligible
-          k_scaled(i)=max(matter_power_minkh,a_scl*mset%mpk_k(i))
-          mpk_lin(i)=MatterPowerAt(Theory,k_scaled(i))/a_scl**3
-    end do
-       
-       
-     do_marge = mset%Q_Marge
-     if (do_marge .and. mset%Q_flat) then
-         !Marginalize analytically with flat prior on b^2 and b^2*Q
-         !as recommended by Max Tegmark for SDSS
-           allocate(mpk_k2(mset%num_mpk_kbands_use))
-           allocate(mpk_WPth_k2(mset%num_mpk_points_use))
-  
-           mpk_Pth=mpk_lin/(1+mset%Ag*k_scaled)
-           mpk_k2=mpk_Pth*k_scaled**2
-           mpk_WPth = matmul(mset%mpk_W,mpk_Pth)
-           mpk_WPth_k2 = matmul(mset%mpk_W,mpk_k2)
- 
-           if (associated(mset%mpk_invcov)) then
-             covdat = matmul(mset%mpk_invcov,mset%mpk_P)
-             covth = matmul(mset%mpk_invcov,mpk_WPth)
-             covth_k2 = matmul(mset%mpk_invcov,mpk_WPth_k2)
-           else
-             w=1/(mset%mpk_sdev**2)
-             covdat = mset%mpk_P*w
-             covth = mpk_WPth*w
-             covth_k2 = mpk_WPth_k2*w     
-           end if
-            
-           Mat(1,1) = sum(covth*mpk_WPth)
-           Mat(2,2) = sum(covth_k2*mpk_WPth_k2)
-           Mat(1,2) = sum(covth*mpk_WPth_k2)
-           Mat(2,1) = Mat(1,2)
-           LnLike = log( Mat(1,1)*Mat(2,2)-Mat(1,2)**2)
-           call inv_mat22(Mat)
-           vec2(1) = sum(covdat*mpk_WPth)
-           vec2(2) = sum(covdat*mpk_WPth_k2)
-           LnLike = (sum(mset%mpk_P*covdat) - sum(vec2*matmul(Mat,vec2)) + LnLike ) /2
- 
-           deallocate(mpk_k2,mpk_WPth_k2)      
-     else
- 
-       if (mset%Q_sigma==0) do_marge = .false.
-       
-       do iQ=-nQ,nQ
-          Q = mset%Q_mid +iQ*mset%Q_sigma*dQ 
-          
-          if (mset%Q_marge) then
-             mpk_Pth=mpk_lin*(1+Q*k_scaled**2)/(1+mset%Ag*k_scaled)
-          else 
-             mpk_Pth = mpk_lin
-          end if
-          
-          mpk_WPth = matmul(mset%mpk_W,mpk_Pth)
-          
-          !with analytic marginalization over normalization nuisance (flat prior on b^2)
-          !See appendix F of cosmomc paper
-          
-          if (associated(mset%mpk_invcov)) then
-             covdat = matmul(mset%mpk_invcov,mset%mpk_P)
-             covth = matmul(mset%mpk_invcov,mpk_WPth)
-             normV = sum(mpk_WPth*covth)
-             chisq(iQ) = sum(mset%mpk_P*covdat)  - sum(mpk_WPth*covdat)**2/normV  + log(normV)  
-             
-          else
-       
-             !with analytic marginalization over normalization nuisance (flat prior on b^2)
-             w=1/(mset%mpk_sdev**2)
-             normV = sum(mpk_WPth*mpk_WPth*w)
-             tmp=sum(mpk_WPth*mset%mpk_P*w)/normV ! avoid subtracting one large number from another
-             chisq(iQ) = sum(mset%mpk_P*(mset%mpk_P - mpk_WPth*tmp)*w)  + log(normV)
-          end if
-          
-          if (do_marge) then
-             calweights(iQ) = exp(-(iQ*dQ)**2/2)
-          else 
-             LnLike = chisq(iQ)/2
-             exit
-          end if
-    
-       end do
-       
-       !without analytic marginalization
-       !! chisq = sum((mset%mpk_P(:) - mpk_WPth(:))**2*w) ! uncommented for debugging purposes
-       
-       if (do_marge) then
-          minchisq=minval(chisq)
-          LnLike = sum(exp(-(chisq-minchisq)/2)*calweights)/sum(calweights)
-          if (LnLike == 0) then
-             LnLike = LogZero
-          else
-             LnLike =  -log(LnLike) + minchisq/2
-          end if
-       end if
- 
-    end if !not analytic over Q
-       
-    if (Feedback>1) write(*,*) 'mpk chi-sq:', LnLike*2
-    
-    if (LnLike > 1e8) then
-       write(*,*) 'Chisq is huge, maybe there is a problem? chisq=',chisq
-    end if
-    
-    deallocate(mpk_Pth,mpk_lin)
-    deallocate(mpk_WPth,k_scaled,w)
-    
-  end function LSS_mpklike
- 
- 
-  function LSSLnLike(CMB, Theory)
-    Type (CMBParams) CMB
-    Type (CosmoTheory) Theory
-    real LSSLnLike
-    integer i
-    real tot(num_mpk_datasets)
- 
-   do i=1, num_mpk_datasets
-      if (mpkdatasets(i)%name == 'twodf') then
-         stop 'twodf no longer supported - use data/2df_2005.dataset'
-      else if (mpkdatasets(i)%name == 'lrg_2009') then
-         tot(i) = LSS_LRG_mpklike(Theory,mpkdatasets(i),CMB)
-      else
-       tot(i) = LSS_mpklike(Theory,mpkdatasets(i),CMB) !LV_06 added CMB here
-      end if
-   end do
-   LSSLnLike = SUM(tot) 
-   
-  end function LSSLnLike
- 
-  subroutine inv_mat22(M)
-     real M(2,2), Minv(2,2), det
- 
-     det = M(1,1)*M(2,2)-M(1,2)*M(2,1)
-     Minv(1,1)=M(2,2)
-     Minv(2,2) = M(1,1)
-     Minv(1,2) = - M(2,1)
-     Minv(2,1) = - M(1,2)
-     M = Minv/det
- 
-  end subroutine inv_mat22
- 
- !-----------------------------------------------------------------------------
- !LV added to include lrg DR4
- 
- subroutine compute_scaling_factor(Ok,Ol,w,a)
-   ! a = dV for z=0.35 relative to its value for flat Om=0.25 model.
-   ! This is the factor by which the P(k) measurement would shift 
-   ! sideways relative to what we got for this fiducial flat model.
-   ! * a = (a_angular**2 * a_radial)**(1/3)
-   ! * a_angular = comoving distance to z=0.35 in Mpc/h relative to its value for flat Om=0.25 model
-   !     dA = (c/H)*eta = (2997.92458 Mpc/h)*eta, so we care only about 
-   !     eta scaling, not h scaling.
-   !     For flat w=-1 models, a ~ (Om/0.25)**(-0.065)
-   !     For the LRG mean redshift z=0.35, the power law fit 
-   !    dA(z,Om= 0.3253 (Om/0.25)^{-0.065}c H_0^{-1} is quite good within 
-   !    our range of interest,
-   !     accurate to within about 0.1% for 0.2<Om<0.3.
-   ! * a_radial = 1/H(z) relative to its value for flat Om=0.25 model
-   implicit none
-   real(mpk_d) Or, Om, Ok, Ol, w, Ok0, Om0, Ol0, w0, z, eta, eta0, Hrelinv, Hrelinv0, tmp
-   real(mpk_d) a_radial, a_angular
-   real a
-   !Or= 0.0000415996*(T_0/2.726)**4 / h**2
-   Or= 0! Radiation density totally negligible at  z < 0.35
-   Om= 1-Ok-Ol-Or
-   !!!z  = 0.35  !!edited by Beth 21-11-08: change to zeff of Will's LRG sample.
-   z = zeffDR7
-   Hrelinv= 1/sqrt(Ol*(1+z)**(3*(1+w)) + Ok*(1+z)**2 + Om*(1+z)**3 + Or*(1+z)**4)
- !  write(*,*) Ok,Ol,w  
- call compute_z_eta(Or,Ok,Ol,w,z,eta)
-   tmp = sqrt(abs(Ok))
-   if (Ok.lt.-1.d-6) eta = sin(tmp*eta)/tmp
-   if (Ok.gt.1d-6)   eta = (exp(tmp*eta)-exp(-tmp*eta))/(2*tmp) ! sinh(tmp*eta)/tmp
-   Ok0= 0
-   Ol0= 0.75
-   w0= -1
-   Om0= 1-Ok0-Ol0-Or
-   call compute_z_eta(Or,Ok0,Ol0,w0,z,eta0)
-   Hrelinv0= 1/sqrt(Ol0*(1+z)**(3*(1+w0)) + Ok0*(1+z)**2 + Om0*(1+z)**3 + Or*(1+z)**4)
-   !a_angular = (Om/0.25)**(-0.065) * (-w*Otot)**0.14 ! Approximation based on Taylor expansion
-   a_angular = eta/eta0
-   a_radial= Hrelinv/Hrelinv0
-   a=  (a_angular**2 * a_radial)**(1/3.d0)
-   !write(*,'(9f10.5)') Ok,Ol,w,a,a_radial,a_angular,(Om/0.25)**(-0.065) * (-w*(1-Ok))**0.14
-   !write(*,'(9f10.5)') Ok,Ol,w,a,a_radial**(2/3.d0),a_angular**(4/3.d0),((Om/0.25)**(-0.065) * (-w*(1-Ok))**0.14)**(4/3.d0)
-   !!! BR09 -- in previous version, scale factor is applied in the wrong direction!  So take a = 1/a to fix it.
-   a = 1.0/a
- end subroutine compute_scaling_factor
- 
- subroutine eta_demo
-   implicit none
-   real(mpk_d) Or, Ok, Ol, w, h, z, eta
-   h  = 0.7
-   Ok = 0
-   Ol = 0.7
-   Or = 0.0000416/h**2 
-   w  = -1
-   z  = 1090
-   call compute_z_eta(Or,Ok,Ol,w,z,eta)
- !  print *,'eta.............',eta
- !  print *,'dlss in Gpc.....',(2.99792458/h)*eta
- end subroutine eta_demo
- 
- !INTERFACE
- logical function nobigbang2(Ok,Ol,w)
-   ! Test if we're in the forbidden zone where the integrand blows up
-   ! (where's H^2 < 0 for some a between 0 and 1).
-   ! The function f(a) = Omega_m + Omega_k*a + Omega_l*a**(-3*w)
-   ! can have at most one local minimum, at (Ok/(3*w*Ol))**(-1/(1+3*w)), 
-   ! so simply check if f(a)<0 there or at the endpoints a=0, a=1.
-   ! g(0) = Omega_m - Omega_l*a**(-3*w) < 0 if w > 0 & Omega_k > 1
-   !                                     or if w = 0 & Omega_l < 1       
-   ! g(1) = Omega_m + Omega_k + Omega_l = 1 > 0
-   implicit none
-   real(mpk_d) Ok, Ol, w, Om, tmp, a, epsilon
-   integer failure
-   failure = 0
-   epsilon = 0
-   !epsilon = 0.04  ! Numerical integration fails even before H^2 goes negative.
-   Om = 1.d0 - Ok - Ol
-   if (w*Ol.ne.0) then
-      tmp = Ok/(3*w*Ol)
-      if ((tmp.gt.0).and.(1+3*w.ne.0)) then ! f'(0)=0 for some a>0
-         a = tmp**(-1/(1+3*w))
-         if (a.lt.1) then
-            if (Om + Ok*a + Ol*a**(-3*w).lt.epsilon) failure = 1
-         end if
-      end if
-   end if
-   if ((w.eq.0).and.(Ok.gt.1)) failure = 2
-   if ((w.gt.0).and.(Ol.lt.0)) failure = 3
-   nobigbang2 = (failure.gt.0)
-   if (failure.gt.0) print *,'Big Bang failure mode ',failure
-   return
- end function nobigbang2
- !END INTERFACE
- 
- real(mpk_d) function eta_integrand(a)
-   implicit none
-   real(mpk_d) Or, Ok, Ox, w
-   common/eta/Or, Ok, Ox, w
-   real(mpk_d) a, Om
-   ! eta = int (H0/H)dz = int (H0/H)(1+z)dln(1+z) = int (H0/H)/a dlna = int (H0/H)/a^2 da = 
-   ! Integrand = (H0/H)/a^2
-   ! (H/H0)**2 = Ox*a**(-3*(1+w)) + Ok/a**2 + Om/a**3 + Or/a**4 
-   if (a.eq.0.d0) then 
-      eta_integrand = 0.d0
-   else
-      Om = 1.d0 - Or - Ok - Ox
-      eta_integrand = 1.d0/sqrt(Ox*a**(1-3*w) + Ok*a**2 + Om*a + Or)
-   end if
-   return
- end function eta_integrand
- 
- subroutine eta_z_integral(Omega_r,Omega_k,Omega_x,w_eos,z,eta)
-   ! Computes eta as a function
-   ! of the curvature Omega_k, the dark energy density Omega_x
-   ! and its equation of state w.
-   implicit none
-   real(mpk_d) Or, Ok, Ox, w
-   common/eta/Or, Ok, Ox, w
-   real(mpk_d) Omega_r, Omega_k,Omega_x,w_eos, z, eta, epsabs, epsrel, amin, amax!, eta_integrand
-   Or = Omega_r
-   Ok = Omega_k
-   Ox = Omega_x
-   w  = w_eos
-   epsabs  = 0
-   epsrel  = 1.d-10
-   amin= 1/(1+z)
-   amax= 1
-   call qromb2(eta_integrand,amin,amax,epsabs,epsrel,eta)
-   return
- end subroutine eta_z_integral
- 
- subroutine compute_z_eta(Or,Ok,Ox,w,z,eta)
-   ! Computes the conformal distance eta(z)
-   implicit none
-   real(mpk_d) Or, Ok, Ox, w, z, eta
- !  logical nobigbang2
-   if (nobigbang2(Ok,Ox,w)) then
-      print *,'No big bang, so eta undefined if z>zmax.'
-      eta = 99 
-   else
-      call eta_z_integral(Or,Ok,Ox,w,z,eta) 
-      ! print *,'Or, Ok, Ox, w, z, H_0 t_0...',Or, Ok, Ox, w, eta
-   end if
-   return
- end subroutine compute_z_eta
- 
- 
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !!!! num rec routines
- !!!!!!!!!!!!!!!!!!!!!!!!!!
- SUBROUTINE qromb2(func,a,b,epsabs,epsrel,ss)
- ! The numerical recipes routine, but modified so that is decides
- ! it's done when either the relative OR the absolute accuracy has been attained.
- ! The old version used relative errors only, so it always failed when
- ! when the integrand was near zero.
- ! epsabs = epsrel = 1e-6 are canonical choices.
-   INTEGER JMAX,JMAXP,K,KM
-   real(mpk_d) a,b,func,ss,epsabs,epsrel
-   EXTERNAL func
-   PARAMETER (JMAX=20, JMAXP=JMAX+1, K=5, KM=K-1)
-                                 !    USES polint,trapzd
-   INTEGER j
-   real(mpk_d) dss,h(JMAXP),s(JMAXP)
-   h(1)=1.d0
-   do j=1,JMAX
-      call trapzd(func,a,b,s(j),j)
-      if (j.ge.K) then
-         call polint(h(j-KM),s(j-KM),K,0.d0,ss,dss)
-         if (abs(dss).le.epsrel*abs(ss)) return
-         if (abs(dss).le.epsabs) return
-      endif
-      s(j+1)=s(j)
-      h(j+1)=0.25d0*h(j)
-   ENDDO
-   print *,'Too many steps in qromb'
-       
-   RETURN 
- END SUBROUTINE qromb2
-   
- SUBROUTINE polint(xa,ya,n,x,y,dy) ! From Numerical Recipes
-   INTEGER n,NMAX
-   real(mpk_d) dy,x,y,xa(n),ya(n)
-   PARAMETER (NMAX=10)
-   INTEGER i,m,ns
-   real(mpk_d) den,dif,dift,ho,hp,w,c(NMAX),d(NMAX)
-   ns=1
-   dif=abs(x-xa(1))
-   do  i=1,n
-      dift=abs(x-xa(i))
-      if (dift.lt.dif) then
-         ns=i
-         dif=dift
-      endif
-      c(i)=ya(i)
-      d(i)=ya(i)
-   enddo
-   y=ya(ns)
-   ns=ns-1
-   do  m=1,n-1
-      do  i=1,n-m
-         ho=xa(i)-x
-         hp=xa(i+m)-x
-         w=c(i+1)-d(i)
-         den=ho-hp
-         if(den.eq.0.) then
-            print*, 'failure in polint'
-            stop
-         endif
-         den=w/den
-         d(i)=hp*den
-         c(i)=ho*den
-      enddo
-      if (2*ns.lt.n-m)then
-         dy=c(ns+1)
-      else
-         dy=d(ns)
-         ns=ns-1
-      endif
-      y=y+dy
-   enddo
-   return
- END SUBROUTINE polint
-       
- SUBROUTINE trapzd(func,a,b,s,n) ! From Numerical Recipes
-   INTEGER n
-   real(mpk_d) a,b,s,func
-   EXTERNAL func
-   INTEGER it,j
-   real(mpk_d) del,sum,tnm,x
-   if (n.eq.1) then
-      s=0.5*(b-a)*(func(a)+func(b))
-   else
-      it=2**(n-2)
-      tnm=it
-      del=(b-a)/tnm
-      x=a+0.5*del
-      sum=0.
-      do  j=1,it
-         sum=sum+func(x)
-         x=x+del
-      enddo
-      s=0.5*(s+(b-a)*sum/tnm)
-   endif
-   return
- END SUBROUTINE trapzd
-             
- 
- 
- !! added by Beth Reid for LRG P(k) analysis
- 
-   function a2maxpos(a1val) result(a2max)
-     real(dl), intent(in) :: a1val
-     real(dl) a2max
-     a2max = -1.0d0
-     if (a1val <= min(s1/k1,s2/k2)) then
-       a2max = min(s1/k1**2 - a1val/k1, s2/k2**2 - a1val/k2)
-     end if
-   end function a2maxpos
- 
-   function a2min1pos(a1val) result(a2min1)
-     real(dl), intent(in) :: a1val
-     real(dl) a2min1
-     a2min1 = 0.0d0
-     if(a1val <= 0.0d0) then
-       a2min1 = max(-s1/k1**2 - a1val/k1, -s2/k2**2 - a1val/k2, 0.0d0)
-     end if
-   end function a2min1pos
- 
-   function a2min2pos(a1val) result(a2min2)
-     real(dl), intent(in) :: a1val
-     real(dl) a2min2
-     a2min2 = 0.0d0
-     if(abs(a1val) >= 2.0d0*s1/k1 .and. a1val <= 0.0d0)  then
-       a2min2 = a1val**2/s1*0.25d0
-     end if
-   end function a2min2pos
- 
-   function a2min3pos(a1val) result(a2min3)
-     real(dl), intent(in) :: a1val
-     real(dl) a2min3
-     a2min3 = 0.0d0
-     if(abs(a1val) >= 2.0d0*s2/k2 .and. a1val <= 0.0d0)  then
-       a2min3 = a1val**2/s2*0.25d0
-     end if
-   end function a2min3pos
- 
-   function a2minfinalpos(a1val) result(a2minpos)
-     real(dl), intent(in) :: a1val
-     real(dl) a2minpos
-     a2minpos = max(a2min1pos(a1val),a2min2pos(a1val),a2min3pos(a1val))
-   end function a2minfinalpos
- 
-   function a2minneg(a1val) result(a2min)
-     real(dl), intent(in) :: a1val
-     real(dl) a2min
-     if (a1val >= max(-s1/k1,-s2/k2)) then
-       a2min = max(-s1/k1**2 - a1val/k1, -s2/k2**2 - a1val/k2)
-     else
-       a2min = 1.0d0
-     end if
-   end function a2minneg
- 
-   function a2max1neg(a1val) result(a2max1)
-     real(dl), intent(in) :: a1val
-     real(dl) a2max1
-     if(a1val >= 0.0d0) then
-       a2max1 = min(s1/k1**2 - a1val/k1, s2/k2**2 - a1val/k2, 0.0d0)
-     else
-       a2max1 = 0.0d0
-     end if
-   end function a2max1neg
- 
-   function a2max2neg(a1val) result(a2max2)
-     real(dl), intent(in) :: a1val
-     real(dl) a2max2
-     a2max2 = 0.0d0
-     if(abs(a1val) >= 2.0d0*s1/k1 .and. a1val >= 0.0d0)  then
-       a2max2 = -a1val**2/s1*0.25d0
-     end if
-   end function a2max2neg
- 
-   function a2max3neg(a1val) result(a2max3)
-     real(dl), intent(in) :: a1val
-     real(dl) a2max3
-     a2max3 = 0.0d0
-     if(abs(a1val) >= 2.0d0*s2/k2 .and. a1val >= 0.0d0)  then
-       a2max3 = -a1val**2/s2*0.25d0
-     end if
-   end function a2max3neg
- 
-   function a2maxfinalneg(a1val) result(a2maxneg)
-     real(dl), intent(in) :: a1val
-     real(dl) a2maxneg
-     a2maxneg = min(a2max1neg(a1val),a2max2neg(a1val),a2max3neg(a1val))
-   end function a2maxfinalneg
- 
- 
- function testa1a2(a1val, a2val) result(testresult)
-     real(dl), intent(in) :: a1val,a2val
-     logical :: testresult
- 
-     real(dl) :: kext, diffval
-     testresult = .true.
- 
-     ! check if there's an extremum; either a1val or a2val has to be negative, not both
-     kext = -a1val/2.0d0/a2val
-     diffval = abs(a1val*kext + a2val*kext**2)
-     if(kext > 0.0d0 .and. kext <= k1 .and. diffval > s1) testresult = .false.
-     if(kext > 0.0d0 .and. kext <= k2 .and. diffval > s2) testresult = .false.
- 
-     if (abs(a1val*k1 + a2val*k1**2) > s1) testresult = .false.
-     if (abs(a1val*k2 + a2val*k2**2) > s2) testresult = .false.
- 
- end function testa1a2
- 
- !! copying LSS_mpklike above.
- !! points_use is how many points to use in the likelihood calculation; 
- !!kbands_use is how many points you need to have a theory for in order to convolve the theory with the window function.
- 
- 
- ! this subroutine fills in the a1 and a2 values only once.
-  subroutine LSS_LRG_mpklike_init()
-    real(dl) :: a1val, a2val
-    real(dl) :: da1, da2  ! spacing of numerical integral over nuisance params.
-    integer :: countcheck = 0
-    integer :: i, j
-    !! this is just for checking the 'theory' curves for fiducial model
-    real :: fidLnLike
-    type(CosmoTheory) :: temptheory
-    type(CMBparams) :: tempCMB
- 
-    da1 = a1maxval/(nptsa1/2)
-    da2 = a2maxpos(-a1maxval)/(nptsa2/2)
-    do i = -nptsa1/2, nptsa1/2
-       do j = -nptsa2/2, nptsa2/2
-          a1val = da1*i
-          a2val = da2*j
- 
-          if ((a2val >= 0.0d0 .and. a2val <= a2maxpos(a1val) .and. a2val >= a2minfinalpos(a1val)) .or. &
-      & (a2val <= 0.0d0 .and. a2val <= a2maxfinalneg(a1val) .and. a2val >= a2minneg(a1val))) then
-             if(testa1a2(a1val,a2val) .eqv. .false.)  then
-                print *,'Failed a1, a2: ',a1val,a2val
-                if (a2val >= 0.0d0) print *,'pos', a2maxpos(a1val), a2minfinalpos(a1val)
-                if (a2val <= 0.0d0) print *,'neg', a2maxfinalneg(a1val), a2minneg(a1val)
-                stop
-             end if
-             countcheck = countcheck + 1
-             if(countcheck > nptstot) then
-                print *, 'countcheck > nptstot failure.'
-                stop
-             end if
-             a1list(countcheck) = a1val
-             a2list(countcheck) = a2val
-             !print *, countcheck, a1list(countcheck), a2list(countcheck)
-          end if
-       end do
-    end do
-    if(countcheck .ne. nptstot) then
-      print *, 'countcheck issue', countcheck, nptstot
-      stop
-    end if
-   call LRGinfo_init()
-  end subroutine LSS_LRG_mpklike_init
- 
- 
-  function LSS_LRG_mpklike(Theory,mset,CMB) result(LnLike)  ! LV_06 added CMB here
-    Type (mpkdataset) :: mset
-    Type (CosmoTheory) Theory
-    Type(CMBparams) CMB                  !LV_06 added for LRGDR4
-    real LnLike
-    integer :: i
-    real, dimension(:), allocatable :: mpk_raw, mpk_Pth, mpk_Pth_k, mpk_Pth_k2, k_scaled
-    real, dimension(:), allocatable :: mpk_WPth, mpk_WPth_k, mpk_WPth_k2
-    real :: covdat(mset%num_mpk_points_use), covth(mset%num_mpk_points_use), &
-           & covth_k(mset%num_mpk_points_use), covth_k2(mset%num_mpk_points_use), & 
-           & covth_zerowin(mset%num_mpk_points_use)
- 
-    real, dimension(nptstot) :: chisq, chisqmarg  !! minus log likelihood list
-    real :: minchisq,maxchisq,deltaL
- 
-    real(dl) :: a1val, a2val, zerowinsub
-    real :: sumDD, sumDT, sumDT_k, sumDT_k2, sumTT,& 
-      &  sumTT_k, sumTT_k2, sumTT_k_k, sumTT_k_k2, sumTT_k2_k2, &
-      &  sumDT_tot, sumTT_tot, &
-      &  sumDT_zerowin, sumTT_zerowin, sumTT_k_zerowin, sumTT_k2_zerowin, sumTT_zerowin_zerowin
- 
-    real :: sumzerow_Pth, sumzerow_Pth_k, sumzerow_Pth_k2
- 
-    real :: a_scl      !LV_06 added for LRGDR4
- 
-    real(wp) :: temp1,temp2,temp3
-    real :: temp4
- 
-    !! added for no marg
-    integer :: myminchisqindx
-    real :: currminchisq, currminchisqmarg, minchisqtheoryamp, chisqnonuis
-    real :: minchisqtheoryampnonuis, minchisqtheoryampminnuis
-    real(dl), dimension(2) :: myerfval
- 
-    call fill_LRGTheory(Theory,matter_power_minkh,matter_power_dlnkh)
-    allocate(mpk_raw(mset%num_mpk_kbands_use) ,mpk_Pth(mset%num_mpk_kbands_use))
-    allocate(mpk_Pth_k(mset%num_mpk_kbands_use) ,mpk_Pth_k2(mset%num_mpk_kbands_use))
-    allocate(mpk_WPth(mset%num_mpk_points_use),mpk_WPth_k(mset%num_mpk_points_use),mpk_WPth_k2(mset%num_mpk_points_use))
-    allocate(k_scaled(mset%num_mpk_kbands_use))!LV_06 added for LRGDR4
- 
-    chisq = 0
- 
-    if (.not. mset%use_set) then
-       LnLike = 0
-       return
-    end if
- 
-    IF(mset%use_scaling) then
-       call compute_scaling_factor(dble(CMB%omk),dble(CMB%omv),dble(CMB%w),a_scl)
-       !! this step now applied in compute_scaling_factor
-       !! this fixes the bug most easily !!
-       !!a_scl = 1.0d0/a_scl
-    else
-      a_scl = 1
-      stop 'use_scaling should be set to true for the LRGs!'
-    end if
- 
-    do i=1, mset%num_mpk_kbands_use
-          k_scaled(i)=max(matter_power_minkh,a_scl*mset%mpk_k(i))
-          mpk_raw(i)=LRGPowerAt(Theory,k_scaled(i))/a_scl**3
-    end do
- 
-    mpk_Pth = mpk_raw
- 
-    mpk_Pth_k = mpk_Pth*k_scaled
-    mpk_Pth_k2 = mpk_Pth*k_scaled**2
-    mpk_WPth = matmul(mset%mpk_W,mpk_Pth)
-    mpk_WPth_k = matmul(mset%mpk_W,mpk_Pth_k)
-    mpk_WPth_k2 = matmul(mset%mpk_W,mpk_Pth_k2)
- 
-    sumzerow_Pth = sum(mset%mpk_zerowindowfxn*mpk_Pth)/mset%mpk_zerowindowfxnsubdatnorm
-    sumzerow_Pth_k = sum(mset%mpk_zerowindowfxn*mpk_Pth_k)/mset%mpk_zerowindowfxnsubdatnorm
-    sumzerow_Pth_k2 = sum(mset%mpk_zerowindowfxn*mpk_Pth_k2)/mset%mpk_zerowindowfxnsubdatnorm
- 
- 
-    covdat = matmul(mset%mpk_invcov,mset%mpk_P)
-    covth = matmul(mset%mpk_invcov,mpk_WPth)
-    covth_k = matmul(mset%mpk_invcov,mpk_WPth_k)
-    covth_k2 = matmul(mset%mpk_invcov,mpk_WPth_k2)
-    covth_zerowin = matmul(mset%mpk_invcov,mset%mpk_zerowindowfxnsubtractdat)
- 
-    sumDD = sum(mset%mpk_P*covdat)
-    sumDT = sum(mset%mpk_P*covth)
-    sumDT_k = sum(mset%mpk_P*covth_k)
-    sumDT_k2 = sum(mset%mpk_P*covth_k2)
-    sumDT_zerowin = sum(mset%mpk_P*covth_zerowin)
- 
-    sumTT = sum(mpk_WPth*covth)
-    sumTT_k = sum(mpk_WPth*covth_k)
-    sumTT_k2 = sum(mpk_WPth*covth_k2)
-    sumTT_k_k = sum(mpk_WPth_k*covth_k)
-    sumTT_k_k2 = sum(mpk_WPth_k*covth_k2)
-    sumTT_k2_k2 = sum(mpk_WPth_k2*covth_k2)
-    sumTT_zerowin = sum(mpk_WPth*covth_zerowin)
-    sumTT_k_zerowin = sum(mpk_WPth_k*covth_zerowin)
-    sumTT_k2_zerowin = sum(mpk_WPth_k2*covth_zerowin)
-    sumTT_zerowin_zerowin = sum(mset%mpk_zerowindowfxnsubtractdat*covth_zerowin)
- 
-    currminchisq = 1000.0d0
-    do i=1,nptstot
-      a1val = a1list(i)
-      a2val = a2list(i)
-      zerowinsub = -(sumzerow_Pth + a1val*sumzerow_Pth_k + a2val*sumzerow_Pth_k2)
- 
-      sumDT_tot = sumDT + a1val*sumDT_k + a2val*sumDT_k2 + zerowinsub*sumDT_zerowin
-      sumTT_tot = sumTT + a1val**2.0d0*sumTT_k_k + a2val**2.0d0*sumTT_k2_k2 + & 
-                  & zerowinsub**2.0d0*sumTT_zerowin_zerowin &
-        & + 2.0d0*a1val*sumTT_k + 2.0d0*a2val*sumTT_k2 + 2.0d0*a1val*a2val*sumTT_k_k2 &
-        & + 2.0d0*zerowinsub*sumTT_zerowin + 2.0d0*zerowinsub*a1val*sumTT_k_zerowin &
-        & + 2.0d0*zerowinsub*a2val*sumTT_k2_zerowin
-      minchisqtheoryamp = sumDT_tot/sumTT_tot
-      chisq(i) = sumDD - 2.0d0*minchisqtheoryamp*sumDT_tot + minchisqtheoryamp**2.0d0*sumTT_tot
- #ifdef DR71RG
-      myerfval(1) = sumDT_tot/2.0d0/sqrt(sumTT_tot)
-      call geterf(myerfval)
-      chisqmarg(i) = sumDD - sumDT_tot**2.0d0/sumTT_tot & 
-          & + log(sumTT_tot) &
-          & - 2.0*log(1.0d0 + myerfval(2))
- #else
-      !!leave out the erf term, just to get it to compile.  This should never run.
-      chisqmarg(i) = sumDD - sumDT_tot**2.0d0/sumTT_tot & 
-          & + log(sumTT_tot)
-      if(0 .eq. 0) stop 'Logic problem.  Shouldnt be here.'
- #endif
- !this should always be here, but we're using gsl to call erf, so this function is only available if gsl is installed.
-      if(i == 1 .or. chisq(i) < currminchisq) then
-         myminchisqindx = i
-         currminchisq = chisq(i)
-         currminchisqmarg = chisqmarg(i)
-         minchisqtheoryampminnuis = minchisqtheoryamp
-      end if
-      if(i == int(nptstot/2)+1) then
-         chisqnonuis = chisq(i)
-         minchisqtheoryampnonuis = minchisqtheoryamp
-         if(abs(a1val) > 0.001 .or. abs(a2val) > 0.001) then
-            print *, 'ahhhh! violation!!', a1val, a2val
-         end if
-      end if
- 
-    end do
- 
- ! numerically marginalize over a1,a2 now using values stored in chisq
-    minchisq = minval(chisqmarg)
-    maxchisq = maxval(chisqmarg)
- 
-    LnLike = sum(exp(-(chisqmarg-minchisq)/2.0d0)/(nptstot*1.0d0))
-    if(LnLike == 0) then
-      LnLike = LogZero
-    else
-      LnLike = -log(LnLike) + minchisq/2.0d0
-    end if
-  deltaL = (maxchisq - minchisq)*0.5
-  if(Feedback > 1) print *,'LRG P(k) LnLike = ',LnLike
- 
-    deallocate(mpk_raw, mpk_Pth)
-    deallocate(mpk_Pth_k, mpk_Pth_k2)
-    deallocate(mpk_WPth, mpk_WPth_k, mpk_WPth_k2)
-    deallocate(k_scaled) 
- 
-  end function LSS_LRG_mpklike
- 
- end module
--- 0 ----
diff -r -c -b -B -N cosmomc/source/paramdef.F90 cosmomc_sampler/source/paramdef.F90
*** cosmomc/source/paramdef.F90	2009-09-18 17:33:04.000000000 +0200
--- cosmomc_sampler/source/paramdef.F90	2009-10-28 18:38:26.467004511 +0100
***************
*** 1,16 ****
  !Defines a parameterization, computes likelihoods and defined proposal density
  !Change this file to change these things, and MPI updating
- !The Cls are computed using routines defined in the CMB_Cls module
  
  module ParamDef
    !module defines a parameterization, and works out power spectra
!  use CMB_Cls
!  use cmbtypes
!  use cmbdata
   use Random
   use settings
   implicit none
  
   Type ParamSet
      real P(num_params)
      Type(ParamSetInfo) Info
--- 1,20 ----
  !Defines a parameterization, computes likelihoods and defined proposal density
  !Change this file to change these things, and MPI updating
  
  module ParamDef
    !module defines a parameterization, and works out power spectra
! ! use cmbtypes
! ! use cmbdata
   use Random
   use settings
+ 
   implicit none
  
+  Type ParamSetInfo  
+     integer :: infoInt
+     real :: infoReal
+  end Type ParamSetInfo
+ 
   Type ParamSet
      real P(num_params)
      Type(ParamSetInfo) Info
***************
*** 135,141 ****
          
          Ini_fail_on_not_found = .false.
  
!         call CMB_Initialize(Params%Info)
  
          prop_mat = Ini_Read_String('propose_matrix')
          has_propose_matrix = prop_mat /= ''
--- 139,145 ----
          
          Ini_fail_on_not_found = .false.
  
! !        call CMB_Initialize(Params%Info)
  
          prop_mat = Ini_Read_String('propose_matrix')
          has_propose_matrix = prop_mat /= ''
***************
*** 359,400 ****
  end subroutine SetProposeMatrix
  
  
- 
-  
-   subroutine WriteCMBParams(CMB,Theory,mult,like, with_data)     
-      Type (CosmoTheory) Theory 
-      real, intent(in) :: mult, like
-      logical, intent(in), optional :: with_data
-      Type(ParamSet) P
-      Type(CMBParams) CMB
- 
- 
-      call CMBParamsToParams(CMB,P%P)
- 
-      P%Info%Theory = Theory
-      if (present(with_data)) then
-       if (with_data) then
-       call WriteParamsAndDat(P, mult,like)
-       else
-       call WriteParams(P, mult,like)
-       end if
-      else
-       call WriteParams(P, mult,like)
-      end if
- 
-   end subroutine WriteCMBParams
-    
    subroutine WriteIndepSample(P, like)
      Type(ParamSet) P
      real like
!     Type(CMBParams) C
      if (indepfile_handle ==0) return
!     call ParamsToCMBParams(P%P,C)
!     call WriteModel(indepfile_handle, C,P%Info%Theory,like)
     end subroutine WriteIndepSample
  
  
     subroutine AddMPIParams(P,like, checkpoint_start)     
       real, intent(in) ::like
       real P(:)
       logical, intent(in), optional :: checkpoint_start
--- 363,380 ----
  end subroutine SetProposeMatrix
  
   
    subroutine WriteIndepSample(P, like)
      Type(ParamSet) P
      real like
! 
      if (indepfile_handle ==0) return
! 
     end subroutine WriteIndepSample
  
  
     subroutine AddMPIParams(P,like, checkpoint_start)     
+      use IO
+      use MAtrixUtils
       real, intent(in) ::like
       real P(:)
       logical, intent(in), optional :: checkpoint_start
***************
*** 729,734 ****
--- 709,715 ----
  #ifdef MPI
  
   subroutine CheckLimitsConverge(L)
+    use IO
    !Check limits from last half chains agree well enough across chains to be confident of result
    !Slowly explored tails will cause problems (long time till stops)
    Type(TList_RealArr), intent(in) :: L
diff -r -c -b -B -N cosmomc/source/params_CMB.f90 cosmomc_sampler/source/params_CMB.f90
*** cosmomc/source/params_CMB.f90	2009-10-02 12:16:48.000000000 +0200
--- cosmomc_sampler/source/params_CMB.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,319 ****
- !Parameterization using theta = r_s/D_a instead of H_0, and tau instead of z_re
- !and log(A_s) instead of A_s
- !Less general, but should give better performance
- !
- !The well-determined parameter A_s exp(-2tau) should be found by the covariance matrix
- !parameter 3 is 100*theta, parameter 4 is tau, others same as params_H except A->log(A)
- !Theta is much better constrained than H_0
- !
- !AL Jul 2005 - fixed bug which screwed up tau values for later importance sampling
- !AL Feb 2004 - fixed compiler compatibility issue with **-number, typo in zstar
- !AL Dec 2003 - renamed from params_Kowosky, changed to tau - log(A)
- !AL Sept 2003 - fixed bug in declaration of dtauda routine
- !AL June 2003
- !Assumes prior 0.4 < h < 1
- 
-    function CMBToTheta(CMB)
-      use settings
-      use cmbtypes
-      use ModelParams
-      use CMB_Cls
-      use Precision
-      implicit none
-      Type(CMBParams) CMB
-      double precision zstar, astar, atol, rs,  DA
-      double precision, external :: dsoundda, rombint
-      real CMBToTheta
-      integer error
-   
-      call InitCAMB(CMB,error,.false.)
- 
- !!From Hu & Sugiyama
-        zstar =  1048*(1+0.00124*CMB%ombh2**(-0.738))*(1+ &
-         (0.0783*CMB%ombh2**(-0.238)/(1+39.5*CMB%ombh2**0.763)) * &
-            (CMB%omdmh2+CMB%ombh2)**(0.560/(1+21.1*CMB%ombh2**1.81)))
-      
-        astar = 1/(1+zstar)
-        atol = 1e-6
-        rs = rombint(dsoundda,1d-8,astar,atol)
-        DA = AngularDiameterDistance(zstar)/astar
-        CMBToTheta = rs/DA
- !       print *,'z* = ',zstar, 'r_s = ',rs, 'DA = ',DA, rs/DA
- 
-   end function CMBToTheta
- 
- 
- 
- 
- !Mapping between array of power spectrum parameters and CAMB
-      subroutine SetCAMBInitPower(P,CMB,in)
-        use camb
-        use settings
-        use cmbtypes
-        implicit none
-        type(CAMBParams)  P
-        Type(CMBParams) CMB
- 
-        integer, intent(in) :: in
- 
- 
-        if (Power_Name == 'power_tilt') then
- 
-        P%InitPower%k_0_scalar = pivot_k
-        P%InitPower%k_0_tensor = pivot_k
- 
-        P%InitPower%ScalarPowerAmp(in) = cl_norm*CMB%norm(norm_As)
-        P%InitPower%rat(in) = CMB%norm(norm_amp_ratio)
-         
-        P%InitPower%an(in) = CMB%InitPower(1)
-        P%InitPower%ant(in) = CMB%InitPower(2)
-        P%InitPower%n_run(in) = CMB%InitPower(3)
-        if (inflation_consistency) then
-          P%InitPower%ant(in) = - CMB%norm(norm_amp_ratio)/8.
-           !note input n_T is ignored, so should be fixed (to anything)
-        end if
-        else
-          stop 'params_CMB:Wrong initial power spectrum'
-        end if
- 
-     end subroutine SetCAMBInitPower
-  
- 
-  subroutine SetForH(Params,CMB,H0)
-      use settings
-      use cmbtypes
-      use CMB_Cls
-      implicit none
-      real Params(num_Params)
- 
-      Type(CMBParams) CMB
-      real h2,H0
-   
-     CMB%H0=H0
-     CMB%ombh2 = Params(1)    
-     CMB%omdmh2 = Params(2)
-     CMB%zre = Params(4) !!Not actually used.. is tau in this parameterization
-     CMB%Omk = Params(5)
-     CMB%nufrac = Params(6)
-     CMB%w = Params(7)
- 
-     CMB%InitPower(1:num_initpower) = Params(index_initpower:index_initpower+num_initPower-1)
-     CMB%norm(1) = exp(Params(index_norm))
-     CMB%norm(2:num_norm) = Params(index_norm+1:index_norm+num_norm-1)
-     CMB%nuisance(1:num_nuisance_params) = Params(index_nuisance:index_nuisance+num_nuisance_params-1)
- 
-     CMB%h = CMB%H0/100
-     h2 = CMB%h**2
-     CMB%omnuh2 = CMB%omdmh2*CMB%nufrac
-     CMB%omch2 = CMB%omdmh2 - CMB%omnuh2
-     CMB%omb = CMB%ombh2/h2
-     CMB%omc = CMB%omch2/h2
-     CMB%omnu = CMB%omnuh2/h2
-     CMB%omdm = CMB%omdmh2/h2
-     CMB%omv = 1- CMB%omk - CMB%omb - CMB%omdm
- 
-  end  subroutine SetForH
- 
-  subroutine ParamsToCMBParams(Params, CMB)
-      use settings
-      use cmbtypes
-      use CMB_Cls
- 
-      implicit none
-      real Params(num_params)
-      real, save :: LastParams(num_params) = 0.
-      real, save :: LastH0, Lastzre
- 
-      Type(CMBParams) CMB
-      real DA
-      real  D_b,D_t,D_try,try_b,try_t, CMBToTheta, lasttry,tau
-      external CMBToTheta
- 
-      if (all(Params(1:num_hard) == Lastparams(1:num_hard))) then
-        call SetForH(Params,CMB,LastH0)
-        CMB%zre = Lastzre
-        CMB%reserved(1) = params(4)
-      else
- 
-      DA = Params(3)/100
-      try_b = 40
-      call SetForH(Params,CMB,try_b)
-      D_b = CMBToTheta(CMB)
-      try_t = 100
-      call SetForH(Params,CMB,try_t)
-      D_t = CMBToTheta(CMB)
-      if (DA < D_b .or. DA > D_t) then
-       cmb%H0=0 !Reject it
-      else
-      lasttry = -1
-      do
-             call SetForH(Params,CMB,(try_b+try_t)/2)
-             D_try = CMBToTheta(CMB)
-                if (D_try < DA) then
-                   try_b = (try_b+try_t)/2
-                else
-                   try_t = (try_b+try_t)/2
-                end if
-                if (abs(D_try - lasttry)< 1e-7) exit
-               lasttry = D_try
-      end do
- 
-     !!call InitCAMB(CMB,error)
-     tau = params(4)
-     CMB%zre = GetZreFromTau(CMB, tau)       
- 
-     LastH0 = CMB%H0
-     Lastzre = CMB%zre
-     LastParams = Params
-     end if
- 
-     CMB%reserved = 0
-     CMB%reserved(1) = params(4) !tau
-   
-      end if
-  
-    end subroutine ParamsToCMBParams
- 
-    subroutine CMBParamsToParams(CMB, Params)
-      use settings
-      use cmbtypes
-      implicit none
-      real Params(num_Params)
-      Type(CMBParams) CMB
-      real CMBToTheta
-      external CMBToTheta
-  
-       Params(1) =CMB%ombh2 
-       Params(2) =CMB%omdmh2
-  
-       Params(3) = CMBToTheta(CMB)*100
-       Params(4) = CMB%reserved(1)
-       Params(5) =CMB%omk 
-       
-       Params(6) =CMB%nufrac 
-       Params(7) =CMB%w
-       Params(index_initpower:index_initpower+num_initpower-1) =CMB%InitPower(1:num_initpower) 
-       Params(index_norm) = log(CMB%norm(1))
-       Params(index_norm+1:index_norm+num_norm-1) = CMB%norm(2:num_norm)
-       Params(index_nuisance:index_nuisance+num_nuisance_params-1)=CMB%nuisance(1:num_nuisance_params) 
- 
-    end subroutine CMBParamsToParams
- 
-    subroutine SetParamNames(Names)
-     use settings
-     use ParamNames
-     Type(TParamNames) :: Names
-  
-     if (generic_mcmc) then
-      Names%nnames=0
-      if (Feedback>0) write (*,*) 'edit SetParamNames in params_CMB.f90 if you want to use named params'
-     else
-      call ParamNames_init(Names, './params_CMB.paramnames')
-     end if
-    end subroutine SetParamNames
- 
- 
-   subroutine WriteParams(P, mult, like)
-      use settings
-      use cmbtypes
-      use ParamDef
-      use IO
-      implicit none
-      Type(ParamSet) P
-      real, intent(in) :: mult, like
-      Type(CMBParams) CMB
-      real r10
-      real, allocatable :: output_array(:)
-   
-     if (outfile_handle ==0) return
-   
-     if (generic_mcmc) then
- 
-       call IO_OutputChainRow(outfile_handle, mult, like, P%P)
-      
-     else
-     
-       call ParamsToCMBParams(P%P,CMB)
- 
-       if (lmax_tensor /= 0 .and. compute_tensors) then
-           r10 = P%Info%Theory%cl_tensor(10,1)/P%Info%Theory%cl(10,1)
-       else
-         r10 = 0
-       end if
-       allocate(output_array(num_real_params + 7 + nuisance_params_used ))
-       output_array(1:num_real_params) =  P%P(1:num_real_params)
-       output_array(num_real_params+1) = CMB%omv
-       output_array(num_real_params+2) = P%Info%Theory%Age
-       output_array(num_real_params+3) = CMB%omdm+CMB%omb
-       output_array(num_real_params+4) = P%Info%Theory%Sigma_8      
-       output_array(num_real_params+5) = CMB%zre
-       output_array(num_real_params+6) = r10
-       output_array(num_real_params+7) = CMB%H0
-       if (nuisance_params_used>0) then
-        output_array(num_real_params+8:num_real_params+8+nuisance_params_used-1) = &
-         P%P(num_real_params+1:num_real_params+nuisance_params_used) 
-       end if
-  
-       call IO_OutputChainRow(outfile_handle, mult, like, output_array)
-       deallocate(output_array)           
-     end if
- 
-   end  subroutine WriteParams
- 
- 
- 
- 
-   subroutine WriteParamsAndDat(P, mult, like)
-      use settings
-      use cmbtypes
-      use ParamDef
-      use IO
-      implicit none
-     Type(ParamSet) P
-     real, intent(in) :: mult, like
-     character(LEN =30) fmt
-     Type(CMBParams) CMB
-     real r10
-     real,allocatable :: output_array(:)
-        
-     if (outfile_handle ==0) return
-       call ParamsToCMBParams(P%P,CMB)
- 
-       if (lmax_tensor /= 0 .and. compute_tensors) then
-           r10 = P%Info%Theory%cl_tensor(10,1)/P%Info%Theory%cl(10,1)
-       else
-         r10 = 0
-       end if
- 
-      allocate(output_array(num_real_params + 7 + num_matter_power ))
-       output_array(1:num_real_params) =  P%P(1:num_real_params)
-       output_array(num_real_params+1) = CMB%omv
-       output_array(num_real_params+2) = P%Info%Theory%Age
-       output_array(num_real_params+3) = CMB%omdm+CMB%omb
-       output_array(num_real_params+4) = P%Info%Theory%Sigma_8      
-       output_array(num_real_params+5) = CMB%zre
-       output_array(num_real_params+6) = r10
-       output_array(num_real_params+7) = CMB%H0
-       output_array(num_real_params+8:num_real_params+8+num_matter_power-1) = &
-         P%Info%Theory%matter_power(:,1) 
- 
-       call IO_OutputChainRow(outfile_handle, mult, like, output_array)
-       deallocate(output_array)
- 
-   end  subroutine WriteParamsAndDat
- 
- 
-   function dsoundda(a)
-           use Precision
-           use ModelParams
-      
-           implicit none
-           real(dl) dsoundda,dtauda,a,R,cs
-           external dtauda
- 
-            R=3.0d4*a*CP%omegab*(CP%h0/100.0d0)**2
-            cs=1.0d0/sqrt(3*(1+R))
-            dsoundda=dtauda(a)*cs
-         
-   end function dsoundda
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/params_EXT.f90 cosmomc_sampler/source/params_EXT.f90
*** cosmomc/source/params_EXT.f90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_sampler/source/params_EXT.f90	2009-10-28 17:57:12.524467968 +0100
***************
*** 0 ****
--- 1,63 ----
+    subroutine SetParamNames(Names)
+     use settings
+     use ParamNames
+     Type(TParamNames) :: Names
+  
+     if (generic_mcmc) then
+      Names%nnames=0
+      if (Feedback>0) write (*,*) 'edit SetParamNames in params_CMB.f90 if you want to use named params'
+ !     call ParamNames_init(Names, './params_EXT.paramnames')
+   end if
+ end subroutine SetParamNames
+ 
+ 
+   subroutine WriteParams(P, mult, like)
+      use settings 
+      use ParamDef
+      use IO
+      implicit none
+      Type(ParamSet) P
+      real, intent(in) :: mult, like
+      real r10
+      real, allocatable :: output_array(:)
+   
+     if (outfile_handle ==0) return
+   
+     if (generic_mcmc) then
+ 
+       call IO_OutputChainRow(outfile_handle, mult, like, P%P)
+      
+     else
+     
+        stop
+      
+     end if
+ 
+   end  subroutine WriteParams
+ 
+ 
+ 
+ 
+   subroutine WriteParamsAndDat(P, mult, like)
+      use settings
+      use ParamDef
+      use IO
+      implicit none
+     Type(ParamSet) P
+     real, intent(in) :: mult, like
+     character(LEN =30) fmt
+     real r10
+     real,allocatable :: output_array(:)
+        
+     if (outfile_handle ==0) return
+ 
+     allocate(output_array(num_real_params))
+     output_array(1:num_real_params) =  P%P(1:num_real_params)
+      
+     call IO_OutputChainRow(outfile_handle, mult, like, output_array)
+     deallocate(output_array)
+     
+   end  subroutine WriteParamsAndDat
+ 
+ 
+  
diff -r -c -b -B -N cosmomc/source/postprocess.f90 cosmomc_sampler/source/postprocess.f90
*** cosmomc/source/postprocess.f90	2009-10-19 20:45:07.000000000 +0200
--- cosmomc_sampler/source/postprocess.f90	2009-10-28 17:35:49.788682234 +0100
***************
*** 7,15 ****
  
  module posthoc
    use settings
-   use cmbtypes
-   use CMB_Cls
-   use cmbdata
    use CalcLike
    implicit none
  
--- 7,12 ----
***************
*** 71,287 ****
     subroutine postprocess(InputFile)
          use IO
          character(LEN=*), intent(INOUT):: InputFile
-         Type(CMBParams) LastCMB,CMB, newCMB
-         Type(CosmoTheory) Theory, CorrectTheory
-         Type(ParamSetInfo) Info
-         real Cls(lmax,num_cls), truelike,mult,like
-         real weight_min, weight_max, mult_sum, mult_ratio, mult_max,weight
  
!         real max_like, max_truelike
!         integer error,num, debug
!         character (LEN=120) :: post_root
!         real Params(num_params)
!         integer infile_handle, outdata_handle
! 
!         flush_write = .false.
!         weight_min= 1e30
!         weight_max = -1e30
!         mult_sum = 0
!         mult_ratio = 0
!         mult_max = -1e30
!         max_like = 1e30
! 
!         max_truelike =1e30
! 
!         debug = 0
!         Info%Theory%Sn_LogLike = 0
!         Info%Theory%HST_LogLike = 0
!         Info%Theory%BAO_LogLike = 0
! 
!         infile_handle = 0
!         Temperature = PostParams%redo_temperature 
! 
!         if (Feedback>0 .and. PostParams%redo_change_like_only) &
!               write (*,*) 'Warning: only changing likelihoods not weights'
! 
!         if (PostParams%redo_datafile /= '') InputFile = PostParams%redo_datafile
! 
!         if (PostParams%redo_from_text) then
! 
!          infile_handle = IO_OpenChainForRead(trim(InputFile)//'.txt')
!          
!          if (.not. PostParams%redo_theory) write (*,*) '**You probably want to set redo_theory**'
!          if (.not. PostParams%redo_cls .and. Use_CMB) write (*,*) '**You probably want to set redo_cls**'
!          if (.not. PostParams%redo_pk .and. Use_mpk) write (*,*) '**You probably want to set redo_pk**'
! 
!          if (PostParams%redo_thin>1) write (*,*) 'redo_thin only OK with redo_from_text if input weights are 1'
! 
!         else
!          infile_handle = IO_OpenDataForRead(trim(InputFile)//'.data')
!         end if
! 
!          
!         if (PostParams%redo_outroot == '') then
!           post_root = trim(ExtractFilePath(InputFile))//'post_'// trim(ExtractFileName(InputFile))
!         else
!           post_root = PostParams%redo_outroot
!           if (instance /= 0) post_root = numcat(trim(post_root)//'_',instance)
!         end if
! 
!         if (Feedback > 0) then
!           if (PostParams%redo_from_text) then
!            write (*,*) 'reading from: ' //  trim(InputFile)//'.txt'
!           else
!            write (*,*) 'reading from: ' //  trim(InputFile)//'.data'
!           end if
!            write (*,*) 'writing to: ' // trim(post_root)//'.*'
!         end if
! 
!         write (*,*) 'Using temperature: ', Temperature
! 
!         outfile_handle = IO_OutputOpenForWrite(trim(post_root)//'.txt')
!         
!         outdata_handle = IO_DataOpenForWrite(trim(post_root)//'.data')
!      
!         num = 0
!         do
! 
!         if (PostParams%redo_from_text) then
!           error = 0
!           if (.not. IO_ReadChainRow(infile_handle, mult, like, Params, num_params)) exit
!           call ParamsToCMBParams(Params, CMB)
! 
!         else
!           call ReadModel(infile_handle,CMB,Theory,mult,like, error)
!         end if
! 
!            
!         if (error ==1) then
!           if (num==0) call MpiStop('Error reading data file.')
! 
!           exit
!         end if
!         num=num+1
!         if (num>PostParams%redo_skip .and. mod(num,PostParams%redo_thin) == 0) then
!      
!         LastCMB = CMB
! 
!         newCMB = CMB  
!         if (PostParams%redo_theory) then
!     
!          call GetClsInfo(newCMB, CorrectTheory, error, PostParams%redo_cls, PostParams%redo_pk)
!     
!          if (PostParams%redo_cls) then
!             Theory%cl = CorrectTheory%cl
!             Theory%cl_tensor = CorrectTheory%cl_tensor
!             !!In last version redo_cls just for going to higher l on temperature
! 
!          end if
!   
!          if (PostParams%redo_pk) then
!             Theory%sigma_8 = CorrectTheory%sigma_8
!             Theory%Matter_Power = CorrectTheory%Matter_Power
!          end if
! 
!          Theory%Age = CorrectTheory%Age
!      
!         else
!           error = 0
!         end if
! 
! 
!           CorrectTheory = Theory
! 
! 
!          if (error ==0) then
!  
!            if (PostParams%redo_like) then
!                
! 
!               if (Use_LSS .and. CorrectTheory%sigma_8==0) &
!                  call MpiStop('Matter power/sigma_8 have not been computed. Use redo_theory and redo_pk.')
! 
! 
!               call ClsFromTheoryData(CorrectTheory, newCMB, Cls)
!               Info%Theory = CorrectTheory
!             
!               if (any(Cls(2:lmax,1) < 0)) then
!                  write (*,*) 'WARNING: bad model with C_l < 0 being rejected'
!                  write (*,*) 'in '//trim(InputFile)
!                  !This shouldn't happen. 
!                  !But good sanity check, esp when playing around with extended models
!                  !Think have fixed problems with Om_k \sim -7e-4, w\sim -0.7.
!                  write (*,*) newCMB
!                  write (*,*)
!                  truelike = logZero
!               else
!                truelike = GetLogLikePost(newCMB, Info, Cls,.true.)
!               end if
!               if (truelike == logZero) then
!                weight = 0
!               else
!                if (PostParams%redo_add) truelike = like + truelike
! 
!                weight = exp(like-truelike+PostParams%redo_likeoffset)
!               end if
!            
!              if (.not. PostParams%redo_change_like_only)  mult = mult*weight
!            else
!               truelike = like
!               weight = 1
!            end if
! 
! 
!            max_like = min(max_like,like)
! 
!            max_truelike = min(max_truelike,truelike)
! 
!            mult_ratio = mult_ratio + weight
!            mult_sum = mult_sum + mult
!           
!            if (mult /= 0) then        
!             call WriteCMBParams(newCMB, CorrectTheory, mult, truelike,txt_theory)
!             call WriteModel(outdata_handle, newCMB, CorrectTheory,truelike,mult)
! 
!            else 
! 
!             if (Feedback >1 ) write (*,*) 'Zero weight: new like = ', truelike
!            end if
!           
!            if (Feedback > 1) write (*,*) 'done ', num, 'mult= ', mult,' weight = ', weight
!            weight_max = max(weight,weight_max)       
!            weight_min = min(weight,weight_min)
!            mult_max = max(mult_max,mult)
! 
!         end if
!         end if
!         
!         end do
! 
!         call IO_Close(infile_handle)
!         call IO_Close(outfile_handle)
!         call IO_DataCloseWrite(outdata_handle)
!       
!         num = (num - PostParams%redo_skip) / PostParams%redo_thin
!         if (Feedback>0) then 
!            write(*,*) 'finished. Processed ',num,' models'
!            write (*,*) 'max weight= ',weight_max, ' min weight = ',weight_min
!            write (*,*) 'mean mult  = ', mult_sum/num
!            write (*,*) 'mean importance weight (approx evidence ratio) = ',mult_ratio/num
!            write (*,*) 'effective number of samples =',mult_sum/mult_max
!            write (*,*) 'Best redo_likeoffset = ',max_truelike - max_like
!          end if
!         
!         if ((mult_ratio < 1e-6 .or. mult_ratio > 1e8) & 
! 
!             .and. .not.PostParams%redo_change_like_only) then
! 
!          write (*,*) 'WARNING: use redo_likeoffset to rescale likelihoods'
!         end if
! 
! 
! 
!         return
  
          end subroutine postprocess
  
--- 68,75 ----
     subroutine postprocess(InputFile)
       use IO
       character(LEN=*), intent(INOUT):: InputFile
  
!      stop 'postprocess not implemented!'
          
     end subroutine postprocess
  
diff -r -c -b -B -N cosmomc/source/SDSSLy-a-v3.f90 cosmomc_sampler/source/SDSSLy-a-v3.f90
*** cosmomc/source/SDSSLy-a-v3.f90	2006-10-05 01:22:56.000000000 +0200
--- cosmomc_sampler/source/SDSSLy-a-v3.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,277 ****
- ! Module for using SDSS McDonald et al. (2004) Ly-alpha data 
- 
- ! NOTE:  Not valid in growth function calculation for dark matter equations 
- ! of state away from -1; 
- ! also, this does not use alpha (running) information from McDonald chi^2 table
- 
- ! If using SDSS Ly-alpha data:  cite  
- !  P.~McDonald {\it et al.},
- !  %``The Linear Theory Power Spectrum from the Lyman-alpha Forest in the Sloan
- !  %Digital Sky Survey,''
- !  arXiv:astro-ph/0407377.
- 
- ! implemented for CosmoMC by Kevork Abazajian  
- 
- ! AL: note requires *linear* power spectrum input
- ! AL: April 2006: added assumption violation traps
- 
- module Lya
- use settings
- use cmbtypes
- use Precision
- implicit none
- 
-  !Note all units are in k/h here
-  logical :: Use_Lya = .false.
- 
- 
-  integer, parameter :: c_lya_points = 12
-  
-  logical, parameter :: use_sdsslyaP  = .true.
-  
-  integer, parameter :: n_SDSSLya = 41
- 
-  real(dl) :: SDSSLya_delta(n_SDSSLya)
-  real(dl) :: SDSSLya_neff(n_SDSSLya)
-  real(dl) :: SDSSLya_chi2(n_SDSSLya,n_SDSSLya)
-  real(dl) :: SDSSLya_chi2a(n_SDSSLya,n_SDSSLya)
- 
-  real ::  kh_pts0(c_lya_points),pk_pts0(c_lya_points),err_pts0(c_lya_points),z_pts
- 
-  logical :: do_lya_init  = .true.
-  real(dl) :: ommpass,omlpass
-  real :: lya_kmax = 1.5
-  real(dl) :: z_SDSSP,kh_SDSSP,minSDSSPchi
- contains
- 
-   function dgrowth(zz)
-     real(dl) dgrowth
-     real(dl) zz
-     
-     dgrowth = (1.d0+zz)/((ommpass*(1.d0+zz)**3+omlpass)**1.5d0)
-    
-   end function dgrowth
- 
- 
-  subroutine lya_init
-    integer i,j
-    real temp
-    if (Feedback > 0) write(*,*) 'reading: SDSS Ly-alpha data'
-    
-     if(use_SDSSLyaP)then
-       minSDSSPchi = 1.d30
-       z_SDSSP = 3.d0
-       kh_SDSSP = 0.009d0
-       call OpenTxtFile('data/SDSSPlyachi2.txt', tmp_file_unit)
-       do i=1,n_SDSSLya
-          do j=1,n_SDSSLya
-             read(tmp_file_unit,*)SDSSLya_delta(i),SDSSLya_neff(j),temp,SDSSLya_chi2(i,j)
-             if(SDSSLya_chi2(i,j)>0.)minSDSSPchi = min(SDSSLya_chi2(i,j),minSDSSPchi)
-          end do
-       end do
-       
-       if (Feedback > 0) write(*,*) 'done reading: SDSS Ly-alpha data'
-       
-       call splie2(SDSSLya_delta,SDSSLya_neff,SDSSLya_chi2,n_SDSSLya,n_SDSSLya,SDSSLya_chi2a)
-    end if
-    if (Feedback > 0) write(*,*) 'done reading: SDSS Ly-alpha data'
-    
-    do_lya_init = .false.
-    
-  end subroutine lya_init
- 
- 
-  function LSS_Lyalike(CMB, Theory)
-    Type (CMBParams) CMB
-    Type (CosmoTheory) Theory
-    real LSS_Lyalike
-    
-    real hubz,h,omm,oml
-    real logdelta,normf
-    real(dl) chi2   
-    real(dl) delta,neff
- 
-    real D0,D2,khlya,pk0,lnkhlya1,lnkhlya2,lnpk1,lnpk2
- 
-    real(dl) rombint
-    external rombint
- 
-    if (do_lya_init) then
-       call lya_init
-    endif   
- 
-     if (CMB%W /= -1. .or. CMB%omnu/=0. .or. CMB%InitPower(3)/= 0.) then
-       write (*,*) 'This SDSS Lya module does not support extended models'
-       write (*,*) 'for extensions see http://www.slosar.com/aslosar/lya.html'
-       stop
-     end if
-    
- 
-    omm = CMB%omc+CMB%omb+CMB%omnu
-    oml = CMB%omv
-    h   = CMB%H0/100.
-    
-    ommpass = omm
-    omlpass = oml
-    D0 = rombint(dgrowth,0.d0,10000.d0,1.d-6) !5 omm / 2 not needed since only want ratio
-    LSS_Lyalike = 0.
- 
-    if(use_sdsslyaP)then  ! use pt. slope
- 
-       normf = 1./(19.739209)  ! 1/(2*pi**2)
- 
-       hubz= CMB%H0*sqrt(omm*(1.+z_SDSSP)**3+oml)
-       
-       D2 =  (hubz/CMB%H0*rombint(dgrowth,z_SDSSP,10000.d0,1.d-6)/D0)**2 ! Note: not valid for w.ne.-1
- 
-       khlya = kh_SDSSP * hubz/h/(1.+z_SDSSP)
-       pk0 = MatterPowerAt(Theory,khlya)*D2
-       lnkhlya1 = log(khlya)*0.99
-       lnkhlya2 = log(khlya)*1.01
-       lnpk1 = log(MatterPowerAt(Theory,exp(lnkhlya1))*D2)
-       lnpk2 = log(MatterPowerAt(Theory,exp(lnkhlya2))*D2)
-       neff  = (lnpk2-lnpk1)/(lnkhlya2-lnkhlya1)
- 
-       delta = (pk0*khlya**3*normf)
-          
-       neff  = (lnpk2-lnpk1)/(lnkhlya2-lnkhlya1)
- 
-       call splin2(SDSSLya_delta,SDSSLya_neff,SDSSLya_chi2,SDSSLya_chi2a,n_SDSSLya,n_SDSSLya &
-            ,delta,neff,chi2)
- 
-       if(chi2<minSDSSPchi)chi2 = 2.d30
- 
-       LSS_Lyalike = LSS_Lyalike + chi2/2.
-    end if
- 
- 
- 
-  end function LSS_lyalike
- 
-  
-  SUBROUTINE splie2(x1a,x2a,ya,m,n,y2a)
-    INTEGER m,n,NN
-    real(dl) x1a(m),x2a(n),y2a(m,n),ya(m,n)
-    PARAMETER (NN=100)
-    INTEGER j,k
-    real(dl) y2tmp(NN),ytmp(NN)
-    do j=1,m
-       do k=1,n
-          ytmp(k)=ya(j,k)
-       end do
-       call spline(x2a,ytmp,n,1.d30,1.d30,y2tmp)
-       do k=1,n
-          y2a(j,k)=y2tmp(k)
-       end do
-    end do
-  end SUBROUTINE splie2
- 
- 
-  SUBROUTINE splin2(x1a,x2a,ya,y2a,m,n,x1,x2,y)
-    INTEGER m,n,NN
-    real(dl) x1,x2,y,x1a(m),x2a(n),y2a(m,n),ya(m,n)
-    PARAMETER (NN=100)
-    INTEGER j,k
-    real(dl) y2tmp(NN),ytmp(NN),yytmp(NN)
-    do j=1,m
-       do k=1,n
-          ytmp(k)=ya(j,k)
-          y2tmp(k)=y2a(j,k)
-       end do
-       yytmp(j) = splintt(x2a,ytmp,y2tmp,n,x2)
-    end do
-    call spline(x1a,yytmp,m,1.d30,1.d30,y2tmp)
-    y = splintt(x1a,yytmp,y2tmp,m,x1)
-  END SUBROUTINE splin2
-  
- 
-  FUNCTION splintt(xa,ya,y2a,n,x)
-    !  USE nrtype; USE nrutil, ONLY : assert_eq,nrerror
-    !  USE nr, ONLY: locate
-    integer, INTENT(IN)  :: n
-    real(dl), INTENT(IN) :: xa(n),ya(n),y2a(n)
-    real(dl), INTENT(IN) :: x
-    real(dl) :: splintt
-    integer :: khi,klo
-    real(dl) :: a,b,h,y
- 
-    klo=max(min(locate(xa,x),n-1),1)
-    khi=klo+1
-    h=xa(khi)-xa(klo)
-    if (h == 0.0)then
-       write(*,*)('bad xa input in splintt')
-       splintt = -99.
-    else
-       a=(xa(khi)-x)/h
-       b=(x-xa(klo))/h
-       !            /** linear interpolation outside boundary **/
-       if((klo==1).and.(b<0.0))then
-          y=a*ya(klo)+b*ya(khi)-b*h*h*(2.0*y2a(klo)+y2a(khi))/6.0
-       else if((khi==n).and.(a<0.0))then
-          y=a*ya(klo)+b*ya(khi)-a*h*h*(y2a(klo)+2.0*y2a(khi))/6.0
-       else
-          y=a*ya(klo)+b*ya(khi)+((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6.0
-       endif
-       splintt = y
-    endif
-  END FUNCTION splintt
- 
- FUNCTION locate(xx,x)
-   REAL(dl), DIMENSION(:), INTENT(IN) :: xx
-   REAL(dl), INTENT(IN) :: x
-   INTEGER :: locate
-   INTEGER :: n,jl,jm,ju
-   LOGICAL :: ascnd
-   n=size(xx)
-   ascnd = (xx(n) >= xx(1))
-   jl=0
-   ju=n+1
-   do
-      if (ju-jl <= 1) exit
-      jm=(ju+jl)/2
-      if (ascnd .eqv. (x >= xx(jm))) then
-         jl=jm
-      else
-         ju=jm
-      end if
-   end do
-   if (x == xx(1)) then
-      locate=1
-   else if (x == xx(n)) then
-      locate=n-1
-   else
-      locate=jl
-   end if
- END FUNCTION locate
- 
- end module Lya
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/settings.f90 cosmomc_sampler/source/settings.f90
*** cosmomc/source/settings.f90	2009-10-22 11:33:09.000000000 +0200
--- cosmomc_sampler/source/settings.f90	2009-10-28 17:36:04.748706471 +0100
***************
*** 43,49 ****
  
    real, parameter :: cl_norm = 1e-10 !units for As
  
!   logical, parameter ::  generic_mcmc= .false. 
      !set to true to not call CAMB, etc.
      !write GenericLikelihoodFunction in calclike.f90   
  
--- 43,49 ----
  
    real, parameter :: cl_norm = 1e-10 !units for As
  
!   logical, parameter ::  generic_mcmc= .true. 
      !set to true to not call CAMB, etc.
      !write GenericLikelihoodFunction in calclike.f90   
  
diff -r -c -b -B -N cosmomc/source/sn_sdss_parser.f90 cosmomc_sampler/source/sn_sdss_parser.f90
*** cosmomc/source/sn_sdss_parser.f90	2009-10-22 13:22:29.000000000 +0200
--- cosmomc_sampler/source/sn_sdss_parser.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,721 ****
- ! A parser for SDSS Supernovae FITRES 
- ! Wessel Valkenburg, LAPTH, 2009
- ! E-mail: wessel.valkenburg@lapp.in2p3.fr
- !
- !
- ! Usage:
- !  "use sn_sdss_parser"
- !  
- !  declare a structure of type sdssdata (already publicly defined in this module)
- ! e.g.  
- !  "type(sdssdata) :: thisdata"
- !
- ! then simply call GetSDSSSN
- !  "call GetSDSSSN('a', thisdata)"
- ! 
- ! where a can be any single character a,b,c,d,e or f, specifying the subset of SNe:
- !   a: SDSS only
- !   b: SDSS+ESSENCE+SNLS
- !   c: LOWZ+SDSS
- !   d: LOWZ+SDSS+ESSENCE+SNLS
- !   e: LOWZ+SDSS+ESSENCE+SNLS+HST
- !   f: LOWZ+ESSENCE+SNLS
- !
- ! or
- !  "call GetSDSSSN('1 3 4 50 100', thisdata)"
- ! with any space-seperated list of arbitrary selectrion of the following id's:
- !
- ! 1   = SDSS
- ! 3   = ESSE
- ! 4   = SNLS
- ! 50  = Nearby
- ! 100 = HST
- !
- ! eg. 'e' is equivalent to '1 3 4 50 100' 
- !
- ! the structure thisdata will be allocated and returned containing
- ! thisdata%z(:)      - redshift
- ! thisdata%zerr(:)   - error in redshift
- ! thisdata%mu(:)     - apparent brightness
- ! thisdata%muerr(:)  - error on brightness
- ! thisdata%sigint(:) - intrinsic error
- !
- ! all these arrays will have exactly the size that corresponds to the number of SNe
- ! in the chosen subset.
- !
- !!
- !AL sept 09: changed not to use non-standard allocatable arrays in derived types
- !            .dataset read using standard INI framework
- module sn_sdss_parser
-   use AmlUtils
-   use IniFile
-   implicit none
-   private
- 
-   logical :: sdss_sn_ini = .false.
-   integer, parameter :: maxit = 10000, sn_len=128, sn_head=32, sn_dlen=Ini_max_string_len
-   integer, parameter :: dp=KIND(1.d0)
- !  character(len=32), parameter :: sntag(3)=/'NVAR:','VARNAMES:','SN:'/
- 
-   type ReallocArray2
-     real(dp), dimension(:,:), pointer :: Arr
-   end type ReallocArray2
- 
-   type sdssvars
-      character(len=sn_dlen) :: filename(2)
-      character(len=sn_head) :: tagnvar, tagvarnames, tagsn, subset
-      character(len=sn_head), pointer :: colnames(:)
-      character(len=1) :: presets(6)
-      integer :: ntags, telids(10), set
-      real(dp), pointer :: sdss_sigint(:)
-   end type sdssvars
-   type(sdssvars) :: sv
- 
-   type sdssdata
-      real(dp), pointer :: mu(:), muerr(:), z(:), sigint(:), sigz(:)
-   end type sdssdata
- 
-   public GetSDSSSn, sdssdata
- 
- contains
- 
-   subroutine GetSDSSSn(thisfilename, thedata, feedback)
-     character(len=*) :: thisfilename
- !    character(len=sn_head) :: thissubset, thissubsetb
- !    integer :: thisset, thissetb
-     integer :: feedback
-     type(sdssdata) :: thedata
-     character(len=128) :: mystring
- 
-     call ReadSDSSdataset(thisfilename)
- 
- !    thissubsetb = thissubset
- !    thissetb = thisset
-     call InitializeSN(sv%set, sv%subset)
-     
- 
-     call ReadSDSSSN(sv%set, sv%subset, thedata)
- 
-     ! Feedback which telescopes are uesd.
-     if(feedback>0)then
-        write(*,*)'Reading: '//trim(adjustl(sv%filename(sv%set)))
-        write(mystring,*)size(thedata%z)
-        mystring = 'Using '//trim(adjustl(mystring))//' SNe'
-        mystring = trim(adjustl(mystring))//' from subset '
-        if(any(sv%telids.eq.1))mystring = trim(adjustl(mystring))//' SDSS +'
-        if(any(sv%telids.eq.3))mystring = trim(adjustl(mystring))//' ESSENCE +'
-        if(any(sv%telids.eq.4))mystring = trim(adjustl(mystring))//' SNLS +'
-        if(any(sv%telids.eq.50))mystring = trim(adjustl(mystring))//' LOWZ +'
-        if(any(sv%telids.eq.100))mystring = trim(adjustl(mystring))//' HST +'
-        mystring=mystring(1:len(trim(mystring))-2)//'  '
-        write(*,*)trim(adjustl(mystring))//'.'
-     end if
- 
-   end subroutine GetSDSSSn
- 
- 
-   subroutine InitializeSN(thisset, thissubset)
-     implicit none
-     character :: mychar
-     character(len=*) :: thissubset
-     integer :: ntel, thisset, maxtel
- 
- 
-     if(sdss_sn_ini)stop 'Calling InitializeSN more than once.'
- 
-     ! All in upper case
-     sv%tagnvar = 'NVAR:'
-     sv%tagvarnames = 'VARNAMES:'
-     sv%tagsn = 'SN:'
- 
-     ! These are the names of the columns, where MU gets the extra character that is the input in
-     ! GetSDSSSn('x',...). That is, the actual column becomes sv%colnames(2)//'x'. If this is 
-     ! not present in your file, then input ' ' in stead of 'x'.
- 
-     sv%ntags=5
- 
-     allocate(sv%colnames(sv%ntags))
- 
-     sv%colnames(1) = 'Z'
-     sv%colnames(2) = 'MU'
-     sv%colnames(3) = 'MUERR'
-     sv%colnames(4) = 'ZERR'
-     sv%colnames(5) = 'IDTEL'
-     
-     ! If SALT-II, then:
-     ! attach 'e' because we want the column that contains just all the data.
-     ! We then select the proper telescopes for our subset ourselves, as the 
-     ! a - f subsets are hardcoded in the next lines.
-     if (thisset .eq.2) then 
-        sv%colnames(2) = trim(adjustl(sv%colnames(2))) //'E'    
-        sv%colnames(3) = trim(adjustl(sv%colnames(3))) //'E'
-     end if
- 
-     ! interpret thisset:
-     thissubset = adjustl(thissubset)
-     sv%telids = 0
-     sv%presets(:)=(/'a','b','c','d','e','f'/)
- 
-     mychar = thissubset(1:1)
-     if(ichar(thissubset(1:1)).lt.58)then ! then it's a number
-        ntel = CountItemsIn(trim(adjustl(thissubset)))
-        read(thissubset,*)sv%telids(1:ntel)
-     else if (any(thissubset(1:1).eq.sv%presets))then
-        if(thissubset(1:1).eq.'a')sv%telids(1)=1
-        if(thissubset(1:1).eq.'b')sv%telids(1:3)=(/1,3,4/)
-        if(thissubset(1:1).eq.'c')sv%telids(1:2)=(/1,50/)
-        if(thissubset(1:1).eq.'d')sv%telids(1:4)=(/1,3,4,50/)
-        if(thissubset(1:1).eq.'e')sv%telids(1:5)=(/1,3,4,50,100/)
-        if(thissubset(1:1).eq.'f')sv%telids(1:3)=(/3,4,50/)
-     else
-        stop 'No subset defined for sn_sdss!'
-     end if
- 
- 
-     ! set intrinsic uncertainty for this dataset
-     maxtel = 100 ! highest telesope id
- !    if(allocated(sv%sdss_sigint))deallocate(sv%sdss_sigint)
-     allocate(sv%sdss_sigint(1:maxtel))
-     
-     ! As specified in arXiv:0908.4274v1 
-     ! table 11 for SALT and paragraph 8.1 for MLCS
- 
-     if(thisset.eq.1)then ! MLCS
-        sv%sdss_sigint = 0.16 ! use same intrinsic error for all telescopes
-     else if (thisset .eq.2) then !SALT-II
-        sv%sdss_sigint = 0.d0
-        sv%sdss_sigint(1) = 0.09 ! SDSS
-        sv%sdss_sigint(3) = 0.13 ! ESSENCE
-        sv%sdss_sigint(4) = 0.16 ! SNLS
-        sv%sdss_sigint(50) = 0.16 ! LOWZ
-        sv%sdss_sigint(100) = 0.15 ! HST
-     else
-        stop 'Need to define intrinsic errors for this set.'
-     end if
-     sdss_sn_ini = .true.
-     
-     
-   end subroutine InitializeSN
- 
- 
-   ! Open the actual file and process it, returns thedata containing
-   ! only the SNe from subset of nset.
-   subroutine ReadSDSSSN(nset, thisset, thedata)
-     character(len=512) :: thisline
-     character(len=sn_head) :: thistag, thisfmt, thisname
-     character(len = 1) :: thisset
-     integer :: fnum,nset,myiostat
-     logical :: snexist
- 
-     integer :: nvar, i
-     Type(ReallocArray2) ::sdss_file
-     character(len=sn_head), allocatable :: header(:)
-     
-     type(sdssdata) :: thedata
- 
-     fnum=NewIONum()
- 
-     inquire(file=sv%filename(nset),exist=snexist)
-     if(.not.snexist)then
-        write(*,*)'File '//trim(sv%filename(nset))//' not found. ABORTING.'
-        stop 'File not found.'
-     end if 
-    open(fnum, file=sv%filename(nset), status='OLD', iostat=myiostat)
- 
- 
-     ! First get nvar
-     myiostat=0
-     Do while (myiostat.eq.0)
- 
-        read(fnum,'(A)',iostat=myiostat)thisline
- 
-        if(myiostat.ne.0)then
-           write(*,*)'Tag '//trim(sv%tagnvar)//' not found in file '//trim(sv%filename(nset))//' not found. ABORTING.'
-           stop 'Tag not found.'
-        end if
- 
-        thisline=trim(adjustl(thisline))
-        thistag = thisline(1:len(trim(sv%tagnvar)))
-        call s_cap(thistag)
-        if(trim(thistag).eq.sv%tagnvar)then
-           call RemoveExp(thisline,trim(sv%tagnvar))
-           read(thisline,*)nvar
-           exit
-        end if
-     end Do
- 
- 
-     ! Get header
-     allocate(header(nvar))
-     myiostat=0
-     Do while (myiostat.eq.0)
-        read(fnum,'(A)',iostat=myiostat)thisline
-        if(myiostat.ne.0)then
-           write(*,*)'Tag '//trim(sv%tagvarnames)//' not found in file '//trim(sv%filename(nset))//' not found. ABORTING.'
-           stop 'Tag not found.'
-        end if
-        thisline=trim(adjustl(thisline))
-        thistag =thisline(1:len(trim(sv%tagvarnames)))
-        call s_cap(thistag)
-        if(trim(thistag).eq.trim(sv%tagvarnames))then
-           call RemoveExp(thisline,trim(sv%tagvarnames))
-           read(thisline,*)header(:)
-           exit
-        end if
-     end Do
- 
-     ! make header data uppercase:
-     do i=1,nvar
-        call s_cap(header(i))
-     end do
- 
-     ! We could make the code more flexible
-     ! in order to deal with CID in any other column,
-     ! but why bother...
-     if(trim(adjustl(header(1))).ne.'CID')then
-        stop 'Wrong file layout: first column must be SN:, second column CID.'
-     end if
-     ! anticipate the ignoring of the CID, the real array sdss_file starts 
-     ! at second column in stead of first.
-     header=header(2:)
-     header(size(header))=''
- 
- 
-     ! Get data
-     call AllocDble(sdss_file,nvar-1)
-     myiostat=0
-     i=0
-     Do while (myiostat .eq.0)
-        read(fnum,'(A)',iostat=myiostat)thisline
-        if(myiostat.ne.0)exit
-        thisline=trim(adjustl(thisline))
- 
- 
-        ! ignore lines that do not start with 'SN:'
-        if(thisline(1:len(trim(sv%tagsn))).eq.sv%tagsn)then
-           
-           i=i+1
-           ! check array size, if necessary increase
-           if(i.gt.size(sdss_file%arr(1,:)))call IncreaseDble(sdss_file)
-           
-           call RemoveExp(thisline,trim(sv%tagsn))
-           read(thisline,*)thisname,sdss_file%arr(:,i)
-        end if
- 
-     end Do
- 
-     call TrimDble(sdss_file,i)
- 
-     call TranslateSDSS(thisset, header, sdss_file, thedata)
- 
- 
-     deallocate(header)
-     deallocate(sdss_file%arr)
- 
-   end subroutine ReadSDSSSN
- 
- 
-   ! Go from full fitres file to only interesting columns
-   ! from subset.
-   subroutine TranslateSDSS(thissetd, header, sdss_file, thedata)
-     implicit none
-     character(len=1) :: thissetd, thissetabc
-     character(len=sn_head) :: header(:), tags(sv%ntags)
-     Type(ReallocArray2) :: sdss_file
-     type(sdssdata) :: thedata
-     integer :: i,j, totsn, setsn, tagn(sv%ntags)
- 
-     thissetabc=thissetd
-     call s_cap(thissetabc)
- 
-     tags(1) = trim(adjustl(sv%colnames(1)))
-     tags(2) = trim(adjustl(sv%colnames(2)))
-     tags(3) = trim(adjustl(sv%colnames(3)))
-     ! we are taking set 'thisset', that is MUA, or MUB, or MUC etc..
-     tags(4) = trim(adjustl(sv%colnames(4)))
-     tags(5) = trim(adjustl(sv%colnames(5)))
- 
- 
-     ! get column number of tags: 
-     tagn=0
-     do i=1,size(header)
-        do j=1,sv%ntags
-           if(trim(adjustl(header(i))).eq.trim(adjustl(tags(j))))tagn(j)=i
-        end do
-     end do
-     if(any(tagn.eq.0))stop 'Tags not found in translatesdss (in sn_sdss_parser.f90).'
- 
-     ! count SN in set:
-     totsn =size(sdss_file%arr(1,:)) 
-     setsn=0
- 
-     do i=1,totsn
-        if(any(int(sdss_file%arr(tagn(5),i)+0.001).eq.sv%telids))setsn=setsn+1
-     end do
- 
- 
-   !  if(allocated(thedata%z))deallocate(thedata%z)
-   !  if(allocated(thedata%mu))deallocate(thedata%mu)
-   !  if(allocated(thedata%muerr))deallocate(thedata%muerr)
-   !  if(allocated(thedata%sigint))deallocate(thedata%sigint)
-   !  if(allocated(thedata%sigz))deallocate(thedata%sigz)
-     allocate(thedata%z(setsn))
-     allocate(thedata%mu(setsn))
-     allocate(thedata%muerr(setsn))
-     allocate(thedata%sigint(setsn))
-     allocate(thedata%sigz(setsn))
- 
-     j=0
-     do i=1,totsn
- 
- !       if(sdss_file(tagn(2),i).gt.-8.9999)then
-        if(any(int(sdss_file%arr(tagn(5),i)+0.001).eq.sv%telids))then
-           j=j+1
-           thedata%z(j)=sdss_file%arr(tagn(1),i)
-           thedata%mu(j)=sdss_file%arr(tagn(2),i)
-           thedata%muerr(j)=sdss_file%arr(tagn(3),i)
-           thedata%sigz(j)=sdss_file%arr(tagn(4),i)
-           thedata%sigint(j)=sv%sdss_sigint(int(sdss_file%arr(tagn(5),i)+0.001))
-        end if
- 
-     end do
- 
-     if(j.ne.setsn) stop 'There is a bug in the code, TranslateSDSS in sn_sdss_parser.f90.'
- 
-   end subroutine TranslateSDSS
- 
-   ! Allocate a double precision array with two indices
-   subroutine AllocDble(A,somesize1)
-     Type(ReallocArray2) :: A
-     integer :: somesize1
- 
-     !if(associated(A%arr))deallocate(A%arr)
-     allocate(A%arr(somesize1,sn_len))
- 
-   end subroutine AllocDble
- 
-   ! Increase the size in second index of a double precision array with two indices
-   subroutine IncreaseDble(A)
-     Type(ReallocArray2) :: A
-     real(dp), allocatable :: arr2(:,:)
-     integer :: arrsize(2)
- 
-     arrsize(1) = size(A%arr(:,1))
-     arrsize(2) = size(A%arr(1,:))
-     allocate(arr2(arrsize(1),arrsize(2)))
-     arr2=A%arr
-     deallocate(A%arr)
-     allocate(A%arr(arrsize(1),arrsize(2)+sn_len))
-     A%arr=0
-     A%arr(:,1:arrsize(2))=arr2(:,:)
- 
-     deallocate(arr2)
-   end subroutine IncreaseDble
- 
-   ! Trim in second index of a double precision array with two indices to size 'finsize'
-   subroutine TrimDble(A,finsize)
-     Type(ReallocArray2) :: A
-     real(dp), allocatable :: arr2(:,:)
-     integer, optional :: finsize
-     integer :: arrsize(2)
- 
-     if(.not.present(finsize))call fatalerror('TrimSing called without final size. Faulty code.')
- 
-     arrsize(1) = size(A%arr(:,1))
-     arrsize(2) = size(A%arr(1,:))
-     allocate(arr2(arrsize(1),arrsize(2)))
-     arr2=A%arr
-     deallocate(A%arr)
-     allocate(A%arr(arrsize(1),finsize))
-     A%arr=0
-     A%arr=arr2(:,1:finsize)
- 
-     deallocate(arr2)
-   end subroutine TrimDble
- 
-   ! return a free io-number for file-io
-   function NewIONum()
-     integer :: NewIONum, i
-     logical :: notfree
- 
-     notfree = .true.
-     i=20
-     
-     do while (notfree)
-        i=i+1
-        inquire(i,opened=notfree)
-        if(i.gt.maxit)call FatalError('NewIONum could not find free filenumber.')
-     end do
-     NewIONum = i
-     
-   endfunction NewIONum
-   
-   ! open existing file for append, or create if nonexistent.
-   subroutine OpenAppend(fnum,fname)
-     character(len=*) :: fname
-     integer :: fnum
-     logical fpresent
-     
-     inquire(file=trim(adjustl(fname)),exist=fpresent)
-     
-     if(fpresent)then
-        open(fnum,file=fname,status='OLD',access='APPEND')
-     else
-        open(fnum,file=fname,status='NEW')
-     end if
-     
-   end subroutine OpenAppend
-   
-   
-   ! split string into two pieces, first half goes into word, second half
-   ! into string. Split point is set by 'seperator', which itself is thrown away
-   subroutine split(string,word,seperator)
-     character(len=*)::string,word,seperator
-     integer :: i,sep
-     
-     string = adjustl(string)
-     sep = len(seperator)-1
-     do i = 1,len(trim(string))!+2
-        if(string(i:i+sep).eq.seperator)then
-           word=trim(string(1:i-1))
-           string=trim(string(i+sep+1:))
-           exit
-        end if
-     enddo
-   end subroutine split
-   
-   ! Remove an expression from string.
-   subroutine RemoveExp(string,seperator)
-     character(len=*)::string,seperator
-     integer :: i,sep
-     
-     !string = adjustl(string)
-     sep = len(seperator)
-     do i = 1,len(trim(string))-sep+1
-        if(string(i:i+sep-1).eq.seperator)then
-           if(i.gt.1)then
-              string=string(:i-1)//trim(string(i+sep:))
-           else
-              string=trim(string(i+sep:))
-           end if
-        end if
-     enddo
-   end subroutine RemoveExp
-   
-   ! Replace expression 'seperator' in 'string' by 'word'.
-   subroutine ReplaceExp(string,seperator,word)
-     character(len=*)::string,seperator,word
-     integer :: i,sep,j
-     
-     !if(seperator.eq.'%fnumber')then
-     !debug=.false.
-     !else
-     !debug=.false.
-     !end if
-     !string = adjustl(string)
-     sep = len(seperator)
-     i=0
-     j=0
-     do
-        i=i+1
-        j=j+1
-        !   if(debug)write(*,*)string(i:i+sep-1),',',seperator
-        if(string(i:i+sep-1).eq.seperator)then
-           !   if(debug)then
-           !   write(*,*)'Whoopie!'
-           !write(*,*)'----------------------------------------------------------'
-           !    write(*,*)string(:i-1)
-           !write(*,*)'----------------------------------------------------------'
-           !    write(*,*)adjustl(word)
-           !write(*,*)'----------------------------------------------------------'
-           !    write(*,*)string(i+sep:)
-           !write(*,*)'----------------------------------------------------------'
-           !stop
-           !    end if
-           if(i.gt.1)then
-              string=string(:i-1)//adjustl(word)//string(i+sep:)
-           else
-              string=adjustl(word)//string(i+sep:)
-           end if
-           if (sep.ne.len(word)) i=i+len(word)-sep
-        end if
-        if (i .ge. len(trim(string))-sep+1) exit
-        if (j.gt. 1000*len(string))call fatalerror('ReplaceExp is hanging.')
-     enddo
-   end subroutine ReplaceExp
-   
-   ! Grab expression surrounded by initag and endtag in string. 
-   ! Result is word.
-   ! Stops is tags are not found.
-   subroutine GetFromTags(string,word,initag,endtag)
-     character(len=*), intent(in) :: string
-     character(len=len(string)) :: mystring1, mystring2
-     character(len=*), intent(out) :: word
-     character(len=*), intent(in) :: initag
-     character(len=*), intent(in) :: endtag
-   
-     mystring1 = string
- 
-     mystring2=''
-     call split(mystring1,mystring2,initag)
-     if(len(trim(mystring2)).eq.0)then
-        write(*,*)'Tag '//trim(adjustl(initag))//' not found.'
-        stop 'Tag not found (GetFromTags in sn_sdss_parser).'
-     end if
- 
-     mystring2=''
-     call split(mystring1,mystring2,endtag)
-     if(len(trim(mystring2)).eq.0)then
-        write(*,*)'Tag '//trim(adjustl(initag))//' not found.'
-        stop 'Tag not found (GetFromTags in sn_sdss_parser).'
-     end if
- 
-     word = trim(adjustl(mystring2))
-     
-   end subroutine GetFromTags
- 
- 
-   ! Count the number of space-separated items in mystr
-   function CountItemsIn(mystr)
-     implicit none
-     integer :: CountItemsIn, i, j
-     character(len=*) :: mystr
- 
-     j=0
-     do i=1,len(mystr)
-        if(mystr(i:i).eq.' ')then
-           if(i.eq.1)then
-              j=j+1
-           else if((i.gt.1).and.(mystr(i-1:i-1).ne.' '))then
-              j=j+1
-           end if
-        end if
-     end do
-     CountItemsIn = j + 1
- 
-   end function CountItemsIn
- 
- ! subroutine ch_cap taken from chrpak at
- ! http://orion.math.iastate.edu/burkardt/f_src/chrpak/chrpak.html
- ! at 08/09/2009
-   subroutine ch_cap ( c )
-     !
-     !*******************************************************************************
-     !
-     !! CH_CAP capitalizes a single character.
-     !
-     !
-     !  Modified:
-     !
-     !    19 July 1998
-     !
-     !  Author:
-     !
-     !    John Burkardt
-     !
-     !  Parameters:
-     !
-     !    Input/output, character C, the character to capitalize.
-     !
-     implicit none
-     !
-     character c
-     integer itemp
-     !
-     itemp = ichar ( c )
-     
-     if ( 97 <= itemp .and. itemp <= 122 ) then
-        c = char ( itemp - 32 )
-     end if
-     
-     return
-   end subroutine ch_cap
-   
-   
- ! subroutine ch_cap taken from chrpak at
- ! http://orion.math.iastate.edu/burkardt/f_src/chrpak/chrpak.html
- ! at 08/09/2009
-   subroutine s_cap ( s )
-     !
-     !*******************************************************************************
-     !
-     !! S_CAP replaces any lowercase letters by uppercase ones in a string.
-     !
-     !
-     !  Modified:
-     !
-     !    28 June 2000
-     !
-     !  Author:
-     !
-     !    John Burkardt
-     !
-     !  Parameters:
-     !
-     !    Input/output, character ( len = * ) S, the string to be transformed.
-     !
-     implicit none
-     !
-     character c
-     integer i
-     integer nchar
-     character ( len = * ) s
-     !
-     nchar = len_trim ( s )
- 
-     do i = 1, nchar
- 
-        c = s(i:i)
-        call ch_cap ( c )
- !       if(len(s).eq.1)then
- !          s=''
- !          s=c
- !       else
-        s(i:i) = c
- !       end if
- 
-     end do
-     return
-   end subroutine s_cap
-   
-   subroutine FatalError(msg)
-     character(len=*) :: msg
-   
-        write(*,*) msg
-        call MpiStop('sn_sdsss_parser: ABORTING DUE TO FATAL ERROR.')
-     
-   end subroutine FatalError
- 
-   
-   ! Open and parse the .dataset-file which contains
-   ! the parameters needed in order to 
-   ! parse the FITRES files
-   ! (paths, set and subset)
-   subroutine ReadSDSSdataset(thisfilename)
-     use Settings
-     character(len=*) :: thisfilename 
-     character(len=sn_head) :: setstring
-     integer :: fnum
-     type(TIniFile) :: Ini
-     logical bad
- 
-     
-     fnum = NewIONum()
-     call Ini_Open_File(Ini, thisfilename, fnum, bad, .false.)
-     
-     if(bad)then
-        write(*,*)'File '//trim(thisfilename)//' not found. ABORTING.'
-        call MpiStop('File not found.')
-     end if
-    
-     sv%filename(1) = ReadIniFileName(Ini,'MLCSfile')
-     sv%filename(2) = ReadIniFileName(Ini,'SALTfile')
-     setstring = Ini_Read_String_File(Ini,'SDSS_set')
-     sv%subset =  Ini_Read_String_File(Ini,'SDSS_subset')
-   
-     read(setstring,*)sv%set
-     call Ini_Close_File(Ini)
-     
-   end subroutine ReadSDSSdataset
- 
- end module sn_sdss_parser
--- 0 ----
diff -r -c -b -B -N cosmomc/source/supernovae.f90 cosmomc_sampler/source/supernovae.f90
*** cosmomc/source/supernovae.f90	2009-09-15 18:02:10.000000000 +0200
--- cosmomc_sampler/source/supernovae.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,138 ****
- !
- ! SDSS MLSC / SALT-II Supernovae Ia datasets, 
- ! Including HST, SNLS, ESSENCE and Lowz
- !
- !
- ! This module uses the data as presented in arXiv:0908.4274v1 
- !
- ! By Wessel Valkenburg, LAPTH, 2009, containing traces of the original 
- ! code by A Lewis, S Bridle and D Rapetti. 
- ! E-mail: wessel.valkenburg@lapp.in2p3.fr
- 
- include 'sn_sdss_parser.f90'
- 
- module snovae
-   use cmbtypes
-   use MatrixUtils
-   implicit none
-   
-   private
- 
-    integer :: SN_num
-    double precision, parameter :: Pi_num = 3.14159265359D0 
-    double precision, allocatable :: SN_z(:), SN_moduli(:)
-    double precision, allocatable :: SN_Ninv(:,:)
-    double precision, allocatable :: allDA(:)
-    double precision :: SN_sumninv
- 
-    character(len=256) :: SN_filename = ''
-    
-    logical, parameter :: SN_marg = .True.
- 
-    public SN_LnLike, SN_filename
- 
-  contains
- 
-    subroutine SN_init
-      use sn_sdss_parser
-      implicit none
- 
-      type(sdssdata) :: thisdata
- 
-      character (LEN=20):: name
-      integer i
-      real :: tmp_mat(sn_num, sn_num)
-      double precision :: thissigz
- 
-      if (Feedback > 0) write (*,*) 'Reading: supernovae data (SDSS).'
- 
-      ! Get the data - hardcode the right path here:
-      if (SN_filename =='') SN_filename = trim(DataDir) // 'supernovae.dataset'
-      call GetSDSSSN(SN_filename, thisdata, feedback)
- 
- 
-      ! Set the sigmas etc
-      SN_Num = size(thisdata%z)
- 
-      allocate(SN_z(SN_Num))
-      allocate(allDA(SN_Num))
-      allocate(SN_moduli(SN_Num))
-      allocate(SN_Ninv(SN_Num,SN_Num))
- 
-      SN_z = thisdata%z
-      SN_moduli = thisdata%mu
- 
-      SN_Ninv = 0.d0
-      do i=1,SN_Num
-         thissigz = thisdata%sigz(i) * (5.d0/dLog(10.d0)) * (1+thisdata%z(i))/(1+thisdata%z(i)/2.d0)/thisdata%z(i)
-         SN_Ninv(i,i) = (thisdata%muerr(i)**2+thisdata%sigint(i)**2+thissigz**2)**(-1)
-      end do
- 
- 
-      SN_sumninv = SUM(sn_ninv)
- 
- 
-    end subroutine SN_init
- 
-    function SN_LnLike(CMB)
-      use camb
-      !Assume this is called just after CAMB with the correct model  use camb
-      implicit none
-      type(CMBParams) CMB
-      logical, save :: do_SN_init = .true.
- 
-      real SN_LnLike
-      integer i, sni
-      double precision z, AT, BT
-      real, allocatable :: diffs(:)
-      real chisq
- 
-      if (do_SN_init) then 
-         call SN_init
-         do_SN_init = .false.
-      end if
- 
-      allocate(diffs(SN_Num))
- 
-      call DzArray(SN_z,allDA)
- 
- 
-      diffs(:) = 5*log10((1+SN_z(:))**2*allDA(:))+25 - SN_moduli(:)
- 
- 
-      AT = dot_product(diffs,matmul(sn_ninv,diffs))
-      if(SN_marg)then
-         BT = SUM(matmul(sn_ninv,diffs))
-      else
-         BT=0.d0
-      end if
-   
-      deallocate(diffs)
-      
-      !! H0 normalisation alla Bridle and co. 
-      chisq = AT-BT**2/sn_sumninv
- 
-      if (Feedback > 1) write (*,*) 'SN chisq: ', chisq
- 
-      SN_LnLike = chisq/2.
- 
-    end function SN_LnLike
- 
-   subroutine DzArray(SNz,ThisDz)
-     use camb
-     implicit none
-     !real(dl) :: z, dum
-     real(dl), intent(in) :: SNz(:)
-     real(dl), intent(out) :: ThisDz(:)
-     integer :: i
- 
-     
-     do i = 1,size(SNz)
-        ThisDz(i) = AngularDiameterDistance(SNz(i))
-     end do
-     
-     ! Or write code here for other distances, in a void etc. etc.
-     
-   end subroutine DzArray
-   
- end module snovae
--- 0 ----
diff -r -c -b -B -N cosmomc/source/supernovae_ReissSNLS.f90 cosmomc_sampler/source/supernovae_ReissSNLS.f90
*** cosmomc/source/supernovae_ReissSNLS.f90	2006-05-03 01:24:20.000000000 +0200
--- cosmomc_sampler/source/supernovae_ReissSNLS.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,143 ****
- !Edit SN_usexxx parameters below; SNLS by default
- !SN_useRiess: Use the gold sample SNe Ia of Riess et al.(2004)
- !   See astro-ph/0402512 
- !SN_useSNLS: use SNLS astro-ph/0510447
- 
- !May 2004 (modified by David Rapetti)
- !May 2006: includes SNLS option (thanks to Anze Slosar)
- 
- !Marginalize anayltically over H_0 with flat prior 
- !(equivalent to mariganlize over M, absolute magnitude; see appendix F of cosmomc paper) 
- !resultant log likelihood has arbitary origin, but is returned equal
- !to the best-fit value.
- module snovae
- use cmbtypes
- implicit none
- 
-  integer, parameter :: riessN=157, snlsN=115
-  integer, parameter :: SN_num = riessN+snlsN
-  double precision, parameter :: Pi_num = 3.14159265359D0 
-  double precision :: SN_z(SN_num), SN_moduli(SN_num), SN_diagerr(SN_num)
-  double precision :: SN_Ninv(SN_num,SN_Num), SN_Ninvmarge(SN_num,SN_Num)
-  double precision :: aprima, bprima, cprima, a1
-  double precision :: SN_trNinv
-  logical :: do_SN_init = .true.
- 
-  logical, parameter :: SN_marg = .true.
-  logical, parameter :: SN_useRiess=.false.
-  logical, parameter :: SN_useSNLS=.true.
- 
- contains
- 
- 
-  subroutine SN_init
-    character (LEN=1200) :: InLine
-    character (LEN=20) :: names(186)
-    double precision :: input (186,3)
-    integer gold(riessN)
-    integer i
- 
-    if (Feedback > 0) write (*,*) 'reading: supernovae data'
-    call OpenTxtFile('data/sn_data_riess.dat',tmp_file_unit)
-    read(tmp_file_unit,'(a)') InLine
-    do i=1, 186
-       read(tmp_file_unit, *) names(i), input(i,:)
-    end do
-    close(tmp_file_unit)
- 
- !Use only those supernovae used for `gold sample'
-    gold = (/(I, I=1, 29), 32, 33, 34, 35, 37, (I, I=42,45)&
-         ,(I,I=48,57),60,62,63,64,65,68,69,(I,I=71,90),(I,I=92,105)&
-         ,107,(I,I=109,121),(I,I=123,131),133,134,135,136,137,138&
-         ,(I,I=140,144),(I,I=146,161),163,164,169,170,171,173&
-         ,174,(I,I=176,186)/)
- 
-    SN_z(1:riessN) = input(gold,1)
-    SN_moduli(1:riessN) = input(gold,2)
-    SN_diagerr(1:riessN) = 1/input(gold,3)**2 !included the extra velocities (see Riess et al.(2004))
- 
- !!! Now add snls
-    call OpenTxtFile('data/snls.dat',tmp_file_unit)
-    do i=riessN+1, sn_Num
-       read(tmp_file_unit, *) SN_z(i), sn_moduli(i), sn_diagerr(i)
-       sn_diagerr(i)=1d0/sn_diagerr(i)**2
-    end do
-    close(tmp_file_unit)
-    
- 
-    SN_trNinv = sum(SN_diagerr)
-    do_SN_init = .false.
- 
-  end subroutine SN_init
- 
-  function SN_LnLike(CMB)
-   !Assume this is called just after CAMB with the correct model
-   use camb
-   implicit none
-   type(CMBParams) CMB
-   real SN_LnLike
-   integer i,kk,aa,bb
-   double precision z
-   real diffs(SN_num), chisq
- 
-   if (do_SN_init) call SN_init
- 
-      !$OMP PARALLEL DO DEFAULT(SHARED),SCHEDULE(STATIC), PRIVATE(z,i)
-      do i=1, SN_num
-         !Obviously this is not v efficient...
- 
-         if ((i.le.riessN).and.(.not.SN_useRiess)) cycle
-         if ((i.gt.riessn).and.(.not.SN_useSNLS)) cycle
-         z= SN_z(i)
-         diffs(i) = 5*log10((1+z)**2*AngularDiameterDistance(z))+25 - SN_moduli(i)
- !        print *, 5*log10((1+z)**2*AngularDiameterDistance(z)*1e5/CMB%h), SN_moduli(i), cmb%h
-      end do
-      !$OMP END PARALLEL DO 
- 
- 
- !!! WE do analytical marginalisation separatelly for riess and SNLS
- 
-      chisq=0
- 
-      do kk=1,2
- 
-         if ((kk.eq.1).and.(.not.SN_useRiess)) cycle
-         if ((kk.eq.2).and.(.not.SN_useSNLS)) cycle
- 
- 
-         if (kk.eq.1) then 
-            aa=1
-            bb=riessN
-         else
-            aa=riessN+1
-            bb=SN_Num
-         end if
- 
-         !analytical marginalization over H_0 (equivaltent for M, absolute magnitude) 
-         
-         
-         aprima = sum(diffs(aa:bb)**2*SN_diagerr(aa:bb))
-         bprima = sum(diffs(aa:bb)*SN_diagerr(aa:bb))
-         cprima = sum(SN_diagerr(aa:bb))
- !        print *,aprima, cprima
-      
-         if (sn_marg) then 
-            ! to calculate the abslolute chisquare 
-            
-            a1=log(cprima/(2*Pi_num))
-            chisq=chisq+a1+aprima-((bprima**2)/(cprima))
-         else
-            chisq=chisq+aprima
-         end if
- 
-      end do
- 
- 
- !     if (Feedback > 1) write (*,*) 'SN chisq: ', chisq
-      SN_LnLike = chisq/2
- 
- !     stop
-  end function SN_LnLike
- 
- 
- end module snovae
--- 0 ----
diff -r -c -b -B -N cosmomc/source/supernovae_Union.f90 cosmomc_sampler/source/supernovae_Union.f90
*** cosmomc/source/supernovae_Union.f90	2009-05-19 16:34:31.000000000 +0200
--- cosmomc_sampler/source/supernovae_Union.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,111 ****
- !
- ! UNION Supernovae Ia dataset
- !
- !
- ! This module uses the Union compilation. Please cite "Kowalski et
- ! al. (The Supernova Cosmology Project), Ap.J., 2008.".  If the Union
- ! compilation is included in any other data sets that are distributed,
- ! please include this citation request there too.
- !
- ! By A Slosar, heavily based on the original code by A Lewis, S Bridle
- ! and D Rapetti. E-mail: Anze Slosar (anze@berkeley.edu) for questions
- ! about the code and David Rubin (rubind@berkeley.edu) for questions
- ! regarding the dataset itself.
- !
- ! Marginalizes anayltically over H_0 with flat prior.  (equivalent to
- ! marginalizing over M, absolute magnitude; see appendix F of cosmomc
- ! paper). Resultant log likelihood has arbitary origin and is
- ! numerically equal to -chi^2/2 value at the best-fit value.
- 
- 
- module snovae
- use cmbtypes
- use MatrixUtils
- implicit none
- 
-  integer, parameter :: SN_num = 307
-  double precision, parameter :: Pi_num = 3.14159265359D0 
-  double precision :: SN_z(SN_num), SN_moduli(SN_num)
-  double precision :: SN_Ninv(SN_num,SN_Num)
-  double precision :: SN_sumninv
- 
-  logical, parameter :: SN_marg = .True.
-  logical, parameter :: SN_syscovmat = .True.  !! Use covariance matrix with or without systematics
-  
- 
- contains
- 
- 
-  subroutine SN_init
-    use settings
-    character (LEN=20):: name
-    integer i
-    real :: tmp_mat(sn_num, sn_num)
- 
-    if (Feedback > 0) write (*,*) 'Reading: supernovae data'
-    call OpenTxtFile(trim(DataDir)//'sn_z_mu_dmu.txt',tmp_file_unit)
-    do i=1,  sn_num
-       read(tmp_file_unit, *) name, SN_z(i), SN_moduli(i)
-    end do
-    close(tmp_file_unit)
- 
-    if (SN_syscovmat) then
-       call OpenTxtFile(trim(DataDir)//'sn_covmat_sys.txt',tmp_file_unit)
-    else
-       call OpenTxtFile(trim(DataDir)//'sn_covmat_nosys.txt',tmp_file_unit)
-    end if
- 
-    do i=1, sn_num
-       read (tmp_file_unit,*) tmp_mat (i,1:sn_num)
-    end do
-    
-    close (tmp_file_unit)
- 
-    call Matrix_Inverse(tmp_mat)
-    sn_ninv = DBLE (tmp_mat)
- 
-    SN_sumninv = SUM(sn_ninv)
-    
-   end subroutine SN_init
- 
-  function SN_LnLike(CMB)
-    use camb
-   !Assume this is called just after CAMB with the correct model  use camb
-   implicit none
-   type(CMBParams) CMB
-   logical, save :: do_SN_init = .true.
- 
-   real SN_LnLike
-   integer i
-   double precision z, AT, BT
-   real diffs(SN_num), chisq
- 
-   if (do_SN_init) then 
-      call SN_init
-      do_SN_init = .false.
-   end if
- 
- 
- !! This is actually seems to be faster without OMP
-      do i=1, SN_num
-         z= SN_z(i)
-         diffs(i) = 5*log10((1+z)**2*AngularDiameterDistance(z))+25 -sn_moduli(i)
-      end do
-      
-      AT = dot_product(diffs,matmul(sn_ninv,diffs))
-      BT = SUM(matmul(sn_ninv,diffs))
-      
-      !! H0 normalisation alla Bridle and co. 
-      chisq = AT-BT**2/sn_sumninv
- 
-      if (Feedback > 1) write (*,*) 'SN chisq: ', chisq
- 
- 
- 
-      SN_LnLike = chisq/2
- 
- 
-  end function SN_LnLike
- 
- 
- end module snovae
--- 0 ----
diff -r -c -b -B -N cosmomc/source/WeakLen.f90 cosmomc_sampler/source/WeakLen.f90
*** cosmomc/source/WeakLen.f90	2006-03-17 18:18:12.000000000 +0100
--- cosmomc_sampler/source/WeakLen.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,22 ****
- 
- MODULE WeakLen
-  use cmbtypes
-   !Dummy module
- 
-   logical :: Use_WeakLen = .false.
-     
- CONTAINS
-   
-   FUNCTION WeakLenLnLike(CMB, Theory)
-     TYPE (CMBParams) CMB
-     TYPE (CosmoTheory) Theory
-     REAL :: WeakLenLnLike
- 
-        stop 'Weak lensing not implemented'
- 
-    WeakLenLnLike = 0
-     
-   END FUNCTION WeakLenLnLike
- 
- end module
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/WMAP_1yr_likelihood.f90 cosmomc_sampler/source/WMAP_1yr_likelihood.f90
*** cosmomc/source/WMAP_1yr_likelihood.f90	2006-03-17 18:18:12.000000000 +0100
--- cosmomc_sampler/source/WMAP_1yr_likelihood.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,456 ****
- ! WMAP likelihood code
- ! Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- !
- ! F90 version by Antony Lewis Feb 03
- 
- !****************************************************************************
- ! If you use this code in any publication, please cite Verde et al. (2003),
- ! Hinshaw et al. (2003) and Kogut et al. (2003). 
- !****************************************************************************
- 
- 
- ! History
- ! 28 Feb 03: AL
- !   * Fixed reading in of lmax'th element of TE array
- !   * Uses packed array storage (1/2 memory use)
- !   * Switch to functions, consistent naming scheme
- ! 27 Feb 03: AL 
- !   * Change to add in off-diagonal TT Fisher only if the model is not a very bad fit
- !      -- prevents erroneous high likelihoods being returned for very bad fit models 
- !   * F90 translation, misc changes, deletion of separate Fisher routines
- !   * Re-organized to use symmetries (2*speed up) 
- ! 21 Feb 03: WMAP
- !   * Fixed bug reading in off-diagonmal TE matrix.
- !     -- changed likelihoods slightly, no significant effect on parameter estimates
- !     (importance weights of order 3 relative to buggy version)
- 
- ! This file contains a set of Fortran subroutines that compute likelihoods
- ! for a set of theoretical cl's:
- !    WMAP_init_TT      - Loads TT data files
- !                               Call this routine once before calling
- !                               WMAP_LnLike_TT
- !    WMAP_init_TE      - Loads TE data files.
- !                               Call this routine once before calling
- !                               WMAP_LnLike_TE
- !    WMAP_init         - Calls WMAP_init_TT and WMAP_init_TE.
- !    WMAP_LnLike_TT    - Computes temperature data likelihoods.
- !    WMAP_LnLike_TE    - Computes TE data likelihoods.
- !
- ! The methods used here are described in the following references:
- !    Verde, L., et.al. 2003, ApJ, submitted. astro-ph/0302218
- !    Bond, J.R., Jaffe, A.H., and Knox, L., 2002, ApJ, 533
- !
- ! ===========================================================================
- !   "WMAP_init_TT" fills the common block used by
- !   "WMAP_LnLike_TT"---this is the initialization subroutine.
- !
- !   Inputs:
- !      clFile  - The name of the file containing the cl data.
- !      offDiag - The name of the file containing the off-diagonal terms.
- !
- !   Outputs:
- !      stat - A status code:  0=success.
- !
- !   Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- ! ===========================================================================
- 
-     module WMAP
-      implicit none
-       private
- 
-       integer, parameter :: WMAP_lmax_TT = 900, WMAP_lmax_TE = 450, &
-              WMAP_lmax_TE_file = 512 
-     
-       integer, parameter :: WMAP_lmin_TT = 2, WMAP_lmin_TE = 2
-      !Can change l_min here to remove e.g. quadrupole 
- 
-       integer, parameter :: wp = KIND(1.0)
-       integer, parameter :: WMAP_precision =wp
- !TT data
-       real(wp) cl_data(WMAP_lmax_TT), neff(WMAP_lmax_TT), fskyeff(WMAP_lmax_TT)
-       real(wp) r_off_diag(((WMAP_lmax_TT-1)*(WMAP_lmax_TT-2))/2)
-       real(wp) off_diag(((WMAP_lmax_TT-1)*(WMAP_lmax_TT-2))/2)
- 
- !TE data
-       real(wp) te_data(WMAP_lmax_TE),ntt(WMAP_lmax_TE),nee(WMAP_lmax_TE)
-       real(wp) te_off_diag(((WMAP_lmax_TE-1)*(WMAP_lmax_TE-2))/2)
-       real(wp) te_tt(WMAP_lmax_TE)
- 
- !Public constant and subroutines 
-       public  WMAP_lmax_TT, WMAP_lmax_TE, WMAP_precision,&
-               WMAP_LnLike_TT,WMAP_LnLike_TE, &
-               WMAP_init_TT, WMAP_init_TE,  WMAP_init             
-     contains
- 
-         SUBROUTINE WMAP_init_TT (clFile, offDiag, stat)
- !
-         IMPLICIT NONE
- !                INPUT
- !                
-         character (*) clFile, offDiag
- !
- !                OUTPUT
- !
-         integer stat
- !
- !                DATA/INTERNAL
- !
-         integer idum, l, ll,i,j,ix
- ! ---------------------------------------------------------------------------
- !               Read the CL data.
- !
-         open (11, file=clFile, status='old', IOStat=stat)
-         if (stat .NE. 0) RETURN
-         rewind(11)
-         do l = 2, WMAP_lmax_TT
-           read (11, *) idum, cl_data(l), neff(l), fskyeff(l)
-           if (idum /= l) stop 'Error reading TT diag'
-         end do
-         close (11)
- !
- !               Read in off diag terms:               
- !               In the *covariance* matrix there are 2 type of terms 
- !               one that does scale with the clth (due to the mask) and 
- !               one that does not (due to beam and point sources marginalization).
- !               In the curvature matrix (what we use here) all the off diagonal 
- !               terms end up scaling with the clth but the 2 contributions scale
- !               in different ways see paper for details
- !               thus here we read them in separately
- !
-         open(11,file=offDiag, status='old', IOStat=stat)
-         if (stat .NE. 0) RETURN
-         rewind(11)
-         ix=1 
-         do  l = 2,WMAP_lmax_TT  
-            do ll= l+1,WMAP_lmax_TT
-               read(11,*) i,j,off_diag(ix),r_off_diag(ix)  
-               if (l >= WMAP_lmin_TT) ix=ix+1 !Skip all entries up to lmin            
-               if (l.ne.i .or. ll .ne. j) stop 'error reading TT off diag' 
-            end do
-         end do
-         close(11)
- ! ---------------------------------------------------------------------------
-         END SUBROUTINE WMAP_init_TT
- ! ===========================================================================
- !   "WMAP_init_TE" fills the common block used by
- !   "compute_mapte_likelihood"---this is the initialization subroutine.
- !
- !   Inputs:
- !      clFile  - The name of the file containing the cl data.
- !      offDiag - The name of the file containing the off-diagonal terms.
- !
- !   Outputs:
- !      stat - A status code:  0=success.
- !
- !   Common blocks:
- !        te_dat  - This common block is used to pass/store information
- !                  that does not change between calls.
- !
- !   Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- ! ===========================================================================
-         SUBROUTINE WMAP_init_TE (clFile, offDiag, stat)
- !                INPUT
-         character (*) clFile, offDiag
- !
- !                OUTPUT
- !
-         integer stat
- !
- !                DATA/INTERNAL
- !
-         integer idum, l, ll, i,j,ix
-         real(wp) tmp
- ! ---------------------------------------------------------------------------
- !               Read the CL data.
- !
-         if (WMAP_lmax_TE_file < WMAP_lmax_TE) stop 'Wrong WMAP_lmax_TE_file'
- 
-         open (11, file=clFile, status='old', IOStat=stat)
-         if (stat .NE. 0) RETURN
-         rewind(11)
-         do  l = 2, WMAP_lmax_TE
-            read(11,*) idum,te_data(l),te_tt(l),ntt(l),nee(l)
-            if (idum.ne.l) stop 'Error reading TE diag file'
-         end do
-         close(11)
- !
- !               Read in off diag terms.
- !
-         te_off_diag = 0
-         open(11,file=offDiag, status='old', IOStat=stat)
-         if (stat .NE. 0) RETURN
-         rewind(11)
-         ix=1
-         do  l = 2,WMAP_lmax_TE  
-            do ll= l+1,WMAP_lmax_TE_file 
-               read(11,*) i,j,tmp
-               if (l /= i .or. j /= ll) stop 'Error reading TE file'
-               if (l>=WMAP_lmin_TE .and. ll<=WMAP_lmax_TE) then
-                te_off_diag(ix) = tmp
-                ix=ix+1
-               end if
-            end do
-         end do
-         close(11)
- ! ---------------------------------------------------------------------------
-         END SUBROUTINE WMAP_init_TE
- ! ===========================================================================
- !   "WMAP_init" encapsulates "WMAP_init_TT" and
- !   "WMAP_init_TE" into a single call.
- !
- !   Inputs:
- !      TclFile   - The name of the file containing the temp. cl data.
- !      ToffDiag  - The name of the file containing the temp. off-diagonal terms.
- !      TEclFile  - The name of the file containing the TE cl data.
- !      TEoffDiag - The name of the file containing the TE off-diagonal terms.
- !
- !   Outputs:
- !      stat - A status code:  0=success.
- !
- !   Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- ! ===========================================================================
-         SUBROUTINE WMAP_init (TclFile, ToffDiag,&
-                                           TEclFile, TEoffDiag, stat)
- !                INPUT
- !                
-         character (*) TclFile, ToffDiag, TEclFile, TEoffDiag
- !
- !                OUTPUT
- !
-         integer stat
- ! ---------------------------------------------------------------------------
-         Call WMAP_init_TT (TclFile, ToffDiag, stat)
-         If (stat .NE. 0) Return
-         Call WMAP_init_TE (TEclFile, TEoffDiag, stat)
- ! ---------------------------------------------------------------------------
-         END SUBROUTINE WMAP_init
- ! ===========================================================================
- !   "WMAP_LnLike_TT" computes the likelihood for temperature data
- !    using the form for the likelihood as in Verde et al 2003 sec. 2.1 
- !
- !    There are 2 contributions to the  off diagonal terms of the fisher matrix: 
- !    this is because in the covariance matrix the terms due to marginalization over 
- !    point sources and beam uncertainties depend on the power spectrum that's out 
- !    there in the sky while the coupling due to the mask depend on the Cl_theory 
- !    (i.e. changes as the cosmological parameters change in exploring the 
- !    likelihood surface) see Verde et al. 2003 , Hinshaw et al 2003.
- !
- !    WARNING: a 2% bias around the first peak results from incorrect scaling 
- !    of the off diagonal terms.    
- !
- !   Inputs:
- !      clth - An array of cl's describing the theory being tested.
- !
- !   Outputs:
- !      LnLike   - The natural log of the likelihood for l >= 2.
- !
- !   Common blocks:
- !        tt_data - This common block is used to pass/store information
- !                  that does not change between calls.
- !
- !   Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- ! ===========================================================================
-         FUNCTION WMAP_LnLike_TT(clth)
- !
-         IMPLICIT NONE
- !
- !                INPUT: clt_theory: l(l+1)C_l/2pi in microK^2
- !                
-         real(wp) clth(*)
- !
- !                OUTPUT: log(likelihood)
- !
-         real(wp) WMAP_LnLike_TT
- !
- !                DATA/INTERNAL
- !
-         integer l,ll,ix
-         real(wp) chisq, offchisq
-         real(wp) dchisq, Fisher, Fdiag(WMAP_lmax_TT)
-         real(wp) z(WMAP_lmax_TT), zbar(WMAP_lmax_TT)
-         real(wp) off_log_curv
-         real(wp) Fdiagsqrt(WMAP_lmax_TT)
- ! ---------------------------------------------------------------------------
-         chisq   = 0
-                 
- ! prepare to compute the offset lognormal likelihood as in Bond Jaffe Knox.
- ! with the difference that the transformation we do on the curvature
- ! matrix is using clth not cltdata
- ! this is closer to the equal variance approx (see Bond Jaffe Knox again)  
- ! form more details see Verde et al .2003 
- !
- ! here Fdiag is the diagonal term of the covariance matrix 
- ! Fisher denotes the curvature matrix.
- !
-         do l = WMAP_lmin_TT, WMAP_lmax_TT        
-            Fdiag(l) = 2*(Clth(l)+neff(l))**2&
-                     / ((2*l+1)*fskyeff(l)**2)
-            Fdiagsqrt(l) = 1/sqrt(Fdiag(l))
-            z(l)=log(cl_data(l)+neff(l))           
-            zbar(l)=log(clth(l)+neff(l))
-  
- ! Get the diagonal terms in the likelihood
-            Fisher=1/Fdiag(l)
-            off_log_curv=(clth(l)+neff(l))**2*Fisher
- 
-            dchisq=2._wp/3*(z(l)-zbar(l))**2*off_log_curv &
-                       +1._wp/3*(clth(l)-cl_data(l))**2*Fisher 
-            chisq=chisq+dchisq
-  
-         end do
-         
-         if (chisq < WMAP_lmax_TT*2) then
- !Only get off-diagonal terms if not a really bad fit, otherwise they will 
- !be wildly wrong
- !In principle the likelihood may not be continuous, but likelihood is so low
- !model will always be rejected or contribute zero anyway
- 
-         offchisq=0
-         ix =1
-         do l = WMAP_lmin_TT,WMAP_lmax_TT        
-            do ll=l+1,WMAP_lmax_TT
- !
- ! here the two contributions to the off diagonal terms to the curvature matrix 
- ! are treated separately
- !
- ! see Verde et.al. 2003 for details.
- ! note off_diag = -epsilon in the papers
-             Fisher=r_off_diag(ix)*Fdiagsqrt(l)*Fdiagsqrt(ll) &
-                              +off_diag(ix)/(Fdiag(l)*Fdiag(ll))
-             off_log_curv=(clth(l)+neff(l))*Fisher*(clth(ll)+neff(ll))
- 
- ! to correct for residual 0.5% bias around the peak
- ! see Verde et.al. 2003 for more details
- !
- ! this is an interpolation between Bond Knox Jaffe and Gaussian Likelihood.
- ! works extremely well on sims (again see paper for details)
- !
-               dchisq=2._wp/3*(z(l)-zbar(l))*off_log_curv*(z(ll)-zbar(ll))+ &
-                     1._wp/3*(clth(l)-cl_data(l))*Fisher*(clth(ll)-cl_data(ll))
-       
-               offchisq=offchisq+dchisq
-               ix=ix+1           
-            end do
-         end do
- 
- ! add it twice because of the symmetry of the matrix
-         chisq=chisq+offchisq*2
-         
-         end if 
- 
-         WMAP_LnLike_TT=-chisq/2.d0
- !
- !        write(*,*) ' MAP_T log(LnLike)=',LnLike,'chisq=',chisq
- !
- ! ---------------------------------------------------------------------------
-         END FUNCTION WMAP_LnLike_TT
- 
- 
- ! "WMAP_LnLike_TE" computes the likelihood for TE data.
- !
- ! Uses the expression for the likelihood  as in Kogut et al 2003 (ApJ in press) 
- ! and Verde et al 2003.
- !
- ! The Curvature matrix has been calibrated from Monte Carlo simulations.  
- ! fsky is set to 0.85, if not using the P2 cut (i.e. if not using the cl 
- ! we provided you with) you should change fsky accordingly.
- !
- !   Inputs:
- !      cltt - An array of temperature cl's describing the theory
- !             being tested.
- !      clte - An array of TE cl's describing the theory
- !             being tested.
- !      clee - An array of EE cl's describing the theory
- !             being tested.
- !
- !   Outputs:
- !      LnLike   - The natural log of the likelihood for all l.
- !
- !   Common blocks:
- !        te_dat - This common block is used to pass/store information
- !                 that does not change between calls.
- !
- !   Written by Licia Verde and Hiranya Peiris, Princeton University,
- !      December 2002.
- ! ===========================================================================
-         FUNCTION WMAP_LnLike_TE(cltt, clte, clee)
- !
-         IMPLICIT NONE
- 
- !               INPUT: clte_theory
- !                
-         real(wp) cltt(*),clte(*),clee(*)
- !
- !               OUTPUT: log(likelihood)
- !
-         real(wp) WMAP_LnLike_TE
- 
-         integer il,ill,ix
-         real(wp) fsky,delta_chisq,chisq, offchisq
-         real(wp) Fdiag, Fdiagsqrt(WMAP_lmax_TE),Fisher
-       !  real(wp) ct, ce
- ! ---------------------------------------------------------------------------
-         fsky=0.85d0
-         chisq=0
- 
- !Alternative code that includes TT - TE correlations
- !        do il = WMAP_lmin_TE,WMAP_lmax_TE        
- !            ct = cltt(il) + ntt(il)
- !            ce = clee(il) + nee(il)
- !            chisq = chisq+ (te_data(il) - clte(il) - clte(il)/ct*(te_tt(il)-ct))**2/ &
- !                    (ct*ce-clte(il)**2)  * (2*il+1)*fsky**2/1.14d0      
- !
- !        end do
- !       WMAP_LnLike_TE=-chisq/2.d0
- !       return
- 
- 
- ! Fdiag is the diagonal element of the covariance matrix
- ! Fisher denotes the curvature matrix.
- !
-         do il = WMAP_lmin_TE,WMAP_lmax_TE        
-            Fdiag=((cltt(il)+ntt(il))*(clee(il)+nee(il))&
-                     +clte(il)*clte(il))&
-                     /((2*il+1)*fsky**2/1.14d0)
-            Fdiagsqrt(il) = 1/sqrt(Fdiag)
- 
- ! this correction factor (1.14) has been obtained from a calibration of
- ! the covariance matrix on monte carlo sims (see papers for more details)
- !
-            delta_chisq = (clte(il)-te_data(il))**2/Fdiag 
- 
-            chisq=chisq+delta_chisq
-           end do
- 
- !
- ! include mask effect on off diagonal terms in the curvature matrix
-    
-         offchisq = 0
-         ix = 1
-         do il = WMAP_lmin_TE,WMAP_lmax_TE
-            do ill=il+1,WMAP_lmax_TE
-               Fisher=te_off_diag(ix)*Fdiagsqrt(il)*Fdiagsqrt(ill)
-  
-               delta_chisq = (clte(il)-te_data(il))*Fisher*&
-                               (clte(ill)-te_data(ill))
-               offchisq=offchisq+delta_chisq
-               ix=ix+1 
-            end do
-         end do
- 
-         chisq = chisq+offchisq*2
- 
-         WMAP_LnLike_TE=-chisq/2.d0
- !
- !        write(*,*) ' MAP_TE log(LnLike)=',LnLike,'chisq=',chisq
- !
- ! ---------------------------------------------------------------------------
-         END FUNCTION WMAP_LnLike_TE
- 
-   end module WMAP
-   
--- 0 ----
diff -r -c -b -B -N cosmomc/source/wrapper.f90 cosmomc_sampler/source/wrapper.f90
*** cosmomc/source/wrapper.f90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_sampler/source/wrapper.f90	2009-04-30 16:51:19.474271389 +0200
***************
*** 0 ****
--- 1,23 ----
+ module wrapper
+   use paramdef, only : paramset, paramsetinfo
+   implicit none
+   
+ 
+ contains
+ 
+ 
+   subroutine AcceptReject(accpt, CurParams, Trial)
+     logical, intent(in) :: accpt
+     Type(ParamSetInfo) CurParams, Trial
+     
+     
+     if (accpt) then
+        print *,'accepted'
+     else
+        print *,'rejected'
+     end if
+     
+   end subroutine AcceptReject
+ 
+ end module wrapper
+ 
diff -r -c -b -B -N cosmomc/WMAPrun.covmat cosmomc_sampler/WMAPrun.covmat
*** cosmomc/WMAPrun.covmat	2006-04-03 15:38:12.000000000 +0200
--- cosmomc_sampler/WMAPrun.covmat	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,13 ****
-     0.10531E-05   -0.29368E-05    0.23292E-05   -0.17249E-05    0.00000E+00    0.00000E+00    0.00000E+00   -0.39292E-04    0.00000E+00    0.26158E-04   -0.82237E-05    0.00000E+00    0.00000E+00
-    -0.29368E-05    0.10534E-03    0.53132E-05   -0.35813E-04    0.00000E+00    0.00000E+00    0.00000E+00    0.31511E-03    0.00000E+00   -0.17403E-03    0.18486E-03    0.00000E+00    0.00000E+00
-     0.23292E-05    0.53132E-05    0.12699E-04   -0.75753E-05    0.00000E+00    0.00000E+00    0.00000E+00   -0.46269E-04    0.00000E+00    0.41283E-04   -0.17150E-04    0.00000E+00    0.00000E+00
-    -0.17249E-05   -0.35813E-04   -0.75753E-05    0.92022E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.46294E-03    0.00000E+00   -0.16839E-03    0.10671E-02    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-    -0.39292E-04    0.31511E-03   -0.46269E-04    0.46294E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.32103E-02    0.00000E+00   -0.17238E-02    0.15058E-03    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.26158E-04   -0.17403E-03    0.41283E-04   -0.16839E-03    0.00000E+00    0.00000E+00    0.00000E+00   -0.17238E-02    0.00000E+00    0.98717E-03   -0.15616E-03    0.00000E+00    0.00000E+00
-    -0.82237E-05    0.18486E-03   -0.17150E-04    0.10671E-02    0.00000E+00    0.00000E+00    0.00000E+00    0.15058E-03    0.00000E+00   -0.15616E-03    0.30606E-02    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
--- 0 ----
diff -r -c -b -B -N cosmomc/WMAPtens.covmat cosmomc_sampler/WMAPtens.covmat
*** cosmomc/WMAPtens.covmat	2006-04-03 15:38:12.000000000 +0200
--- cosmomc_sampler/WMAPtens.covmat	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,13 ****
-     0.11673E-05   -0.33769E-05    0.31091E-05    0.93094E-05    0.00000E+00    0.00000E+00    0.00000E+00    0.29364E-04    0.00000E+00    0.00000E+00   -0.74689E-04    0.16271E-03    0.00000E+00
-    -0.33769E-05    0.84910E-04   -0.72276E-06   -0.57407E-04    0.00000E+00    0.00000E+00    0.00000E+00   -0.14744E-03    0.00000E+00    0.00000E+00    0.66519E-03   -0.11625E-02    0.00000E+00
-     0.31091E-05   -0.72276E-06    0.15778E-04    0.20667E-04    0.00000E+00    0.00000E+00    0.00000E+00    0.76829E-04    0.00000E+00    0.00000E+00   -0.16030E-03    0.33937E-03    0.00000E+00
-     0.93094E-05   -0.57407E-04    0.20667E-04    0.95425E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.29403E-03    0.00000E+00    0.00000E+00    0.86891E-03    0.47634E-03    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.29364E-04   -0.14744E-03    0.76829E-04    0.29403E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.89432E-03    0.00000E+00    0.00000E+00   -0.24458E-02    0.52498E-02    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
-    -0.74689E-04    0.66519E-03   -0.16030E-03    0.86891E-03    0.00000E+00    0.00000E+00    0.00000E+00   -0.24458E-02    0.00000E+00    0.00000E+00    0.11302E-01   -0.18441E-01    0.00000E+00
-     0.16271E-03   -0.11625E-02    0.33937E-03    0.47634E-03    0.00000E+00    0.00000E+00    0.00000E+00    0.52498E-02    0.00000E+00    0.00000E+00   -0.18441E-01    0.43832E-01    0.00000E+00
-     0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00    0.00000E+00
--- 0 ----
