      subroutine ccontr (icall,c1,c2,c3,ier1,ier2)
      USE ROCM_REAL,   ONLY: theta=>THETAC,y=>DV_ITM2
      USE NM_INTERFACE,ONLY: CELS
!      parameter (lth=40,lvr=30,no=50)
!      common /rocm0/ theta (lth)
!      common /rocm4/ y
!      double precision c1,c2,c3,theta,y,w,one,two
      double precision c1,c2,c3,w,one,two
      dimension c2(:),c3(:,:)
      data one,two/1.,2./
      if (icall.le.1) return
      w=y(1)
      if (LAMBDA .eq. 1.0) then
         y(1) = y(1)
      else if (y(1) .gt. 0.0) then
         if (LAMBDA .eq. 0.0) then
            y(1) = log(y(1) + one)
         else
            y(1) = ((y(1)+one)**LAMBDA-one)/LAMBDA
         end if
      else
         if (LAMBDA .eq. 2.0) then
            y(1) = -log(one - y(1))
         else
            y(1) = (1.0 - (1.0- y(1))**(2.0-LAMBDA))/(2.0 - LAMBDA)
         end if
      end if
      call cels (c1,c2,c3,ier1,ier2)
      y(1)=w
      if (y(1) .ge. 0) then
         c1=c1-two*(LAMBDA-one)*log(one+y(1))
      else
         c1=c1-two*(one-LAMBDA)*log(one-y(1))
      end if
      return
      end
