      SUBROUTINE afromc(a,c,ei,cc,rhocst1ov2,rhogas,nx,ny)
      include 'undefined.h'
      INTEGER nx,ny
      DOUBLE PRECISION a(nx,ny),c(nx,ny),ei(nx,ny),cc(nx,ny)
      DOUBLE PRECISION rhocst1ov2,rhogas ,dmax1,dmin1,cc1,cc2,cc3
      INTEGER i,j,ifetch,capdens

      capdens=0.
      i=ifetch("capdens",capdens)
      if(capdens.eq.1) then 
         do j=2,ny-1
            do i=2,nx-1
               cc1 = dmax1(0.d0, dmin1(cc(i,j),1.d0))
               cc2 = dmax1(0.d0, dmin1(cc(i+1,j),1.d0))
               cc3 = dmax1(0.d0, dmin1(cc(i,j+1),1.d0))
               a(i,j) = 1.d0/(rhocst1ov2*(cc1 + cc2) + rhogas)
               c(i,j) = 1.d0/(rhocst1ov2*(cc1 + cc3) + rhogas)
            enddo
         enddo
         do j=2,nx-1
            cc1 = dmax1(0.d0, dmin1(cc(j,1),1.d0))
            cc2 = dmax1(0.d0, dmin1(cc(j,2),1.d0))
            c(j,1) =  1.d0/(rhocst1ov2*(cc1 + cc2) + rhogas)
         enddo
         do j=2,ny-1
            cc1 = dmax1(0.d0, dmin1(cc(1,j),1.d0))
            cc2 = dmax1(0.d0, dmin1(cc(2,j),1.d0))
            a(1,j) = 1.d0/(rhocst1ov2*(cc1 + cc2) + rhogas)
         enddo
         do j=2,ny-1
            do i=2,nx-1
               ei(i,j) = 1.d0/(a(i,j) + a(i-1,j) + c(i,j) + c(i,j-1))
            enddo
         enddo
      else
c
         do j=2,ny-1
            do i=2,nx-1
               a(i,j) = 1.d0/(rhocst1ov2*(cc(i,j) +
     *         cc(i+1,j)) + rhogas)
               c(i,j) = 1.d0/(rhocst1ov2*(cc(i,j) + cc(i,j+1)) + rhogas)
            enddo
         enddo
         do j=2,nx-1
            c(j,1) =  1.d0/(rhocst1ov2*(cc(j,1) + cc(j,2)) + rhogas)
         enddo
         do j=2,ny-1
            a(1,j) = 1.d0/(rhocst1ov2*(cc(1,j) + cc(2,j)) + rhogas)
         enddo
         do j=2,ny-1
            do i=2,nx-1
               ei(i,j) = 1.d0/(a(i,j) + a(i-1,j) + c(i,j) + c(i,j-1))
            enddo
         enddo
      endif
      return
      end











