diff -r -c -b -B -N cosmomc/camb/inidriver.F90 cosmomc_addon/camb/inidriver.F90
*** cosmomc/camb/inidriver.F90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_addon/camb/inidriver.F90	2009-10-27 18:02:44.492876662 +0100
***************
*** 249,254 ****
--- 249,264 ----
         lAccuracyBoost = Ini_Read_Real('l_accuracy_boost',lAccuracyBoost)
         lSampleBoost   = Ini_Read_Double('l_sample_boost',lSampleBoost)
  
+  !addon     
+         DoClsInterpol  = Ini_Read_Logical('do_cls_interpol',.false.)
+         ComputeEveryl  = Ini_Read_Logical('compute_every_l',.false.)
+    
+         if (FeedbackLevel > 0) then
+            write (*,*)'do_cls_interpol is',DoClsInterpol
+            write (*,*)'compute_every_l is',ComputeEveryl          
+         endif
+  !end addon
+ 
         if (outroot /= '') then
           call Ini_SaveReadValues(trim(outroot) //'params.ini',1)
         end if
***************
*** 297,302 ****
--- 307,316 ----
  
          call CAMB_cleanup             
    
+         if (P%InitPower%WantExternalScalar.or.P%InitPower%WantExternalTensor) &
+              call FreeExternalData(P%InitPower)
+ 
+ 
          end program driver
  
  
diff -r -c -b -B -N cosmomc/camb/Makefile cosmomc_addon/camb/Makefile
*** cosmomc/camb/Makefile	2009-10-22 15:59:31.000000000 +0200
--- cosmomc_addon/camb/Makefile	2009-10-28 12:01:06.936215275 +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
--- 1,91 ----
!  # >>> DESIGNED FOR GMAKE <<<
!  #CAMB System unified Makefile 
  
! ext=$(shell uname | cut -c1-3)
! ifeq ($(ext),IRI)
! F90C=f90	
! FFLAGS = -Ofast -mp -n32 -LANG:recursive=ON
! endif
! 
! ifeq ($(ext),Lin)
! F90C=gfortran
! FFLAGS= -O -fopenmp #-D__GFORTRAN__
! endif 
! 
! ifeq ($(ext),OSF)
! F90C=f90
! FFLAGS= -omp -O -arch host -math_library fast -tune host -fpe1
! endif
! 
! ifeq ($(ext),Sun)
! F90C=f90
! FFLAGS= -O4 -xarch=native64 -openmp -ftrap=%none
! endif
! 
! ifeq ($(ext),AIX)
! F90C=xlf90_r
! FFLAGS= -O4 -qsmp=omp -qmaxmem=-1 -qstrict -qfree=f90 -qsuffix=f=f90:cpp=F90
! endif
! 
! 
! #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.$(ext)
! 
! all: camb.$(ext) $(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.$(ext): $(CAMBOBJ) $(DRIVER)
! 	$(F90C) $(F90FLAGS) $(CAMBOBJ) $(DRIVER) -o $@
! 
! $(CAMBLIB): $(CAMBOBJ)
! 	ar -r $@ $?
! 
! camb_fits: writefits.f90 $(CAMBOBJ) $(DRIVER)
! 	$(F90C) $(F90FLAGS) -I$(HEALPIXDIR)/include tils.o $(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
  
  
diff -r -c -b -B -N cosmomc/camb/modules.f90 cosmomc_addon/camb/modules.f90
*** cosmomc/camb/modules.f90	2008-09-16 17:57:58.000000000 +0200
--- cosmomc_addon/camb/modules.f90	2009-10-27 18:07:20.224980779 +0100
***************
*** 202,208 ****
        integer, parameter:: l0max=4000
  
  !     lmax is max possible number of l's evaluated
!       integer, parameter :: lmax_arr = 100+l0max/7
   
          contains
        
--- 202,213 ----
        integer, parameter:: l0max=4000
  
  !     lmax is max possible number of l's evaluated
! !addon
! !      integer, parameter :: lmax_arr = 100+l0max/7
!       integer, parameter :: lmax_arr = 100 + l0max
!       logical :: DoClsInterpol=.true.
!       logical :: ComputeEveryl=.true.
! !end addon
   
          contains
        
***************
*** 554,559 ****
--- 559,582 ----
          integer lind, lvar, step,top,bot,ls(lmax_arr)
          real(dl) AScale
      
+ !addon    
+         if (ComputeEveryl) then
+            write(*,*) 'Warning: computing every l'           
+            if (max_l.gt.lmax_arr) then
+               write(*,*)'lmax_arr maxl',lmax_arr,max_l
+               stop
+            endif
+            lind=0
+            do lvar=2, max_l
+               lind=lind+1
+               ls(lind)=lvar 
+            end do
+ 
+            lSet%l0=lind
+            lSet%l = ls(1:lind)
+ 
+         else
+ !end addon
          Ascale=scale/lSampleBoost       
        
          lind=0
***************
*** 678,683 ****
--- 701,710 ----
          lSet%l0=lind
          lSet%l(1:lind) = ls(1:lind)
          
+ !addon
+         endif
+ !end addon
+         
        end subroutine initlval
  
        subroutine InterpolateClArr(lSet,iCl, all_Cl, max_ind)
***************
*** 697,702 ****
--- 724,731 ----
        xl = real(lSet%l(1:lSet%l0),dl)
        call spline(xl,iCl(1),max_ind,cllo,clhi,ddCl(1))
       
+ !addon
+       if (DoClsInterpol) then
              llo=1
              do il=lmin,lSet%l(max_ind)
                 xi=il
***************
*** 713,718 ****
--- 742,764 ----
                
              end do
  
+       else
+ 
+          llo=1
+          do il=2,lSet%l(max_ind)
+             xi=il
+             if ((xi > lSet%l(llo+1)).and.(llo < max_ind)) then
+                llo=llo+1
+             end if
+ 
+             all_Cl(il) = iCl(llo+1)
+ 
+          end do
+          all_Cl(2)=iCl(1)
+       endif
+ !end addon
+ 
+ 
        end subroutine InterpolateClArr
  
   
diff -r -c -b -B -N cosmomc/camb/params.ini cosmomc_addon/camb/params.ini
*** cosmomc/camb/params.ini	2008-03-26 15:24:18.000000000 +0100
--- cosmomc_addon/camb/params.ini	2009-10-27 18:07:32.737626748 +0100
***************
*** 65,70 ****
--- 65,77 ----
  
  #Initial power spectrum, amplitude, spectral index and running. Pivot k in Mpc^{-1}.
  initial_power_num         = 1
+ 
+ #read the power spectra form ascii files in the form (Mpc^-1): k P(k)
+ use_external_scalar       = F
+ use_external_tensor       = F
+ scalar_input_file(1)      = scalar_power.dat
+ tensor_input_file(1)      = tensor_power.dat
+ 
  pivot_scalar              = 0.05
  pivot_tensor              = 0.05
  scalar_amp(1)             = 2.3e-9
***************
*** 129,134 ****
--- 136,147 ----
  #Matter power spectrum output against k/h in units of h^{-3} Mpc^3
  transfer_matterpower(1) = matterpower.dat
  
+ #Use spline interpolation for the Cls
+ do_cls_interpol = T
+ 
+ #Remove undersampling of the Cls: if true lSampleBoost has no effect
+ compute_every_l = F
+ 
  
  #Output files not produced if blank. make camb_fits to use use the FITS setting.
  scalar_output_file = scalCls.dat
***************
*** 186,188 ****
--- 199,207 ----
  #interpolation errors may be up to 3%
  #Decrease to speed up non-flat models a bit
  l_sample_boost          = 1
+ 
+ #Use spline interpolation for the Cls
+ do_cls_interpol         = F
+  
+ # Remove undersampling of the Cls: if true lSampleBoost has no effect
+ compute_every_l         = T
diff -r -c -b -B -N cosmomc/camb/power_tilt.f90 cosmomc_addon/camb/power_tilt.f90
*** cosmomc/camb/power_tilt.f90	2008-03-13 15:40:20.000000000 +0100
--- cosmomc_addon/camb/power_tilt.f90	2009-10-27 18:07:39.376925048 +0100
***************
*** 50,58 ****
--- 50,77 ----
         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)
+ !addon 
+        logical :: WantExternalScalar
+        logical :: WantExternalTensor
+        character(80) :: ScalarPowerFileName(nnmax),TensorPowerFileName(nnmax)
+ !end addon      
   
        end Type InitialPowerParams
  
+ !addon
+       type ExternalData
+ !only pointers may be defered shape in derived type
+          real(dl) :: ScalarMomentumMin, ScalarMomentumMax
+          real(dl), dimension(:), pointer :: PtrScalarPower, PtrScalarLnMomentum
+          real(dl), dimension(:), pointer :: PtrScalarPower2
+          real(dl) :: TensorMomentumMin, TensorMomentumMax
+          real(dl), dimension(:), pointer :: PtrTensorPower, PtrTensorLnMomentum
+          real(dl), dimension(:), pointer :: PtrTensorPower2
+       end type ExternalData
+ 
+       type(ExternalData), dimension(:), pointer  :: PtrExternalData => null()
+ !end addon      
+ 
        real(dl) curv  !Curvature contant, set in InitializePowers     
        
        Type(InitialPowerParams) :: P
***************
*** 61,66 ****
--- 80,90 ----
   
        public InitialPowerParams, InitialPower_ReadParams, InitializePowers, ScalarPower, TensorPower
        public nnmax,Power_Descript, Power_Name, SetDefPowerParams
+ 
+ !addon
+       public FreeExternalData
+ !end addon
+ 
  !      public 
      contains
         
***************
*** 76,81 ****
--- 100,110 ----
           AP%k_0_scalar = 0.05
           AP%k_0_tensor = 0.05
           AP%ScalarPowerAmp = 1
+ !addon
+ !         nullify(PtrExternalData)
+          AP%WantExternalScalar = .false.
+          AP%WantExternalTensor = .false.
+ !end addon        
  
         end subroutine SetDefPowerParams
  
***************
*** 86,91 ****
--- 115,128 ----
  
          real(dl) acurv
  
+ !addon
+         integer :: i,ioflag,j
+         integer :: nPowerUnit=111
+         integer :: nData
+         real(dl), save :: sbuffer1,sbuffer2
+         real(dl), parameter :: spl_large=1.e40_dl     
+ !end addon
+ 
          if (AParamSet%nn > nnmax) then
             write (*,*) 'To use ',AParamSet%nn,'power spectra you need to increase'
             write (*,*) 'nnmax in power_tilt.f90, currently ',nnmax
***************
*** 96,104 ****
--- 133,295 ----
  
  !Write implementation specific code here...
  
+ !addon
+ 
+ !create and point to P%nn ExternalData objects (pointers and reals)
+         if ((P%WantExternalScalar).or.(P%WantExternalTensor)) then
+            if (.not.associated(PtrExternalData)) then
+               allocate(PtrExternalData(P%nn)) 
+            else
+               write(*,*)'InitializePowers: PtrExternalData already Initialized!'
+               return
+            endif
+         endif
+          
+         if (P%WantExternalScalar) then
+                         
+            do i=1,P%nn
+                
+               write(*,*)'using primordial scalar power spectrum: ',P%ScalarPowerFileName(i)
+                
+               open(unit=nPowerUnit,file=P%ScalarPowerFileName(i),action='read' &
+                    ,form='formatted',status='old')             
+ !count the number of records
+               nData=0
+               do                                    
+                  read(nPowerUnit,*,iostat=ioflag)                  
+                  if (ioflag.lt.0) exit
+                  nData=nData + 1                                    
+               enddo
+ !create and point to
+               allocate(PtrExternalData(i)%PtrScalarPower(nData) & 
+                    ,PtrExternalData(i)%PtrScalarLnMomentum(nData))
+               
+               rewind(nPowerUnit)
+               nData=1
+               do                                   
+                  read(nPowerUnit,*,iostat=ioflag) sbuffer1,sbuffer2
+                  if (ioflag.lt.0) exit
+                  PtrExternalData(i)%PtrScalarLnMomentum(nData) = log(sbuffer1)
+                  PtrExternalData(i)%PtrScalarPower(nData) = sbuffer2      
+                  nData=nData+1
+               enddo
+               nData=nData - 1 
+               close(nPowerUnit,iostat=ioflag)
+             
+ !keep trace of the accessible range              
+               PtrExternalData(i)%ScalarMomentumMin = exp(PtrExternalData(i)%PtrScalarLnMomentum(1))
+               PtrExternalData(i)%ScalarMomentumMax = exp(PtrExternalData(i)%PtrScalarLnMomentum(nData))
+               
+ 
+ !2nd order derivatives allocation
+               allocate(PtrExternalData(i)%PtrScalarPower2(nData))
+ !splining in log k
+               call spline(PtrExternalData(i)%PtrScalarLnMomentum(:) &
+                    ,PtrExternalData(i)%PtrScalarPower(:),nData, spl_large &
+                    , spl_large,PtrExternalData(i)%PtrScalarPower2(:))
+               
+            enddo
+ 
+         endif
+ 
+ 
+ !the same for tensors
+ 
+         if (P%WantExternalTensor) then
+             
+            do i=1,P%nn
+               
+               write(*,*)'using primordial tensor power spectrum: ',P%TensorPowerFileName(i)
+ 
+               open(unit=nPowerUnit,file=P%TensorPowerFileName(i) &
+                    ,action='read',form='formatted',status='old')     
+ !count the number of records
+               nData=0
+               do                                    
+                  read(nPowerUnit,*,iostat=ioflag)                  
+                  if (ioflag.lt.0) exit
+                  nData=nData + 1                                    
+               enddo
+ !store the data
+               allocate(PtrExternalData(i)%PtrTensorPower(nData) & 
+                    ,PtrExternalData(i)%PtrTensorLnMomentum(nData))
+                
+               rewind(nPowerUnit)
+               nData=1
+               do                                   
+                  read(nPowerUnit,*,iostat=ioflag) sbuffer1,sbuffer2
+                  if (ioflag.lt.0) exit
+                  PtrExternalData(i)%PtrTensorLnMomentum(nData) = log(sbuffer1)
+                  PtrExternalData(i)%PtrTensorPower(nData) = sbuffer2      
+                  nData=nData+1
+               enddo
+               nData=nData - 1 
+               close(nPowerUnit)
+ 
+ !keep trace of the accessible range              
+               PtrExternalData(i)%TensorMomentumMin = exp(PtrExternalData(i)%PtrTensorLnMomentum(1))
+               PtrExternalData(i)%TensorMomentumMax = exp(PtrExternalData(i)%PtrTensorLnMomentum(nData))
+               
+ 
+ !2nd order derivatives
+               allocate(PtrExternalData(i)%PtrTensorPower2(nData))
+ !splining in log k
+               call spline(PtrExternalData(i)%PtrTensorLnMomentum(:) &
+                    ,PtrExternalData(i)%PtrTensorPower(:),nData, spl_large &
+                    , spl_large,PtrExternalData(i)%PtrTensorPower2(:))
+               
+            enddo
+ 
+             
+         endif
+          
         end subroutine InitializePowers
         
  
+ 
+        subroutine FreeExternalData(AP)
+          type (InitialPowerParams), intent(in) :: AP
+          integer :: i
+ 
+          if (AP%nn.ne.size(PtrExternalData,1)) then
+             write(*,*)'InitialPower.FreeExternalData : wrong initial power params'
+             stop
+          endif
+ 
+          if (AP%WantExternalScalar) then
+             do i=1, AP%nn               
+ !free heap arrays and disassociate ExternalData pointers            
+                deallocate(PtrExternalData(i)%PtrScalarPower)
+                deallocate(PtrExternalData(i)%PtrScalarPower2)
+                deallocate(PtrExternalData(i)%PtrScalarLnMomentum)
+ !should still point to ExternalData objects
+                if (.not.associated(PtrExternalData)) stop 'InitialPower.FreeExternalData : ooops'
+             enddo
+          endif
+          if (AP%WantExternalTensor) then
+             do i=1, AP%nn               
+                deallocate(PtrExternalData(i)%PtrTensorPower)
+                deallocate(PtrExternalData(i)%PtrTensorPower2)
+                deallocate(PtrExternalData(i)%PtrTensorLnMomentum)
+                if (.not.associated(PtrExternalData)) stop 'InitialPower.FreeExternalData : ooops'
+             enddo
+          endif
+ !Free remaining objects and disassociate pointer to ExternalData
+          if (associated(PtrExternalData)) then
+             deallocate(PtrExternalData)
+             PtrExternalData => null()
+          else
+             if (AP%WantExternalScalar.or.AP%WantExternalTensor) then
+ !should never happen               
+                stop 'InitialPower.FreeExternalData : ooops'
+             endif
+          endif
+ 
+        end subroutine FreeExternalData
+ 
+ !end addon
+ 
+ 
        function ScalarPower(k,in)
  
         !"in" gives the index of the power to return for this k
***************
*** 119,127 ****
--- 310,340 ----
          real(dl) ScalarPower,k, lnrat
          integer in
  
+ !addon
+         integer :: nData       
+ 
+         if (P%WantExternalScalar) then
+            nData=size(PtrExternalData(in)%PtrScalarLnMomentum,1)
+ 
+            if ((k.ge.PtrExternalData(in)%ScalarMomentumMin) &
+                 .and.(k.le.PtrExternalData(in)%ScalarMomentumMax)) then
+               call splinterpol(PtrExternalData(in)%PtrScalarLnMomentum &
+                    ,PtrExternalData(in)%PtrScalarPower &
+                    ,PtrExternalData(in)%PtrScalarPower2,nData,log(k),ScalarPower)
+ !confusing              ScalarPower = P%ScalarPowerAmp(in)*ScalarPower
+            else
+               write(*,*)'InitPower.ScalarPower() : out of range: k= ',k
+               ScalarPower=0_dl              
+            endif
+ 
+         else
+ 
            lnrat = log(k/P%k_0_scalar)
            ScalarPower=P%ScalarPowerAmp(in)*exp((P%an(in)-1)*lnrat + P%n_run(in)/2*lnrat**2)   
   
+         endif
+ !end addon
+ 
        end function ScalarPower
  
        
***************
*** 142,148 ****
--- 355,384 ----
     
          integer in
  
+ !addon
+         integer :: nData
+         
+ 
+         if (P%WantExternalTensor) then
+            nData=size(PtrExternalData(in)%PtrTensorLnMomentum,1)
+            if ((k.ge.PtrExternalData(in)%TensorMomentumMin) &
+                 .and.(k.le.PtrExternalData(in)%TensorMomentumMax)) then
+               call splinterpol(PtrExternalData(in)%PtrTensorLnMomentum &
+                    ,PtrExternalData(in)%PtrTensorPower &
+                    ,PtrExternalData(in)%PtrTensorPower2,nData,log(k),TensorPower)
+ 
+ !confusing              TensorPower = P%rat(in)*P%ScalarPowerAmp(in)*TensorPower
+            else
+               write(*,*)'InitPower.TensorPower() : out of range: k= ',k
+               TensorPower=0_dl               
+            endif
+         else
+ 
          TensorPower=P%rat(in)*P%ScalarPowerAmp(in)*exp(P%ant(in)*log(k/P%k_0_tensor))
+ 
+         endif
+ !end addon
+         
          if (curv < 0) TensorPower=TensorPower*tanh(PiByTwo*sqrt(-k**2/curv-3)) 
  
         
***************
*** 193,209 ****
            
             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) 
--- 429,464 ----
            
             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) 
