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

penalization.f90

Go to the documentation of this file.
00001 !------------------------------------------------------------------------------
00002 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00003 !                effects based on Ordinary Differential equations
00004 !------------------------------------------------------------------------------
00005 !
00006 ! VERSION : 1.0
00007 !
00008 ! MODULE: panalization.f90 function logLikelihood_penalization
00038 
00039 subroutine logLikelihood_penalization(bparam, pena)
00040     use WorkingSharedValues
00041     implicit none
00042     double precision, intent(out) :: pena
00043     double precision, dimension(npm), intent(in) :: bparam
00044     integer :: i
00045     pena=0.d0
00046     if (penalisationBiologique .NE. 0) then
00047         !
00048         ! *** Normal prior on bilogical parameters
00049         !
00050         do i=1,npmbio
00051             pena=pena-(bparam(i)-esp_prior(i))**2/(2*std_prior(i)**2)
00052         end do
00053         if(penalisationAll.NE.0) then
00054             !
00055             ! *** Normal prior on explanatory variables
00056             !
00057             do i=npmbio+1,npmbio+npmexpl
00058                 pena=pena-(bparam(i)-esp_prior(i))**2/(2*std_prior(i)**2)
00059             end do
00060             !
00061             ! *** Half Cauchy for random effects
00062             !
00063             do i=npmbio+npmexpl+1,npmbio+npmexpl+ndim
00064                 pena=pena-(bparam(i)-0.5D0)**2/(2*0.1D0**2)
00065             end do
00066             !
00067             ! *** Non informative jeffrey's for error measurment
00068             !
00069             do i=npmbio+npmexpl+ndim+1,npmbio+npmexpl+ndim+npmcomp
00070                 pena=pena-(bparam(i)-0.5D0)**2/(2*0.5D0**2)
00071             end do
00072         end if
00073     end if
00074     return
00075 end subroutine logLikelihood_penalization
00076 
00077 !------------------------------------------------------------------------------
00078 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00079 !                effects based on Ordinary Differential equations
00080 !------------------------------------------------------------------------------
00081 !
00082 ! VERSION : 1.0
00083 !
00084 ! MODULE: panalization.f90 function logLikelihood_penalization
00113 
00114 subroutine gradients_penalization(bparam,pena)
00115     use WorkingSharedValues
00116     implicit none
00117     double precision, dimension(npm),intent(out) :: pena
00118     double precision, dimension(npm), intent(in) :: bparam
00119     integer :: i
00120     pena(:)=0.D0
00121     IF (penalisationBiologique .eq. 1) THEN
00122         !
00123         ! *** Derivative of Normal prior on bilogical parameters
00124         !
00125         do i=1,npmbio
00126             pena(i)=-((bparam(i)-esp_prior(i))/((std_prior(i)**2)))
00127         end do
00128         if(penalisationAll.EQ.1) then
00129             !
00130             ! *** Derivative of Normal prior on explanatory variables
00131             !
00132             do i=npmbio+1,npmbio+npmexpl
00133                 pena(i)=-((bparam(i)-esp_prior(i))/((std_prior(i)**2)))
00134             end do
00135             !
00136             ! *** Derivative of Half Cauchy for random effects
00137             !
00138             do i=npmbio+npmexpl+1,npmbio+npmexpl+ndim
00139                 pena(i)=-((bparam(i)-0.5D0)/((0.1D0**2)))
00140             end do
00141             !
00142             ! *** Derivative of Non informative jeffrey's for error measurment
00143             !
00144             do i=npmbio+npmexpl+ndim+1,npmbio+npmexpl+ndim+npmcomp
00145                 pena(i)=-((bparam(i)-0.5D0)/((0.5D0**2)))
00146             end do
00147         end if
00148     end if
00149     return
00150 
00151 end subroutine gradients_penalization
00152 
00153 
00154 !------------------------------------------------------------------------------
00155 ! N.I.M.R.O.D. - Normal approximation Inference in Models with Random
00156 !                effects based on Ordinary Differential equations
00157 !------------------------------------------------------------------------------
00158 !
00159 ! VERSION : 1.0
00160 !
00161 ! MODULE: penalization.f90 function hessian_penalization
00190 subroutine hessian_penalization(bparam,pena)
00191     use WorkingSharedValues
00192     implicit none
00193     double precision, dimension(npm),intent(out) :: pena
00194     double precision, dimension(npm), intent(in) :: bparam
00195     integer :: i
00196     pena(:)=0.D0
00197     IF (penalisationBiologique .eq. 1) THEN
00198         !
00199         ! *** Second Derivative of Normal prior on bilogical parameters
00200         !
00201          do i=1,npmbio
00202             pena(i)=-(1/((std_prior(i)**2)))
00203          end do
00204          if (penalisationAll.EQ.1) then
00205             !
00206             ! *** Second Derivative of Normal prior on explanatory variables
00207             !
00208             do i=npmbio+1,npmbio+npmexpl
00209                pena(i)=-(1/((std_prior(i)**2)))
00210             end do
00211             !
00212             ! *** Second Derivative of Half Cauchy for random effects
00213             !
00214             do i=npmbio+npmexpl+1,npmbio+npmexpl+ndim
00215                pena(i)=-(1/((0.1D0**2)))
00216             end do
00217             !
00218             ! *** Second Derivative of Non informative jeffrey's for error measurment
00219             !
00220             do i=npmbio+npmexpl+ndim+1,npmbio+npmexpl+ndim+npmcomp
00221                pena(i)=-(1/((0.5D0**2)))
00222             end do
00223          end if
00224       END IF
00225     return
00226 
00227 end subroutine hessian_penalization
00228 
00229 
00230 
00231