N.I.M.R.O.D.  

parametricEmpiricalBayes.f90

Go to the documentation of this file.
00001 
00002 !------------------------------------------------------------------------------
00003 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00004 !                effects based on Ordinary Differential equations
00005 !------------------------------------------------------------------------------
00006 !
00007 ! VERSION : 2.0
00008 !
00009 ! MODULE: parametricEmpiricalBayes.f90 function  writeFile_bayes
00028 subroutine writeFile_bayes()
00029     use WorkingSharedValues
00030     use mpimod
00031     implicit none
00032     integer::i,j
00033 
00034     ! *** individual PEB parameters
00035     open (888,file="./"// &
00036                           trim(adjustl(OutputFolder))//"/PEBParameters.txt")
00037     do i=1,nbpatient
00038         if (numproc.EQ.0) write(888,'(i4,1x,10(f10.6,1x))')idpat(i),emp_bayes(1:ndim,i)
00039     end do
00040     close(888)
00041 
00042     ! *** individual PEB trajectories
00043     open (888,file="./"// &
00044                           trim(adjustl(OutputFolder))//"/PEBTrajectories.txt")
00045     do i=1,nbpatient
00046         do j=1,tdef2-12
00047             if (numproc.EQ.0) write(888,'(i7,2x,i7,2x,100(f15.7,2x,f15.7,2x))') &
00048                 idpat(i),j-1,bayes_data(i,j,1:npmcomp),ICmoins(i,j,1:npmcomp),ICplus(i,j,1:npmcomp)
00049         end do
00050         if (numproc.EQ.0) write(888,*)
00051     end do
00052     close(888)
00053 end subroutine writeFile_bayes
00054 
00055 
00056 !------------------------------------------------------------------------------
00057 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00058 !                effects based on Ordinary Differential equations
00059 !------------------------------------------------------------------------------
00060 !
00061 ! VERSION : 2.0
00062 !
00063 ! MODULE: parametricEmpiricalBayes.f90 function EBCurves
00082 subroutine EBCurves(b)
00083     use WorkingSharedValues
00084     implicit none
00085     integer :: i,j,k
00086     double precision, dimension(ndim)::X
00087     double precision,dimension(tdef2,npmcomp):: deriv
00088     double precision,dimension(npm),intent(in)::b
00089 
00090     ! New time computation definition
00091     do i=1,nbpatient
00092         do k=1,npmcomp
00093             nbobs(i,k)=tdef2-10
00094         end do
00095     end do
00096     do j=1,tdef2-10
00097         schedule(1:nbpatient,j,1)=j-1
00098     end do
00099     call ODEschedule()
00100 
00101     ! Solver trajectories for each patient
00102     do i=1,nbpatient
00103         numpat1=i
00104         systeme=1
00105         X=0.d0
00106         b1=0.0D0
00107         b1(1:npmbio+npmexpl)=emp_bayes(1:npmbio+npmexpl,i)
00108         call solution(x,bayes_data(i,:,1:npmcomp),deriv)
00109     end do
00110 
00111     do i=1,npmcomp
00112     ICplus(:,:,i)=bayes_data(:,:,i)+1.96*b(npmbio+npmexpl+ndim+i)
00113     ICmoins(:,:,i)=bayes_data(:,:,i)-1.96*b(npmbio+npmexpl+ndim+i)
00114     end do
00115 
00116     ! Data transformation
00117     call removeObservationModel(ICplus)
00118     call removeObservationModel(ICmoins)
00119     call removeObservationModel(bayes_data)
00120 
00121     return
00122 end subroutine EBCurves
00123 
00124 
00125 
00126 !------------------------------------------------------------------------------
00127 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00128 !                effects based on Ordinary Differential equations
00129 !------------------------------------------------------------------------------
00130 !
00131 ! VERSION : 2.0
00132 !
00133 ! MODULE: parametricEmpiricalBayes.f90 function EmpiricalBayesEstimation
00155 subroutine EmpiricalBayesEstimation(b)
00156     use WorkingSharedValues
00157     implicit none
00158     integer :: i
00159     double precision,dimension(npm),intent(in)::b
00160     double precision :: rl,funcpa
00161     ! Shared values
00162     abserrfuncpa= 5.d-2!*controleRDM*npm/nbpatient
00163     rl=funcpa(b,npm,0,0.D0,0,0.D0)
00164     do i=1,nbpatient
00165        emp_bayes(:,i)=b(:)
00166     end do
00167     ! PEB calculation for parameters with random effects
00168     do i=1,ndim
00169         emp_bayes(i,1:nbpatient)=b(i)+startsauv(i,1:nbpatient)*b(npmbio+npmexpl+i)
00170     end do
00171 end subroutine EmpiricalBayesEstimation
00172