! ************************************************************* 
!
!   This is a software package CIAO
!
!     developed as a part of the national project "Research and 
!     Development of Innovative Simulation software",which is   
!     supported by the next-generation IT program of MEXT of Japan
!
!   latest version: 
!
!     4.0:  2013/01/17 
!           codes for spin-polarized pseudopotential generation are added
!
! ************************************************************* 
!
!  Software name : CIAO (Code for Investigating Atomic Orbitals)
!  Subroutine(s) : write_pcc
!  Author(s)     : Masakuni Okamoto (August 25, 2003)
!
!  The license of the code and contact address :
!  See the files, COPYRIGHT and LICENSE (or LICENSE_J.pdf)
!
!=====================================================================
   subroutine write_pcc(ier)
!=====================================================================
!
!  M. Okamoto
!     
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ir, ig
   ier = 0
   open(IFPCC,file=trim(pccfile),status='unknown')
   write(IFPCC,*) 'PCC electron density and its fourier transform'
   call write_file_header(IFPCC)
   write(IFPCC,*)
   write(IFPCC,31) rpos(nr0_pcc), 'rcut  '
   write(IFPCC,31) gmin_pcc,      'gcut  '
   write(IFPCC,*)
   write(IFPCC,*) 'rpos, rho_core, rho_pcc, rho_val'
   do ir = 1,nmesh
! ============================================= modified by K. T. ========== 4.0
!      write(IFPCC,10) rpos(ir),rho_core(ir),rho_pcore(ir),rho_ps(ir)
      write(IFPCC,10) rpos(ir),rho_core(ir),rho_pcore(ir),rho_ps(ir,1)
! ========================================================================== 4.0
   end do
   write(IFPCC,*)
   write(IFPCC,*) 'gpos, gg_rho_core, gg_rho_pcc, gg_rho_val'
   do ig = 1,ng_mesh
      write(IFPCC,10) gpos(ig),gg_rho_core(ig),gg_rho_pcore(ig), &
                      gg_rho_val(ig)
   end do
10 format(10(1pe20.10))
31 format(1x,f20.10, 5x,':',1x,a6)
   close(IFPCC)
   end subroutine write_pcc