+ 
+ !addon
+             InitPower%WantExternalScalar = Ini_Read_Logical('use_external_scalar',.false.)
+             InitPower%WantExternalTensor = Ini_Read_Logical('use_external_tensor',.false.)
+ !end addon
             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
! !addon
!               if (InitPower%WantExternalScalar) then
!                  InitPower%ScalarPowerFileName(i) & 
!                       = Ini_Read_String_Array_File(Ini,'scalar_input_file',i)
!               else
! !end addon
                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) 
+               endif
                
                if (WantTensors) then
+ !addon
+                  if (InitPower%WantExternalTensor) then
+                     InitPower%TensorPowerFileName(i) & 
+                          = Ini_Read_String_Array_File(Ini,'tensor_input_file',i)
+                  else
+ !end addon
                   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)
+                  endif
+ 
                end if              
  
                InitPower%ScalarPowerAmp(i) = Ini_Read_Double_Array_File(Ini,'scalar_amp',i,1._dl) 
diff -r -c -b -B -N cosmomc/camb/subroutines.f90 cosmomc_addon/camb/subroutines.f90
*** cosmomc/camb/subroutines.f90	2008-09-16 18:04:28.000000000 +0200
--- cosmomc_addon/camb/subroutines.f90	2009-10-27 18:07:43.041419647 +0100
***************
*** 1131,1133 ****
--- 1131,1166 ----
  !  end abort action
  !
        end subroutine dverk
