c***********************************************************************
c	tcrco2_subrut.f                              
c                                               
c	jan 98 	malv    version for mz1d. copied from solar10/mz4sub.f         
c       jul 2011 malv+fgg   adapted to LMD-MGCM
c***********************************************************************
                                                
************************************************************************
                                                
	subroutine dinterconnection ( v, vt )          
                                                
*  input: vib. temp. from che*.for programs, vt(nl)         
*  output: test vibrational temp. for other che*.for, v(nl) 
! iconex_smooth=1  ==>  with smoothing          
! iconex_smooth=0  ==>  without smoothing       
! iconex_tk=40  ==>  with forced lte up to 40 km            
! iconex_tk=20  ==>  with forced lte up to 20 km            
************************************************************************
                                                
        implicit none                           
	include 'nltedefs.h'          
                                                
c argumentos                                    
	real*8 vt(nl), v(nl)                           
                                                
c local variables                               
	integer 	i                                     
                                                
c   *************                               
                                                
	do i=1,nl                                      
	  v(i) = vt(i)                                 
	end do                                         
                                                
! lo siguiente se utilizaba en solar10, pero es mejor introducirlo en   
! la driver. por ahora no lo uso todavia.       
!	call fluctua(v,iconex_fluctua)                
!	call smooth_nl(v,iconex_smooth,nl)               
!	call forzar_tk(v,iconex_tk)                   
                                                
	return                                         
	end                  
                                                
c***********************************************************************
	subroutine smooth_nl(y,nlx,nl) 
                                                
c	returns smoothed y                            
c***********************************************************************
                                                
        implicit none                           
                                                
c arguments                          
        integer         nl      ! Dimension of vectors
	integer 	nlx	! i. =0 ==> no smoothing          
                                !    =m ==> smoothing from point m up to nl
	real*8		y(nl)	! o. is returned after smoothed  
                                                
c local variables and constants                 
	integer 	i  , nlmax   
        parameter ( nlmax=250 )         ! Llevarse esto al mz1d.par !
	real*8 		x(nlmax)                                 
                                                
c   ***************                             
                                                
	if (nlx.eq.0) return                          
                                                
	do i=nlx,nl                                    
	  x(i)=y(i)                                    
	  y(i)=0.                                      
	end do                                         
                                                
	do i=nlx,nl                                    
	  if(i.eq.nlx)then                             
		 y(i)=x(i)                                    
	  elseif(i.eq.nl)then                          
		 y(i)=2.*y(i-1)-y(i-2)                        
	  else                                         
		 y(i)=(x(i+1)/2.+x(i)+x(i-1)/2.)/2.           
	  end if                                       
	end do	                                        
                                                
	return                                         
	end                                            
                                                
c***********************************************************************
	function planckdp(tp,xnu)                      
c	returns the black body function at wavenumber xnu and temperature t.  
c***********************************************************************
                                                
	implicit none                                  

        include 'nltedefs.h'
	include 'nlte_data.h'      
!        common/datis/ pi, vlight, ee, hplanck, gamma, ab,
!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
!        real*8  pi, vlight, ee, hplanck, gamma, ab,
!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg

	real*8 planckdp                                
	real*8 xnu                                     
	real tp                                        
                                                
	planckdp = gamma*xnu**3.0 / exp( ee*xnu/dble(tp) )             
	!erg cm-2.sr-1/cm-1.                           
                                                
	return                                         
	end                                            
c***********************************************************************
	function planckdpdp(tp,xnu)                      
c	returns the black body function at wavenumber xnu and temperature t.  
c***********************************************************************
                                                
	implicit none                                  

        include 'nltedefs.h'
	include 'nlte_data.h'      
!        common/datis/ pi, vlight, ee, hplanck, gamma, ab,
!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg
!        real*8  pi, vlight, ee, hplanck, gamma, ab,
!     @       n_avog, GG, R0, cte_sb, kboltzman,  raddeg

	real*8 planckdpdp                               
	real*8 xnu                                     
	real*8 tp                                        
                                                
	planckdpdp = gamma*xnu**3.0 / exp( ee*xnu/dble(tp) )             
	!erg cm-2.sr-1/cm-1.                           
                                                
	return                                         
	end                                            
c       ****************************************************************
	function bandid (ib)                           
c       returns the 2 character code of the band            
c       ****************************************************************
        implicit none                           
                                                
        integer ib                              
        character*2 bandid                      
                                                
132     format(i2)                              
!        encode (2,132,bandid) ib                
        write ( bandid, 132) ib                
                                                
        if ( ib .eq. 1 ) bandid = '01'          
        if ( ib .eq. 2 ) bandid = '02'          
        if ( ib .eq. 3 ) bandid = '03'          
        if ( ib .eq. 4 ) bandid = '04'          
        if ( ib .eq. 5 ) bandid = '05'          
        if ( ib .eq. 6 ) bandid = '06'          
        if ( ib .eq. 7 ) bandid = '07'          
        if ( ib .eq. 8 ) bandid = '08'          
        if ( ib .eq. 9 ) bandid = '09'          
        if ( ib .eq. 0 ) bandid = '00'          
                                                
c end                                           
        return                                  
        end