require(bvpSolve)
x <- seq(0, 1, length.out = 100)
rpar <- c(1e-4, 0, 10, 0)

feval <- "
      double precision :: eps, h1v, h3v, h2v, h4v, h5v,c11, F1v,F2v,
     & 		J21, k1, c12, c21, c22, c31, c32, F4v, c41, c42, c51, c52, 
     &		c61,c62, J3v, J4v, J5v, J2v, J1v, f3v, f5v, f6v, J31, J51,
     &		J41, J42,J12, J22, J32, J11, J52, J61, J62
	  
   	  c12=Y(1)
      c21=Y(2)
      c22=Y(3)
      c31=Y(4)
      c32=Y(5)
      k1=Y(6)
      F4v=Y(7)
      c41=Y(8)
      c42=Y(9)
      c51=Y(10)
      c52=Y(11)
      c61=Y(12)
      c22=Y(13)
  	  h1v= RPAR(3)
      h2v= RPAR(4)      
      h3v=RPAR(3)
      h2v=h4v
      h2v=h5v

      c11=20*Y(1)
      F1v=0.05/Y(1)
      F2v= -0.05/Y(3)


      if ((x.ge.0) .AND. (x.le.0.4)) then 
        J21=1.8
        J32=0
      else if ((x.gt.0.4) .AND. (x.lt.0.5)) then 
        J21=1.8+(-18+100*(c12-c41)*(x-0.4))
        J32=0.1*(c32-c42)*(x-0.4)
      else if ((x.ge.0.5) .and. (x.le.1)) then 
        J21=10*(c21-c41)
        J32=0.01*(c32-c42)
      end if
      
      
 	    J3v= h3v*((c41-c31)+(c42-c32))
      J4v=-(J1v+J2v+J3v+J5v)
      J1v=h1v*(c42-c11)+(c42-c12)
      J2v=h2v*(c41-c21)+(c41-c22)     
      f3v=k1/c31
      f5v=5
      f6v=0.05/c62
      J11=0
      J12=0
      J22=0
      J31=0
      J51=1000*(c51-c41)
      J52=1000*(c52-c42)
      J61=(0.75*c61)/(1+c61)
      J62=0
      J41=-(J11+J21+J31+J51)
      J42=- (J12+J22+J32+J52)

      F(1)=(20*h1v*(c21)**2)*(c41+c42-21*c12)
      F(2)=20*Y(3)*J21
      F(3)=0
      F(4)=((h3v/k1)*(c31)**2)*(c41+c42-c31-c32)
      F(5)=(c31/k1)*((J3v*c32)-J32)
      F(6)=0
      F(7)=-J4v
      F(8)=(1/F4v)*(J4v*c41-J41)
      F(9)=(1/F4v)*(J4v*c42-J42)
      F(10)= -200*(c51-c41)
      F(11)= -200*(c52-c42)
      F(12)= (20*c62)*(J62*c61-J61)
  	  F(13)= 20*(c62**2)
      F(14)=0
" 
ceval <- compile.func(feval, language = "Fortran")

fbnd <- "
      double precision :: eps, h1v, h3v, h2v, h4v, h5v,c11, F1v,F2v,
     & 		J21, k1, c12, c21, c22, c31, c32, F4v, c41, c42, c51, c52, 
     &		c61,c62, J3v, J4v, J5v, J2v, J1v, f3v, f5v, f6v, J31, J51,
     &		J41, J42,J12, J22, J32, J11, J52, J61, J62
      c12=Y(1)
      c21=Y(2)
      c22=Y(3)
      c31=Y(4)
      c32=Y(5)
      k1=Y(6)
      F4v=Y(7)
      c41=Y(8)
      c42=Y(9)
      c51=Y(10)
      c52=Y(11)
      c61=Y(12)
      c22=Y(13)

      
        if (i .eq. 1) g =c12-0.05
        if (i .eq. 2) g =c51-1
        if (i .eq. 3) g =c52-0.05
        if (i .eq. 4) g =F4v+5          
        if (i .eq. 5) g =(c31-20*k1*c31)-0
        if (i .eq. 6) g =c22-c62
        if (i .eq. 7) g =c61-c21
        if (i .eq. 8) g =c31-y(14)      ! was f(14)
c con 1
        if (i .eq. 9) g =c12-c22
        if (i .eq. 10) g =c21-20*c12
        if (i .eq. 11) g =c41-c51
        if (i .eq. 12) g =c42+c52          
        if (i .eq. 13) g =(c61-20*k1*c62)-0
        if (i .eq. 14) g=c31-y(14)      ! was f(14)
"
cbound <- compile.bound(fbnd, language = "Fortran")
out <- bvptwp(func = ceval, x = x,  ncomp = 12, leftbc = 8 , bound = cbound, rpar = rpar, cond = TRUE)        