+ 
+ 
+ !addon
+ !the numrec splint renamed
+ 
+ SUBROUTINE splinterpol(xa,ya,y2a,n,x,y)
+   use Precision
+   INTEGER n
+   REAL(dl) x,y,xa(n),y2a(n),ya(n)
+   INTEGER k,khi,klo
+   REAL(dl) a,b,h
+   klo=1
+   khi=n
+ 1 if (khi-klo.gt.1) then
+      k=(khi+klo)/2
+      if(xa(k).gt.x)then
+         khi=k
+      else
+         klo=k
+      endif
+      goto 1
+   endif
+   h=xa(khi)-xa(klo)
+   if (h.eq.0.) stop 'bad xa input in splint'
+   a=(xa(khi)-x)/h
+   b=(x-xa(klo))/h
+   y=a*ya(klo)+b*ya(khi)+((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))&
+        *(h**2)/6.
+   return
+ END SUBROUTINE splinterpol
+ 
+ 
+ !end addon
diff -r -c -b -B -N cosmomc/distparams.ini cosmomc_addon/distparams.ini
*** cosmomc/distparams.ini	2009-09-17 15:14:51.000000000 +0200
--- cosmomc_addon/distparams.ini	2009-10-27 18:08:06.060876506 +0100
***************
*** 49,54 ****
--- 49,55 ----
  
  plot_meanlikes = T
  shade_meanlikes = T
+ td_meanlikes = F
  
  # if non-zero, output _thin file, thinned by thin_factor
  thin_factor = 0
diff -r -c -b -B -N cosmomc/params.ini cosmomc_addon/params.ini
*** cosmomc/params.ini	2009-10-27 15:35:25.000000000 +0100
--- cosmomc_addon/params.ini	2009-10-27 18:28:07.281067670 +0100
***************
*** 135,141 ****
  #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
--- 135,141 ----
  #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 = T
  
  
  #CAMB parameters
***************
*** 151,156 ****
--- 151,159 ----
  #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
+ l_accuracy_level = 1
+ l_sample_level = 1
+ camb_compute_every_l = F
  
  #If action = 1
  redo_likelihoods = T
diff -r -c -b -B -N cosmomc/source/CMB_Cls_simple.f90 cosmomc_addon/source/CMB_Cls_simple.f90
*** cosmomc/source/CMB_Cls_simple.f90	2009-10-21 22:14:28.000000000 +0200
--- cosmomc_addon/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/CMB_Cls_simple.F90 cosmomc_addon/source/CMB_Cls_simple.F90
*** cosmomc/source/CMB_Cls_simple.F90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/CMB_Cls_simple.F90	2009-10-27 18:08:30.108876490 +0100
***************
*** 0 ****
--- 1,527 ----
+ !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)
+ 
+ !addon
+    AccuracyBoost = AccuracyLevel
+    lAccuracyBoost = lAccuracyLevel
+    lSampleBoost = lSampleLevel
+    ComputeEveryl = CambComputeEveryl
+ 
+    write(*,*)
+    write(*,*) '>>>>>>>>>>>>>> accuracy settings <<<<<<<<<<<<<<'
+    write(*,*) 'Power_Name     =    ',Power_Name
+    write(*,*) 'write_all_cls  =   ',write_all_cls
+    write(*,*) 'AccuracyBoost  = ',AccuracyBoost
+    write(*,*) 'lAccuracyBoost = ',lAccuracyBoost          
+    write(*,*) 'DoClsInterpol  =   ',DoClsInterpol
+    write(*,*) 'ComputeEveryl  =   ',ComputeEveryl
+    write(*,*) '>>>>>>>>>>>>>> accuracy settings <<<<<<<<<<<<<<'
+    write(*,*)
+ !end addon
+ 
+         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
+ !addon
+ !moved up for screen output
+ !          AccuracyBoost = AccuracyLevel
+ !          lAccuracyBoost = AccuracyLevel
+ !          lSampleBoost = AccuracyLevel
+ !end addon
+           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
+ 
diff -r -c -b -B -N cosmomc/source/cmbtypes.f90 cosmomc_addon/source/cmbtypes.f90
*** cosmomc/source/cmbtypes.f90	2009-10-20 16:45:00.000000000 +0200
--- cosmomc_addon/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/cmbtypes.F90 cosmomc_addon/source/cmbtypes.F90
*** cosmomc/source/cmbtypes.F90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/cmbtypes.F90	2009-10-28 12:02:35.376021546 +0100
***************
*** 0 ****
--- 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
diff -r -c -b -B -N cosmomc/source/distparams.ini cosmomc_addon/source/distparams.ini
*** cosmomc/source/distparams.ini	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/distparams.ini	2009-10-27 18:08:06.060876506 +0100
***************
*** 0 ****
--- 1,133 ----
+ #Params for "getdist" - for processing .txt chain information
+ 
+ #if zero, columnnum calculated automatically as total number of columns
+ columnnum  = 0
+ 
+ file_root = chains/test
+ out_root = 
+ out_dir = 
+ plot_data_dir = plot_data/
+ 
+ #if parameter_names empty set from file_root.paramnames if it exists
+ #otherwise set up labels manually in this file using lab1=... etc.
+ parameter_names = 
+ #params_CMB.paramnames
+ 
+ 
+ #If generated chain at higher temperature can cool for computing results
+ cool = 1
+ 
+ #If 0 assume 1 and no chain filename prefixes
+ chain_num = 6
+ first_chain = 
+ exclude_chain = 
+ 
+ #width of Gaussian smoothing - Should check plots are robust to changes in 
+ #this parameter. Narrow diagonal distributions need larger number
+ #Can also check plots by comparing with setting smoothing=F below
+ num_bins = 20
+ 
+ #For disgarding burn-in if using raw chains
+ #if < 1 interpreted as a fraction of the total number of rows (0.3 ignores first 30% of lines)
+ ignore_rows = 0.5
+ 
+ #if T produced B&W printer friendly output
+ B&W = F
+ #version of MatLab you are using
+ matlab_version = 7
+ 
+ #Switches; auto_label labels all parameters by their number
+ no_plots = F
+ no_tests = F
+ auto_label = F
+ #samples_are_chains = F can be useful for other samples when first two columns not present
+ samples_are_chains = T
+ 
+ #Include these in 1D plots for comparison - must have same parameters
+ compare_num = 0
+ compare1 = basic6_cmb
+ 
+ plot_meanlikes = T
+ shade_meanlikes = T
+ td_meanlikes = F
+ 
+ # if non-zero, output _thin file, thinned by thin_factor
+ thin_factor = 0
+ #Do probabilistic importance sampling to single samples
+ make_single_samples = F
+ single_thin = 4
+ 
+ #Do simple importance sampling
+ adjust_priors = F
+ #Map parameters to other derived quantities
+ map_params = F
+ 
+ #Use a Gaussian smoothing with width of the bin size
+ #Otherwise use top hat bins
+ smoothing = T
+ 
+ num_contours = 2
+ contour1 = 0.68
+ contour2 = 0.95
+ 
+ do_minimal_1d_intervals = F
+ 
+ #if we only want 2D plots agains a particular variable
+ plot_2D_param = 0
+ 
+ #if above zero, instead plot just these combinations:
+ #if both zero it will plot most correlated variables
+ plot_2D_num = 0
+ plot1 = ns omegabh2
+ plot2 =
+ 
+ #number of sample plots, colored by third parameter
+ #if last parameter is 0 or -1 colored by the parameter most correlated
+ #with one of the eigenvector directions (e.g. parallel or orthogonal to degeneracy)
+ num_3D_plots = 1
+ 3D_plot1 = H0 omegam tau
+ 
+ #Output 2D plots for param combos with 1D marginalized plots along the diagonal
+ triangle_plot = T
+ 
+ #Number of parameters to get covariance matrix for
+ #set automatically from parameter names file by default 
+ #If you are going to use the output as a proposal density make sure
+ #you have map_params = F, and the dimension equal to the number of MCMC parameters
+ cov_matrix_dimension = 
+ 
+ #e.g. colormap('jet')
+ matlab_colscheme =
+ 
+ #Parameters to use. If zero use all parameters which have lables.
+ plotparams_num = 0
+ plotparams = omegabh2 omegadmh2 tau ns
+ 
+ #Get set label to empty to not include a parameter in the parameter_names file
+ #lab[asz]=
+ 
+ #marker[x] adds vertical line to MatLab 1D plot
+ marker[nrun] = 0
+ 
+ #Need to give limits if prior cuts off distribution where not very small
+ limits[tau] = 0.01 N
+ limits[fnu] = 0 N
+ limits[w] = -1 N
+ limits[r]= 0 N
+ limits[asz] = 0 2
+ 
+ #all_limits sets all limitsxx for all variables to the same; can be useful for bins
+ all_limits = 
+ 
+ #compute two-tail marginalized limits irrespective of limits settings above
+ #(otherwise limits are two-tail only for those parameters without limits)
+ force_twotail = F
+ 
+ #PCA - analysis output in file file_root.PCA
+ #number of parameter to do PCA for
+ PCA_num = 0
+ PCA_normparam = omegam
+ #The parameters to use
+ PCA_params = omegam H0 tau
+ #L for log(x), M for log(-x), N for no log
+ PCA_func   = LLL
diff -r -c -b -B -N cosmomc/source/driver.F90 cosmomc_addon/source/driver.F90
*** cosmomc/source/driver.F90	2009-10-20 15:24:17.000000000 +0200
--- cosmomc_addon/source/driver.F90	2009-10-27 18:13:18.549876476 +0100
***************
*** 58,68 ****
  
  #ifdef MPI 
  
!         if (instance /= 0) call DoStop('With MPI should not have second parameter')
          call mpi_comm_rank(mpi_comm_world,MPIrank,ierror)
  
          instance = MPIrank +1 !start at 1 for chains                                             
!         write (numstr,*) instance
          rand_inst = instance
          if (ierror/=MPI_SUCCESS) call DoStop('MPI fail')
  
--- 58,77 ----
  
  #ifdef MPI 
  
! !addon
! !        if (instance /= 0) call DoStop('With MPI should not have second parameter')
!         instance_shift=instance
!         write(*,*)'MPI file names shifted by: ',instance_shift
! !end addon
          call mpi_comm_rank(mpi_comm_world,MPIrank,ierror)
  
          instance = MPIrank +1 !start at 1 for chains                                             
! !addon
! !        write (numstr,*) instance
!          instance_shift = MPIrank + instance_shift
!          write (numstr,*) instance_shift
! !end addon
! 
          rand_inst = instance
          if (ierror/=MPI_SUCCESS) call DoStop('MPI fail')
  
***************
*** 85,90 ****
--- 94,104 ----
  
          propose_scale = Ini_Read_Real('propose_scale',2.4)
          AccuracyLevel = Ini_Read_Real('accuracy_level',1.)
+ !addon
+         lAccuracyLevel = Ini_Read_Real('l_accuracy_level',1.)
+         lSampleLevel = Ini_Read_Real('l_sample_level',1.)
+         CambComputeEveryl = Ini_Read_Logical('camb_compute_every_l',.false.)
+ !end addon
  
          checkpoint = Ini_Read_Logical('checkpoint',.false.)
          if (checkpoint) flush_write = .true.
diff -r -c -b -B -N cosmomc/source/GetDist.f90 cosmomc_addon/source/GetDist.f90
*** cosmomc/source/GetDist.f90	2009-10-27 16:41:31.000000000 +0100
--- cosmomc_addon/source/GetDist.f90	2009-10-27 18:29:27.986127617 +0100
***************
*** 89,94 ****
--- 89,97 ----
          logical force_twotail 
          logical smoothing, plot_meanlikes, plot_NDcontours
          logical shade_meanlikes, make_single_samples
+ !addon
+         logical td_meanlikes,volume_plots
+ !end addon
          integer single_thin,cust2DPlots(max_cols**2)
          integer ix_min(max_cols),ix_max(max_cols)
          real center(max_cols),width(max_cols)   
***************
*** 1123,1130 ****
--- 1126,1314 ----
           close(40)
  
           end subroutine DoConvergeTests
+ !addon
+         subroutine Get4DPlotData(j,j2,j3)
+          integer, intent(in) :: j,j2,j3
+          integer i,ix1,ix2,ix3,wx,wy,wz, ix1min,ix1max,ix2min,ix2max,ix3min,ix3max
+          real binweight, dist1, dist2, dist3, norm, maxbin
+          real try_b, try_t,try_sum, try_last
+          character(LEN=120) :: plotfile, filename,numstr
+          real, dimension(:,:,:), allocatable :: TheBins3, bins3D, bin3Dlikes, bin3Dmax
+ 
+                 
+          ix1min = 0
+          ix1max = 0
+          ix2min = 0
+          ix2max = 0
+          ix3min = 0
+          ix3max = 0
+ 
+ 
+          do i = 0,nrows-1
+             ix1=nint((coldata(colix(j),i)-center(j))/width(j))
+             ix2=nint((coldata(colix(j2),i)-center(j2))/width(j2))
+             ix3=nint((coldata(colix(j3),i)-center(j3))/width(j3))
+             ix1min = min(ix1min,min(ix_min(j),ix1-2))
+             ix1max = max(ix1max,max(ix_max(j),ix1+2))
+             ix2min = min(ix2min,min(ix_min(j2),ix2-2))
+             ix2max = max(ix2max,max(ix_max(j2),ix2+2))
+             ix3min = min(ix3min,min(ix_min(j3),ix3-2))
+             ix3max = max(ix3max,max(ix_max(j3),ix3+2))           
+          enddo
+ 
+ !         print *,'bounds 1',ix1min,ix1max
+ !         print *,'bounds 2',ix2min,ix2max
+ !         print *,'bounds 3',ix3min,ix3max
+ !         read(*,*)
+          allocate(bins3D(ix1min:ix1max,ix2min:ix2max,ix3min:ix3max))
+          allocate(bin3Dlikes(ix1min:ix1max,ix2min:ix2max,ix3min:ix3max))
+          allocate(bin3Dmax(ix1min:ix1max,ix2min:ix2max,ix3min:ix3max))
+ 
+          bins3D = 0.
+ 
+ 
+          bin3Dlikes = 0.
+          bin3Dmax = 1e30         
+          
+ !         print *,'jj2j3',j,j2,j3
+ !         print *,'center',center(j),center(j2),center(j3)
+ !         print *,'width',width(j),width(j2),width(j3)
+ !         print *,'ixmin',ix_min(j),ix_min(j2),ix_min(j3)
+ !         print *,'ixmax',ix_max(j),ix_max(j2),ix_max(j3)
+                 
+ 
+          do i = 0, nrows-1
+             ix1=nint((coldata(colix(j),i)-center(j))/width(j))
+             ix2=nint((coldata(colix(j2),i)-center(j2))/width(j2))
+             ix3=nint((coldata(colix(j3),i)-center(j3))/width(j3))
           
  
+             if (smoothing) then
+                do wx = max(ix_min(j),ix1-2),min(ix_max(j),ix1+2)
+                   dist1 = (coldata(colix(j),i) - (center(j) + real(wx)*width(j)))**2/width(j)**2
+ 
+                   do wy = max(ix_min(j2),ix2-2),min(ix_max(j2),ix2+2)
+                      dist2 = (coldata(colix(j2),i) - (center(j2) + real(wy)*width(j2)))**2/width(j2)**2
+ 
+                      do wz =  max(ix_min(j3),ix3-2),min(ix_max(j3),ix3+2)
+                         dist3 = (coldata(colix(j3),i) - (center(j3) + real(wz)*width(j3)))**2/width(j3)**2 
+ 
+                         binweight = coldata(1,i)*exp( - (dist1 + dist2 + dist3)/2.)
+                         bins3D(wx,wy,wz) = bins3D(wx,wy,wz) + binweight
+                         bin3Dlikes(wx,wy,wz) = bin3Dlikes(wx,wy,wz) + binweight*exp(meanlike - coldata(2,i))
+ 
+                      end do
+                   end do
+                enddo
+                
+             else
+                bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3) + coldata(1,i) 
+                bin3Dlikes(ix1,ix2,ix3) = bin3Dlikes(ix1,ix2,ix3) + coldata(1,i)*exp(meanlike-coldata(2,i))
+             end if
+             
+             bin3Dmax(ix1,ix2,ix3) = min(bin3Dmax(ix1,ix2,ix3),real(coldata(2,i)))
+             
+          end do
+          
+          
+          do ix1=ix_min(j),ix_max(j)
+             do ix2 =ix_min(j2),ix_max(j2)
+                do ix3 = ix_min(j3),ix_max(j3)
+                   if (bins3D(ix1,ix2,ix3) >0) bin3Dlikes(ix1,ix2,ix3) = bin3Dlikes(ix1,ix2,ix3)/bins3D(ix1,ix2,ix3)
+                   if (plot_NDcontours) then
+                   !Map maximum likelihood in each bin into a significance value from the full N-D distribution
+                      if (bin3DMax(ix1,ix2,ix3) == 1e30) then
+                         bin3DMax(ix1,ix2,ix3) = 0
+                      else
+                         bin3DMax(ix1,ix2,ix3) = &
+                              sum(coldata(1,0:nrows-1), mask = coldata(2,0:nrows-1) > bin3DMax(ix1,ix2,ix3))/numsamp
+                      end if
+                   end if
+                end do
+             end do
+          enddo
+          
+          if (has_limits(colix(j)) .or. has_limits(colix(j2))) then
+ 
+         !Fix up underweighting near edges. Note this makes edge pixels noisier.
+             do ix1 = ix_min(j), ix_max(j)
+                  do ix2 = ix_min(j2),ix_max(j2)
+                     do ix3 = ix_min(j3),ix_max(j3)                       
+                     if (ix1 ==ix_min(j) .and. has_limits_bot(colix(j))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+                     if (ix1 ==ix_max(j) .and. has_limits_top(colix(j))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+                     if (ix2 ==ix_min(j2).and. has_limits_bot(colix(j2))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+                     if (ix2 ==ix_max(j2).and. has_limits_top(colix(j2))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+                     if (ix3 ==ix_min(j3).and. has_limits_bot(colix(j3))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+                     if (ix3 ==ix_max(j3).and. has_limits_top(colix(j3))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)*2
+ 
+                     if (ix1 ==ix_min(j)+1.and. has_limits_bot(colix(j))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                     if (ix1 ==ix_max(j)-1.and. has_limits_top(colix(j))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                     if (ix2 ==ix_min(j2)+1.and. has_limits_bot(colix(j2))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                     if (ix2 ==ix_max(j2)-1.and. has_limits_top(colix(j2))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                     if (ix3 ==ix_min(j3)+1.and. has_limits_bot(colix(j3))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                     if (ix3 ==ix_max(j3)-1.and. has_limits_top(colix(j3))) bins3D(ix1,ix2,ix3) = bins3D(ix1,ix2,ix3)/0.84
+                  end do
+               end do
+            enddo
+         end if
+         
+ ! Get contour containing contours(:) of the probability
+ 
+              allocate(TheBins3(ix_max(j)-ix_min(j)+1,ix_max(j2)-ix_min(j2)+1,ix_max(j3)-ix_min(j3)+1))
+              TheBins3 = bins3D(ix_min(j):ix_max(j),ix_min(j2):ix_max(j2),ix_min(j3):ix_max(j3))
+                 
+              norm = sum(TheBins3)
+              
+              do ix1 = 1, num_contours
+              try_t = maxval(TheBins3)
+              try_b = 0
+              try_last = -1
+              do
+                try_sum = sum(TheBins3,mask = TheBins3 < (try_b + try_t)/2) 
+                if (try_sum > (1-contours(ix1))*norm) then
+                   try_t = (try_b+try_t)/2
+                else
+                   try_b = (try_b+try_t)/2
+                end if
+                if (try_sum == try_last) exit
+                try_last = try_sum
+          
+              end do
+              contour_levels(ix1) = (try_b+try_t)/2
+ 
+              end do
+              deallocate(TheBins3)
+             
+              
+              plotfile = numcat(trim(numcat(trim(numcat(trim(rootname)//'_4D_',colix(j)-2))//'_',colix(j2)-2))//'_',colix(j3)-2)
+              filename = 'plot_data/'//trim(plotfile)
+              open(unit=49,file=filename,form='formatted',status='replace')
+              maxbin = maxval(bin3Dlikes(ix_min(j):ix_max(j),ix_min(j2):ix_max(j2),ix_min(j3):ix_max(j3)))
+              do ix1 = ix_min(j), ix_max(j)
+                 do ix2 = ix_min(j2), ix_max(j2)
+                    do ix3 = ix_min(j3), ix_max(j3)
+                       write (49,'(6(E16.7))') center(j) + ix1*width(j), center(j2) + ix2*width(j2) &
+                            , center(j3) + ix3*width(j3) , bins3D(ix1,ix2,ix3),bin3Dmax(ix1,ix2,ix3) &
+                            , bin3Dlikes(ix1,ix2,ix3)/maxbin
+                    end do
+                 enddo
+              enddo
+              
+              close(49)
+ 
+ 
+ 
+              open(unit=49,file=trim(filename)//'_cont',form='formatted',status='replace')
+             write(numstr,*) contour_levels(1:num_contours)
+             if (num_contours==1) numstr = trim(numstr)//' '//trim(numstr)
+             write (49,*) trim(numstr)
+             close(49)
+ 
+ 
+              deallocate(bins3D,bin3Dmax,bin3Dlikes)
+      
+         end subroutine Get4DPlotData
+ !end addon
  
          subroutine Get2DPlotData(j,j2)
           integer, intent(in) :: j,j2
***************
*** 1339,1351 ****
--- 1523,1550 ----
   !             write (aunit,fmt) (/(I, I=ix_min(j), ix_max(j), 1)/)*width(j)+center(j)
                if (DoShade) then
                if (shade_meanlikes) then
+ !addon
                  write (aunit,'(a)') "load (fullfile('"//trim(plot_data_dir)//"','" // trim(plotfile) //'_likes''));'
+                 if (td_meanlikes) then
+                    write (aunit,*) 'surfl(x1,x2,'//trim(plotfile)//'_likes);'
+                 else
                  write (aunit,*) 'contourf(x1,x2,'//trim(plotfile)//'_likes,64);'
+                 endif
+ !end addon
                else     
                  write (aunit,*) 'contourf(x1,x2,pts,64);'
                end if
  
+ !addon
+ !              write (aunit,*) 'set(gca,''climmode'',''manual''); shading flat; hold on;'
+               if (td_meanlikes) then
+                  write (aunit,*) 'set(gca,''climmode'',''manual'');shading interp; hold on;'
+                  write (aunit,*) 'grid off;box on;camproj(''perspective'');'
+                  write (aunit,*) 'set(gca,''climmode'',''manual'');alpha(0.9);axis tight'
+               else
                write (aunit,*) 'set(gca,''climmode'',''manual''); shading flat; hold on;'
+               endif
+ !end addon
                end if
                
             
***************
*** 1549,1555 ****
  
          real thin_cool
          logical no_tests, auto_label
! 
          logical :: single_column_chain_files, samples_are_chains
          integer sz
          !for single_colum_chain_files    
--- 1748,1756 ----
  
          real thin_cool
          logical no_tests, auto_label
! !addon
!         integer :: w,j3,i2
! !end addon
          logical :: single_column_chain_files, samples_are_chains
          integer sz
          !for single_colum_chain_files    
***************
*** 1762,1767 ****
--- 1963,1972 ----
            write (*,*) 'WARNING: Mapping params - .covmat file is new params.'
  
      shade_meanlikes = Ini_Read_Logical('shade_meanlikes',.false.)   
+ !addon
+     td_meanlikes = Ini_Read_Logical('td_meanlikes',.false.)  
+     volume_plots = Ini_Read_Logical('volume_plots',.false.)
+ !end addon
  
      matlab_col = Ini_Read_String('matlab_colscheme')
      smoothing = Ini_Read_Logical('smoothing',.true.)
***************
*** 2435,2441 ****
--- 2640,2653 ----
                write (51,*)  'set(gcf, ''PaperUnits'',''inches'');'
       
                if (plot_row < plot_col .and. plot_row*plot_col>9) then
+ !addon
+ !            write (51,*) 'set(gcf, ''PaperPosition'',[ 0 0 8 10]);';
+          if (td_meanlikes) then
+             write (51,*) 'set(gcf, ''PaperPosition'',[ 0 0 7 9]);';
+          else
                  write (51,*) 'set(gcf, ''PaperPosition'',[ 0 0 8 10]);';
+          endif
+ !end addon           
                else
                  write (51,*) 'set(gcf, ''PaperPosition'',[ 0 0 8 8]);';
                end if
***************
*** 2637,2642 ****
--- 2849,2881 ----
            end if
      
     
+ !addon
+           if (num_3D_plots /=0 .and. .not. no_plots .and. volume_plots) then
+              write (*,*) 'Producing ',num_3D_plots,' 3D volume plots'
+              
+              do i=1, num_3D_plots
+                 read(plot_3D(i),*) ix1,ix2,ix3
+ !                print *,'p1 p2 p3',ix1, ix2, ix3
+                 j=0
+                 j2=0
+                 j3=0
+                 do w = 1,num_vars
+ !                   print *,'colix',colix(w)
+                    if (colix(w)-2.eq.ix1) j = w
+                    if (colix(w)-2.eq.ix2) j2 = w
+                    if (colix(w)-2.eq.ix3) j3 = w
+                 enddo
+ !                print *,'jj2j3',j,j2,j3
+                 if (j*j2*j3.eq.0) then
+                    print *
+                    print *,ix1,ix2,ix3,' not in 1D: skipped'
+                    print *
+                 else
+                    call Get4DPlotData(j,j2,j3)  
+                 endif
+              enddo
+           endif
+ !end addon
  
  !write out stats
  !Marginalized
diff -r -c -b -B -N cosmomc/source/lrggettheory.f90 cosmomc_addon/source/lrggettheory.f90
*** cosmomc/source/lrggettheory.f90	2009-10-27 00:48:14.000000000 +0100
--- cosmomc_addon/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/lrggettheory.F90 cosmomc_addon/source/lrggettheory.F90
*** cosmomc/source/lrggettheory.F90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/lrggettheory.F90	2009-10-28 12:02:35.376021546 +0100
***************
*** 0 ****
--- 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
diff -r -c -b -B -N cosmomc/source/Makefile cosmomc_addon/source/Makefile
*** cosmomc/source/Makefile	2009-10-27 16:42:57.000000000 +0100
--- cosmomc_addon/source/Makefile	2009-10-28 12:00:05.672022401 +0100
***************
*** 1,118 ****
! #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
--- 1,84 ----
! # >>> DESIGNED FOR GMAKE <<<
  
! # Unified Systems makefile for COSMOMC
! # Add FLAGS -DMPI for using MPI
! 
! ext=$(shell uname | cut -c1-3)
! 
! CC=cc
! 
! ifeq ($(ext),IRI)
! F90C= f90
! FFLAGS= -Ofast -mp -n32 -LANG:recursive=ON -lmpi -DMPI
! WMAPFLAGS= $(FFLAGS)
! LAPACKL = -lcomplib.sgimath_mp
! INCLUDE = -I../camb
! CFITSIODIR = /people/ringeval/usr
! GSLDIR =
! endif
! 
! ifeq ($(ext),Lin)
! F90C=gfortran
! FFLAGS= -O -fopenmp
! WMAPFLAGS= -O
! LAPACKL = -llapack
! INCLUDE = -I../camb 
! CFITSIODIR = /opt/gnu/cfitsio
! GSLDIR = /usr
! endif 
  
! ifeq ($(ext),OSF)
! F90C=f90
! FFLAGS= -omp -O -arch host -math_library fast -tune host -fpe1
! WMAPFLAGS= $(FFLAGS)
! LAPACKL  = -lcxml
! INCLUDE = -I../camb 
! CFITSIODIR = 
! GSLDIR =
! endif
  
! ifeq ($(ext),Sun)
! F90C=f90
! FFLAGS= -O4 -xarch=native64 -openmp -ftrap=%none
! WMAPFLAGS= $(FFLAGS)
! LAPACKL = -lsunperf -lfsu
! INCLUDE = -I../camb -M../camb
! CFITSIODIR = 
! GSLDIR =
! endif
! 
! ifeq ($(ext),AIX)
! F90C    = mpxlf90_r
! FFLAGS  = -O4 -WF,-DIBMXL,-DMPI -qstrict -qsmp=omp -qmaxmem=-1 -qsuffix=f=f90:cpp=F90
! WMAPFLAGS= $(FFLAGS)
! LAPACKL = -lessl
! INCLUDE = -I../camb
! CFITSIODIR = 
! GSLDIR =
! endif
! 
! #EXTDATA = LRG
! EXTDATA = LRG
! EXTINCLUDE = -I$(GSLDIR)/include
! EXTOBJS = bsplinepk.o
! 
! 
! WMAPDIR = ../WMAP
! WMAPINCLUDE = -I$(CFITSIODIR)/include
! WMAPOBJS = read_archive_map.o \
! 	read_fits.o \
! 	healpix_types.o \
! 	br_mod_dist.o \
! 	WMAP_5yr_options.o \
! 	WMAP_5yr_util.o \
! 	WMAP_5yr_gibbs.o \
! 	WMAP_5yr_tt_pixlike.o \
! 	WMAP_5yr_tt_beam_ptsrc_chisq.o \
! 	WMAP_5yr_teeebb_pixlike.o \
! 	WMAP_5yr_tetbeebbeb_pixlike.o \
! 	WMAP_5yr_likelihood.o
  
  
  
  PROPOSE = propose.o
  CLSFILE = CMB_Cls_simple.o
***************
*** 120,132 ****
  #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
  
--- 86,101 ----
  #Can use params_H if you prefer more generic parameters
  PARAMETERIZATION = params_CMB.o
  
  LINKFLAGS =  -L../camb -lcamb  $(LAPACKL)
  
+ F90FLAGS = -DMATRIX_SINGLE $(FFLAGS) $(INCLUDE)
+ 
  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
  
***************
*** 130,163 ****
  	$(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
--- 99,124 ----
  	$(CLSFILE) paramdef.o $(PROPOSE) $(PARAMETERIZATION) calclike.o \
  	conjgrad_wrapper.o EstCovmat.o postprocess.o MCMC.o driver.o
  
  ifeq ($(EXTDATA),LRG)	
  F90FLAGS += -DDR71RG
! EXTINCLUDE = -I$(GSLDIR)/include
! LINKFLAGS += -lgsl -lgslcblas
! OBJFILES += $(EXTOBJS)
! endif	
! 
! ifneq ($(WMAPDIR),)
! F90FLAGS += $(WMAPINCLUDE)
! LINKFLAGS += -L$(CFITSIODIR)/lib -lcfitsio
! OBJFILES += $(WMAPOBJS)
  else
  F90FLAGS += -DNOWMAP
  endif
  
  
! 
! default: cosmomc.$(ext)
! 
! all : cosmomc.$(ext) getdist.$(ext)
  
  utils.o: ../camb/libcamb.a
  settings.o: utils.o
***************
*** 181,194 ****
  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
--- 142,159 ----
  MCMC.o: calclike.o
  driver.o: MCMC.o
  
  .f.o:
  	f77 $(F90FLAGS) -c $<
  
  %.o: %.c
! 	$(CC) $(EXTINCLUDE) -c $*.c
! 
! %.o: $(WMAPDIR)/%.f90
! 	$(F90C) $(WMAPFLAGS) $(WMAPINCLUDE) -c $<
! 
! %.o: $(WMAPDIR)/%.F90
! 	$(F90C) $(WMAPFLAGS) $(WMAPINCLUDE) -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
--- 162,173 ----
  	$(F90C) $(F90FLAGS) -c $*.F90
  
  
! cosmomc.$(ext): $(OBJFILES) ../camb/libcamb.a 	
! 	$(F90C) -o ../$@ $(OBJFILES) $(LINKFLAGS) $(F90FLAGS)
  
  
! clean:
  	rm -f *.o *.mod *.d *.pc *.obj ../core
  
! getdist.$(ext): $(DISTFILES)
! 	$(F90C) -o ../$@ $(DISTFILES) $(LINKFLAGS) $(F90FLAGS) 
diff -r -c -b -B -N cosmomc/source/MCMC.f90 cosmomc_addon/source/MCMC.f90
*** cosmomc/source/MCMC.f90	2009-09-18 18:32:05.000000000 +0200
--- cosmomc_addon/source/MCMC.f90	2009-10-27 18:29:44.137456952 +0100
***************
*** 215,221 ****
    
      Like = GetLogLike(grid(r))
     
!     if (Feedback > 1) write (*,*) r, 'Likelihood: ', Like, 'Current Like:', CurLike
  
      if ((Like /= logZero) .and. (CurLike > Like .or. randexp1() > Like - CurLike)) then
      !Accept
--- 215,221 ----
    
      Like = GetLogLike(grid(r))
     
!     if (Feedback > 1) write (*,*) r, 'Likelihood: ', Like, 'Current Like:', CurLike, 'Rank:',MPIRank
  
      if ((Like /= logZero) .and. (CurLike > Like .or. randexp1() > Like - CurLike)) then
      !Accept
***************
*** 501,507 ****
             output_lines = output_lines +1
             call WriteParams(CurParams, real(mult), CurLike)
            end if
!           if (Feedback > 1) write (*,*) instance, 'Slicing, Current Like:', CurLike
            mult = 1
            if (num_slow /=0) call SliceSampleSlowParam(CurParams, CurLike) 
            if (num_fast /=0) call SliceSampleFastParams(CurParams, CurLike) 
--- 501,507 ----
             output_lines = output_lines +1
             call WriteParams(CurParams, real(mult), CurLike)
            end if
!           if (Feedback > 1) write (*,*) instance, 'Slicing, Current Like:', CurLike, 'Rank:',MPIRank
            mult = 1
            if (num_slow /=0) call SliceSampleSlowParam(CurParams, CurLike) 
            if (num_fast /=0) call SliceSampleFastParams(CurParams, CurLike) 
***************
*** 536,542 ****
  
      Like = GetLogLike(Trial) 
  
!     if (Feedback > 1) write (*,*) 'Likelihood: ', Like, 'Current Like:', CurLike
  
  !!!    accpt = (Like /= logZero) .and. (CurLike > Like .or. randexp1() > Like - CurLike) 
               !Include the min() so that compilers not doing optimal compilation don't complain
--- 536,542 ----
  
      Like = GetLogLike(Trial) 
  
!     if (Feedback > 1) write (*,*) 'Likelihood: ', Like, 'Current Like:', CurLike, 'Rank:',MPIRank
  
  !!!    accpt = (Like /= logZero) .and. (CurLike > Like .or. randexp1() > Like - CurLike) 
               !Include the min() so that compilers not doing optimal compilation don't complain
diff -r -c -b -B -N cosmomc/source/mpk.f90 cosmomc_addon/source/mpk.f90
*** cosmomc/source/mpk.f90	2009-10-23 10:48:04.000000000 +0200
--- cosmomc_addon/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/mpk.F90 cosmomc_addon/source/mpk.F90
*** cosmomc/source/mpk.F90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/mpk.F90	2009-10-28 12:02:35.376021546 +0100
***************
*** 0 ****
--- 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
diff -r -c -b -B -N cosmomc/source/params.ini cosmomc_addon/source/params.ini
*** cosmomc/source/params.ini	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/params.ini	2009-10-27 18:28:07.281067670 +0100
***************
*** 0 ****
--- 1,190 ----
+ #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 = T
+ 
+ 
+ #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
+ l_accuracy_level = 1
+ l_sample_level = 1
+ camb_compute_every_l = F
+ 
+ #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
diff -r -c -b -B -N cosmomc/source/settings.f90 cosmomc_addon/source/settings.f90
*** cosmomc/source/settings.f90	2009-10-22 11:33:09.000000000 +0200
--- cosmomc_addon/source/settings.f90	1970-01-01 01:00:00.000000000 +0100
***************
*** 1,192 ****
- module settings
-   use AMLutils
-   use Random
-   use IniFile
-   use ParamNames
-   implicit none
- 
-   real :: AccuracyLevel = 1.
-   !Set to >1 to use CAMB etc on higher accuracy settings. 
-   !Does not affect MCMC (except making it all slower)
- 
- !num_norm is number of calibration and normalization parameters (fast)
- !         should be 2 or larger (scale for the scalar Cl, and the T/S ratio
- !num_initpower is the number of initial power parameters
- !num_hard is the number of 'hard' parameters
- !num_freq_params are parameters for frequency-dependant part of CMB signal
- !                 by default just one, an SZ amplitude
- !num_nuisance_params is number of nuisance parameters used internally by data likelihoods
- !                    (e.g. beam uncertainty modes, etc, specific to dataset)
- 
-   integer, parameter :: num_hard =7 
-   integer, parameter :: num_initpower = 3 
-   integer, parameter :: num_freq_params = 1
-   integer, parameter :: num_norm = 2 + num_freq_params 
-   integer, parameter :: num_nuisance_params= 0
- 
-   logical :: use_fast_slow = .false.
-     !Set to false if using a slow likelihood function so no there's point is treating
-     !'fast' parameters differently (in fact, doing so will make performance worse)
- 
-   Type(TParamNames) :: NameMapping
- 
-   integer :: oversample_fast = 0
-   integer, parameter :: sampling_metropolis = 1, sampling_slice = 2, sampling_fastslice =3, &
-          sampling_slowgrid = 4,  sampling_multicanonical = 5,  sampling_wang_landau = 6
- 
-   integer :: sampling_method = sampling_metropolis
-  
-   !scale of the proposal distribution in units of the posterior standard deviation
-   real    :: propose_scale  = 2.4 
- 
- !The rest are set up automatically
- 
-   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   
- 
-   character(LEN=1024) :: DataDir='data/';
- 
-   integer, parameter :: num_fast_params = num_initpower + num_norm + num_nuisance_params
- 
-   integer, parameter :: num_params = num_norm + num_initpower + num_hard + num_nuisance_params
-   integer, parameter :: num_real_params = num_norm + num_initpower + num_hard 
-   integer, parameter :: index_initpower = num_hard+1
-   integer, parameter :: index_norm = index_initpower + num_initpower
-   integer, parameter :: index_nuisance = index_norm  + num_norm
-   integer, dimension(:), allocatable :: params_used,fast_params_used
-   integer num_params_used, num_fast, num_slow, nuisance_params_used
- 
-   integer :: num_threads = 0
-   integer :: instance = 0
-   integer :: MPIchains = 1, MPIrank = 0
- 
-   logical :: Use_LSS = .true.
- 
-   integer :: logfile_unit  = 0
-   integer :: outfile_handle = 0 
-   integer :: indepfile_handle = 0
-   integer :: slow_proposals = 0
-   integer :: output_lines = 0
- 
-   real, parameter :: logZero = 1e30
-   character (LEN =120) :: FileChangeIni = '', FileChangeIniAll = ''
- 
- 
- contains
- 
-   function ReadIniFileName(Ini,key) result (filename)
-    Type(TIniFile) :: Ini
-    character(LEN=*), intent(in) :: Key
-    character(LEN=Ini_max_string_len) :: filename
-    
-    filename = Ini_Read_String_File(Ini, key)
-    call StringReplace('%DATASETDIR%',DataDir,filename)
- 
-   end function ReadIniFileName
- 
-  subroutine CheckParamChangeF(F)
-    character(LEN=*), intent(in) ::  F
-    logical bad, doexit
- 
-    if (F /= '') then
- 
-        call Ini_Open(F, tmp_file_unit, bad, .false.)
-        if (bad) return
-        Ini_fail_on_not_found = .false.
-        doexit = (Ini_Read_Int('exit',0) == 1) 
-        FeedBack = Ini_Read_Int('feedback',Feedback)
-        num_threads = Ini_Read_Int('num_threads',num_threads)
-        call Ini_Close
-        if (F== FileChangeIni) call DeleteFile(FileChangeini)
-        if (doexit) stop
- 
-    end if
- 
-  end subroutine CheckParamChangeF
- 
-  subroutine CheckParamChange
- 
-    call CheckParamChangeF(FileChangeIni)
-    if (FileChangeIni/=FileChangeIniAll) call CheckParamChangeF(FileChangeIniAll)
- 
-  end subroutine CheckParamChange
- 
-   subroutine ReadVector(aname, vec, n)
-    character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: n
-    real, intent(out) :: vec(n)
-    integer j
- 
-    if (Feedback > 0) write(*,*) 'reading: '//trim(aname)
- 
-    call OpenTxtFile(aname, tmp_file_unit)
- 
-    do j=1,n
-       read (tmp_file_unit,*, end = 200) vec(j)
-    end do
- 
- 
-     close(tmp_file_unit)
-     return
- 
-  200 write (*,*) 'vector file '//trim(aname)//' is the wrong size'
-      stop
- 
-  end subroutine ReadVector
- 
-  subroutine WriteVector(aname, vec, n)
-    character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: n
-    real, intent(in) :: vec(n)
-    integer j
-   
-    call CreateTxtFile(aname, tmp_file_unit)
- 
-    do j=1,n
-       write (tmp_file_unit,'(1E15.6)') vec(j)
-    end do
- 
-    close(tmp_file_unit)
-   
-  end subroutine WriteVector
- 
- 
-  subroutine ReadMatrix(aname, mat, m,n)
-    character(LEN=*), intent(IN) :: aname
-    integer, intent(in) :: m,n
-    real, intent(out) :: mat(m,n)
-    integer j,k
-    real tmp
- 
-    if (Feedback > 0) write(*,*) 'reading: '//trim(aname)
-    call OpenTxtFile(aname, tmp_file_unit)
- 
-    do j=1,m
-       read (tmp_file_unit,*, end = 200, err=100) mat(j,1:n)
-    end do
-    goto 120
- 
- 100 rewind(tmp_file_unit)  !Try other possible format
-    do j=1,m 
-     do k=1,n
-       read (tmp_file_unit,*, end = 200) mat(j,k)
-     end do
-    end do
- 
- 120 read (tmp_file_unit,*, err = 150, end =150) tmp
-    goto 200
- 
- 150 close(tmp_file_unit)
-     return
- 
-  200 write (*,*) 'matrix file '//trim(aname)//' is the wrong size'
-      stop
- 
-  end subroutine ReadMatrix
- 
- 
- end module settings
- 
--- 0 ----
diff -r -c -b -B -N cosmomc/source/settings.F90 cosmomc_addon/source/settings.F90
*** cosmomc/source/settings.F90	1970-01-01 01:00:00.000000000 +0100
--- cosmomc_addon/source/settings.F90	2009-10-27 18:29:48.013877674 +0100
***************
*** 0 ****
--- 1,200 ----
+ module settings
+   use AMLutils
+   use Random
+   use IniFile
+   use ParamNames
+   implicit none
+ 
+   real :: AccuracyLevel = 1.
+ !addon
+   real :: lAccuracyLevel = 1.
+   real :: lSampleLevel = 1.
+   logical :: CambComputeEveryl = .false.
+ !end addon
+   !Set to >1 to use CAMB etc on higher accuracy settings. 
+   !Does not affect MCMC (except making it all slower)
+ 
+ !num_norm is number of calibration and normalization parameters (fast)
+ !         should be 2 or larger (scale for the scalar Cl, and the T/S ratio
+ !num_initpower is the number of initial power parameters
+ !num_hard is the number of 'hard' parameters
+ !num_freq_params are parameters for frequency-dependant part of CMB signal
+ !                 by default just one, an SZ amplitude
+ !num_nuisance_params is number of nuisance parameters used internally by data likelihoods
+ !                    (e.g. beam uncertainty modes, etc, specific to dataset)
+ 
+   integer, parameter :: num_hard =7 
+   integer, parameter :: num_initpower = 3 
+   integer, parameter :: num_freq_params = 1
+   integer, parameter :: num_norm = 2 + num_freq_params 
+   integer, parameter :: num_nuisance_params= 0
+ 
+   logical :: use_fast_slow = .false.
+     !Set to false if using a slow likelihood function so no there's point is treating
+     !'fast' parameters differently (in fact, doing so will make performance worse)
+ 
+   Type(TParamNames) :: NameMapping
+ 
+   integer :: oversample_fast = 0
+   integer, parameter :: sampling_metropolis = 1, sampling_slice = 2, sampling_fastslice =3, &
+          sampling_slowgrid = 4,  sampling_multicanonical = 5,  sampling_wang_landau = 6
+ 
+   integer :: sampling_method = sampling_metropolis
+  
+   !scale of the proposal distribution in units of the posterior standard deviation
+   real    :: propose_scale  = 2.4 
+ 
+ !The rest are set up automatically
+ 
+   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   
+ 
+   character(LEN=1024) :: DataDir='data/';
+ 
+   integer, parameter :: num_fast_params = num_initpower + num_norm + num_nuisance_params
+ 
+   integer, parameter :: num_params = num_norm + num_initpower + num_hard + num_nuisance_params
+   integer, parameter :: num_real_params = num_norm + num_initpower + num_hard 
+   integer, parameter :: index_initpower = num_hard+1
+   integer, parameter :: index_norm = index_initpower + num_initpower
+   integer, parameter :: index_nuisance = index_norm  + num_norm
+   integer, dimension(:), allocatable :: params_used,fast_params_used
+   integer num_params_used, num_fast, num_slow, nuisance_params_used
+ 
+   integer :: num_threads = 0
+   integer :: instance = 0
+ !addon
+   integer :: instance_shift = 0
+ !end addon
+   integer :: MPIchains = 1, MPIrank = 0
+ 
+   logical :: Use_LSS = .true.
+ 
+   integer :: logfile_unit  = 0
+   integer :: outfile_handle = 0 
+   integer :: indepfile_handle = 0
+   integer :: slow_proposals = 0
+   integer :: output_lines = 0
+ 
+   real, parameter :: logZero = 1e30
+   character (LEN =120) :: FileChangeIni = '', FileChangeIniAll = ''
+ 
+ 
+ contains
+ 
+   function ReadIniFileName(Ini,key) result (filename)
+    Type(TIniFile) :: Ini
+    character(LEN=*), intent(in) :: Key
+    character(LEN=Ini_max_string_len) :: filename
+    
+    filename = Ini_Read_String_File(Ini, key)
+    call StringReplace('%DATASETDIR%',DataDir,filename)
+ 
+   end function ReadIniFileName
+ 
+  subroutine CheckParamChangeF(F)
+    character(LEN=*), intent(in) ::  F
+    logical bad, doexit
+ 
+    if (F /= '') then
+ 
+        call Ini_Open(F, tmp_file_unit, bad, .false.)
+        if (bad) return
+        Ini_fail_on_not_found = .false.
+        doexit = (Ini_Read_Int('exit',0) == 1) 
+        FeedBack = Ini_Read_Int('feedback',Feedback)
+        num_threads = Ini_Read_Int('num_threads',num_threads)
+        call Ini_Close
+        if (F== FileChangeIni) call DeleteFile(FileChangeini)
+        if (doexit) stop
+ 
+    end if
+ 
+  end subroutine CheckParamChangeF
+ 
+  subroutine CheckParamChange
+ 
+    call CheckParamChangeF(FileChangeIni)
+    if (FileChangeIni/=FileChangeIniAll) call CheckParamChangeF(FileChangeIniAll)
+ 
+  end subroutine CheckParamChange
+ 
+   subroutine ReadVector(aname, vec, n)
+    character(LEN=*), intent(IN) :: aname
+    integer, intent(in) :: n
+    real, intent(out) :: vec(n)
+    integer j
+ 
+    if (Feedback > 0) write(*,*) 'reading: '//trim(aname)
+ 
+    call OpenTxtFile(aname, tmp_file_unit)
+ 
+    do j=1,n
+       read (tmp_file_unit,*, end = 200) vec(j)
+    end do
+ 
+ 
+     close(tmp_file_unit)
+     return
+ 
+  200 write (*,*) 'vector file '//trim(aname)//' is the wrong size'
+      stop
+ 
+  end subroutine ReadVector
+ 
+  subroutine WriteVector(aname, vec, n)
+    character(LEN=*), intent(IN) :: aname
+    integer, intent(in) :: n
+    real, intent(in) :: vec(n)
+    integer j
+   
+    call CreateTxtFile(aname, tmp_file_unit)
+ 
+    do j=1,n
+       write (tmp_file_unit,'(1E15.6)') vec(j)
+    end do
+ 
+    close(tmp_file_unit)
+   
+  end subroutine WriteVector
+ 
+ 
+  subroutine ReadMatrix(aname, mat, m,n)
+    character(LEN=*), intent(IN) :: aname
+    integer, intent(in) :: m,n
+    real, intent(out) :: mat(m,n)
+    integer j,k
+    real tmp
+ 
+    if (Feedback > 0) write(*,*) 'reading: '//trim(aname)
+    call OpenTxtFile(aname, tmp_file_unit)
+ 
+    do j=1,m
+       read (tmp_file_unit,*, end = 200, err=100) mat(j,1:n)
+    end do
+    goto 120
+ 
+ 100 rewind(tmp_file_unit)  !Try other possible format
+    do j=1,m 
+     do k=1,n
+       read (tmp_file_unit,*, end = 200) mat(j,k)
+     end do
+    end do
+ 
+ 120 read (tmp_file_unit,*, err = 150, end =150) tmp
+    goto 200
+ 
+ 150 close(tmp_file_unit)
+     return
+ 
+  200 write (*,*) 'matrix file '//trim(aname)//' is the wrong size'
+      stop
+ 
+  end subroutine ReadMatrix
+ 
+ 
+ end module settings
+ 
