Index: trunk/LMDZ.MARS/libf/aeronomars/calchim.F90
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/calchim.F90	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/calchim.F90	(revision 635)
@@ -98,4 +98,5 @@
       integer :: ig,l,i,iq,iqmax
       integer :: foundswitch, lswitch
+      integer,save :: chemthermod
 
       integer,save :: i_co2  = 0
@@ -113,4 +114,19 @@
       integer,save :: i_n2   = 0
       integer,save :: i_h2o  = 0
+      integer,save :: i_n    = 0
+      integer,save :: i_no   = 0
+      integer,save :: i_no2  = 0
+      integer,save :: i_n2d  = 0
+      integer,save :: i_co2plus=0
+      integer,save :: i_oplus=0
+      integer,save :: i_o2plus=0
+      integer,save :: i_coplus=0
+      integer,save :: i_cplus=0
+      integer,save :: i_nplus=0
+      integer,save :: i_noplus=0
+      integer,save :: i_n2plus=0
+      integer,save :: i_hplus=0
+      integer,save :: i_hco2plus=0
+      integer,save :: i_elec=0
 
       integer :: ig_vl1
@@ -157,5 +173,7 @@
 
          ! find index of chemical tracers to use
+         ! Listed here are all tracers that can go into photochemistry
          nbq = 0 ! to count number of tracers
+         ! Species ALWAYS present if photochem=.T. or thermochem=.T.
          i_co2 = igcm_co2
          if (i_co2 == 0) then
@@ -248,5 +266,5 @@
          i_ch4 = igcm_ch4
          if (i_ch4 == 0) then
-            write(*,*) "calchim: no CH4 tracer !!!"
+            write(*,*) "calchim: Error; no CH4 tracer !!!"
             write(*,*) "CH4 will be ignored in the chemistry"
          else
@@ -270,7 +288,280 @@
             niq(nbq) = i_h2o
          end if
+         !Check tracers needed for thermospheric chemistry
+         if(thermochem) then
+            chemthermod=0  !Default: C/O/H chemistry
+            !Nitrogen chemistry
+            !NO is used to determine if N chemistry is wanted
+            !chemthermod=2 -> N chemistry
+            i_no = igcm_no
+            if (i_no == 0) then
+               write(*,*) "calchim: no NO tracer"
+               write(*,*) "C/O/H themosp chemistry only "
+            else
+               nbq = nbq + 1
+               niq(nbq) = i_no
+               chemthermod=2
+               write(*,*) "calchim: NO in traceur.def"
+               write(*,*) "Nitrogen chemistry included"
+            end if
+            ! N
+            i_n = igcm_n
+            if(chemthermod == 2) then
+               if (i_n == 0) then
+                  write(*,*) "calchim: Error; no N tracer !!!"
+                  write(*,*) "N is needed if NO is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_n
+               end if
+            else 
+               if (i_n /= 0) then
+                  write(*,*) "calchim: Error: N is present, but NO is not!!!"
+                  write(*,*) "Both must be in traceur.def if N chemistry is wanted"
+                  stop
+               endif
+            endif    !Of if(chemthermod == 2) 
+            ! NO2
+            i_no2 = igcm_no2
+            if(chemthermod == 2) then
+               if (i_no2 == 0) then
+                  write(*,*) "calchim: Error; no NO2 tracer !!!"
+                  write(*,*) "NO2 is needed if NO is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_no2
+               end if
+            else
+               if (i_no2 /= 0) then
+                  write(*,*) "calchim: Error: N is present, but NO is not!!!"
+                  write(*,*) "Both must be in traceur.def if N chemistry is wanted"
+                  stop
+               endif
+            endif     !Of if(chemthermod == 2)
+            ! N(2D)
+            if(chemthermod == 2) then
+               i_n2d = igcm_n2d
+               if (i_n2d == 0) then
+                  write(*,*) "calchim: Error; no N2D !!!"
+                  write(*,*) "N2D is needed if NO is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_n2d
+               end if
+            else
+               if (i_n2d /= 0) then
+                  write(*,*) "calchim: Error: N2D is present, but NO is not!!!"
+                  write(*,*) "Both must be in traceur.def if N chemistry wanted"
+                  stop
+               endif
+            endif    !Of if(chemthermod == 2)
+            ! Ions
+            ! O2+ is used to determine if ion chemistry is needed
+            ! chemthermod=3 -> ion chemistry
+            i_o2plus = igcm_o2plus
+            if(chemthermod == 2) then
+               if (i_o2plus == 0) then
+                  write(*,*) "calchim: no O2+ tracer; no ion chemistry"
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_o2plus
+                  chemthermod = 3
+                  write(*,*) "calchim: O2+ in traceur.def"
+                  write(*,*) "Ion chemistry included"
+               end if
+            else
+               if (i_o2plus /= 0) then
+                  write(*,*) "calchim: O2+ is present, but NO is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if(chemthermod == 2)
+            ! CO2+
+            i_co2plus = igcm_co2plus
+            if(chemthermod == 3) then
+               if (i_co2plus == 0) then
+                  write(*,*) "calchim: Error; no CO2+ tracer !!!"
+                  write(*,*) "CO2+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_co2plus
+               end if
+            else
+               if (i_co2plus /= 0) then
+                  write(*,*) "calchim: Error: CO2+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif    !Of if(chemthermod == 3)
+            ! O+
+            i_oplus = igcm_oplus
+            if(chemthermod == 3) then
+               if (i_oplus == 0) then
+                  write(*,*) "calchim: Error; no O+ tracer !!!"
+                  write(*,*) "O+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_oplus
+               end if
+            else
+               if (i_oplus /= 0) then
+                  write(*,*) "calchim: Error: O+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+            ! CO+
+            i_coplus = igcm_coplus
+            if(chemthermod == 3) then
+               if (i_coplus == 0) then
+                  write(*,*) "calchim: Error; no CO+ tracer !!!"
+                  write(*,*) "CO+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_coplus
+               end if
+            else
+               if (i_coplus /= 0) then
+                  write(*,*) "calchim: Error: CO+ is present, but O2+ is not!!!"
+                  write(*,*) " Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   ! Of if (chemthermod == 3)
+            ! C+
+            i_cplus = igcm_cplus
+            if(chemthermod == 3) then
+               if (i_cplus == 0) then
+                  write(*,*) "calchim: Error; no C+ tracer !!!"
+                  write(*,*) "C+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_cplus
+               end if
+            else
+               if (i_cplus /= 0) then
+                  write(*,*) "calchim: Error; C+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   ! Of if (chemthermod == 3)
+            ! N+
+            i_nplus = igcm_nplus
+            if(chemthermod == 3) then
+               if (i_nplus == 0) then
+                  write(*,*) "calchim: Error; no N+ tracer !!!"
+                  write(*,*) "N+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_nplus
+               end if
+            else
+               if (i_nplus /= 0) then
+                  write(*,*) "calchim: Error: N+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+            ! NO+
+            i_noplus = igcm_noplus
+            if(chemthermod == 3) then
+               if (i_noplus == 0) then
+                  write(*,*) "calchim: Error; no NO+ tracer !!!"
+                  write(*,*) "NO+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_noplus
+               end if
+            else
+               if (i_noplus /= 0) then
+                  write(*,*) "calchim: Error: NO+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+            ! N2+
+            i_n2plus = igcm_n2plus
+            if (chemthermod == 3) then
+               if (i_n2plus == 0) then
+                  write(*,*) "calchim: Error; no N2+ tracer !!!"
+                  write(*,*) "N2+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_n2plus
+               end if
+            else
+               if (i_n2plus /= 0) then
+                  write(*,*) "calchim: Error: N2+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+            !H+
+            i_hplus = igcm_hplus
+            if (chemthermod == 3) then
+               if (i_hplus == 0) then
+                  write(*,*) "calchim: Error; no H+ tracer !!!"
+                  write(*,*) "H+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_hplus
+               end if
+            else
+               if (i_hplus /= 0) then
+                  write(*,*) "calchim: Error: H+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+            ! HCO2+
+            i_hco2plus = igcm_hco2plus
+            if(chemthermod == 3) then
+               if (i_hco2plus == 0) then
+                  write(*,*) "calchim: Error; no HCO2+ tracer !!!"
+                  write(*,*) "HCO2+ is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_hco2plus
+               end if
+            else
+               if (i_hco2plus /= 0) then
+                  write(*,*) "calchim: Error: HCO2+ is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif    !Of if(chemthermod == 3)
+            !e-
+            i_elec = igcm_elec
+            if(chemthermod == 3) then
+               if (i_elec == 0) then
+                  write(*,*) "calchim: Error; no e- tracer !!!"
+                  write(*,*) "e- is needed if O2+ is in traceur.def"
+                  stop
+               else
+                  nbq = nbq + 1
+                  niq(nbq) = i_elec
+               end if
+            else
+               if(i_elec /= 0) then
+                  write(*,*) "calchim: Error: e- is present, but O2+ is not!!!"
+                  write(*,*) "Both must be in traceur.def if ionosphere wanted"
+                  stop
+               endif
+            endif   !Of if (chemthermod == 3)
+         endif      !Of thermochem
 
          write(*,*) 'calchim: found nbq    = ',nbq,' tracers'
-         
+               
          firstcall = .false.
       end if ! if (firstcall)
@@ -279,6 +570,6 @@
 
       zycol(:,:)    = 0.
-      dqchim(:,:,:) = 0
-      dqschim(:,:)  = 0
+      dqchim(:,:,:) = 0.
+      dqschim(:,:)  = 0.
 
 !     latvl1= 22.27
@@ -292,5 +583,5 @@
 
       do ig = 1,ngridmx
-
+         
          foundswitch = 0
          do l = 1,nlayermx
@@ -316,5 +607,5 @@
 
             if (photochem .and. thermochem) then
-               if (foundswitch == 0 .and. pplay(ig,l) < 1.e-3) then
+               if (foundswitch == 0 .and. pplay(ig,l) < 1.e-1) then
                   lswitch = l
                   foundswitch = 1
@@ -357,8 +648,8 @@
 
 !        chemistry in upper atmosphere
-
+        
          if (thermochem) then
-            call chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,  &
-                             zlocal,szacol,ptimestep,zday)
+            call chemthermos(ig,lswitch,chemthermod,zycol,ztemp,zdens,  &
+                             zpress,zlocal,szacol,ptimestep,zday)
          end if
 
@@ -392,4 +683,5 @@
             end do
          end do ! of do l = 1,nlayermx
+!         if(ig.eq.800)write(*,*)'calchim/686',dqchim(ig,27,23)
 
 !=======================================================================
@@ -419,2 +711,3 @@
       return
       end
+
Index: trunk/LMDZ.MARS/libf/aeronomars/ch.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/ch.F	(revision 633)
+++ 	(revision )
@@ -1,550 +1,0 @@
-c 	************************************************************
-c
-c		chapman function for grazing incidence
-c
-c 	************************************************************
-
-	function ch(x,z) 
-
-	integer ierr
-	real ch,x
-
-	double precision ch1,sublim,z,error,aerr,rerr
-	double precision dcadre,fch
-	external fch,dcadre 
-
-	common/integ/ax,az
-	double precision ax,az 
-
-c
-
-	ax=x
-	az=z
-
-	aerr= 0.0d0
-	rerr= 0.0001d0 
-	sublim = 1.0d-4
-	ch1 = dcadre( fch, sublim, az, aerr, rerr, error, ierr )
-	ch = ax * sin(az) * ch1
-
-	return
-	end
-
-c 	************************************************************
-c
-c		integrand for the chapman function 
-c
-c 	************************************************************
-
-	double precision function fch(gi)
-
-	double precision gi
-
-	common/integ/x,z
-	double precision x,z 
-
-!	real x,z,a
-
-	fch = (1./sin(gi))**2. * exp( x *(1.- sin(z)/sin(gi)) )
-
-	return 
-	end
-
-
-
-
-******************************************************************************
-
-      double precision function dcadre (f,a,b,aerr,rerr,error,ier)              
-c                                  specifications for arguments                 
-      integer            ier                                                    
-      double precision   f,a,b,aerr,rerr,error                                  
-c                                  specifications for local variables           
-      integer            ibegs(30),maxts,maxtbl,mxstge,ibeg,ii,nnleft           
-      integer            i,n2,iii,istep2,iend,istep,l,lm1,it,istage,n           
-      double precision   t(10,10),r(10),ait(10),dif(10),rn(4),ts(2049)          
-      double precision   begin(30),finis(30),est(30)                            
-      double precision   h2tol,aittol,length,jumptl,zero,p1,half,one            
-      double precision   two,four,fourp5,ten,hun,cadre,aitlow                   
-      double precision   stepmn,stepnm,stage,curest,fnsize,hrerr                
-      double precision   prever,beg,fbeg,edn,fend,step,astep,tabs,hovn          
-      double precision   fn,sum,sumabs,vint,tabtlm,ergl,ergoal                  
-      double precision   erra,errr,fextrp,errer,diff,sing,fextm1                
-      double precision   h2next,singnx,slope,fbeg2,erret,h2tfex,fi              
-      logical            h2conv,aitken,right,reglar,reglsv(30)                  
-      data               aitlow,h2tol,aittol,jumptl,maxts,maxtbl,mxstge         
-     1                   /1.1d0,.15d0,.1d0,.01d0,2049,10,30/                    
-      data               rn(1),rn(2),rn(3),rn(4)/                               
-     1                   .7142005d0,.3466282d0,.843751d0,.1263305d0/            
-      data               zero,p1,half,one,two,four,fourp5,ten,hun               
-     1                   /0.0d0,0.1d0,0.5d0,1.0d0,2.0d0,4.0d0,                  
-     2                   4.5d0,10.0d0,100.0d0/                                  
-c                                  first executable statement                   
-      ier = 0                                                                   
-      cadre = zero                                                              
-      error = zero                                                              
-      curest = zero                                                             
-      vint = zero                                                               
-      length = dabs(b-a)
-
-      if (length .eq. zero) go to 215                                           
-      if (rerr .gt. p1 .or. rerr .lt. zero) go to 210                           
-      hrerr = rerr+hun                                                          
-      if (aerr .eq. zero .and. hrerr .le. hun) go to 210                        
-      errr = rerr                                                               
-      erra = dabs(aerr)                                                         
-      stepmn = length/(two**mxstge)                                             
-      stepnm = dmax1(length,dabs(a),dabs(b))*ten                                
-      stage = half                                                              
-      istage = 1                                                                
-      fnsize = zero                                                             
-      prever = zero                                                             
-      reglar = .false.                                                          
-c                                  the given interval of integration            
-c                                    is the first interval considered.          
-      beg = a                                                                   
-      fbeg = f(beg)*half                                                        
-      ts(1) = fbeg                                                              
-      ibeg = 1                                                                  
-      edn = b                                                                   
-      fend = f(edn)*half                                                        
-      ts(2) = fend                                                              
-      iend = 2                                                                  
-    5 right = .false.                                                           
-c                                  investigation of a particular                
-c                                    subinterval begins at this point.          
-   10 step = edn - beg                                                          
-      astep =  dabs(step)                                                       
-      if (astep .lt. stepmn) go to 205                                          
-      hrerr = stepnm+astep                                                      
-      if (hrerr .eq. stepnm) go to 205                                          
-      t(1,1) = fbeg + fend                                                      
-      tabs = dabs(fbeg) + dabs(fend)                                            
-      l = 1                                                                     
-      n = 1                                                                     
-      h2conv = .false.                                                          
-      aitken = .false.                                                          
-   15 lm1 = l                                                                   
-      l = l + 1                                                                 
-c                                  calculate the next trapezoid sum,            
-c                                    t(l,1), which is based on *n2* + 1         
-c                                    equispaced points. here,                   
-c                                    n2 = n*2 = 2**(l-1).                       
-      n2 = n+n                                                                  
-      fn = n2                                                                   
-      istep = (iend - ibeg)/n                                                   
-      if (istep .gt. 1) go to 25                                                
-      ii = iend                                                                 
-      iend = iend + n                                                           
-      if (iend .gt. maxts) go to 200                                            
-      hovn = step/fn                                                            
-      iii = iend                                                                
-      fi = one                                                                  
-      do 20 i=1,n2,2                                                            
-         ts(iii) = ts(ii)                                                       
-         ts(iii-1) = f(edn - fi * hovn)                                         
-         fi = fi+two                                                            
-         iii = iii-2                                                            
-         ii = ii-1                                                              
-   20 continue                                                                  
-      istep = 2                                                                 
-   25 istep2 = ibeg + istep/2                                                   
-      sum = zero                                                                
-      sumabs = zero                                                             
-      do 30 i=istep2,iend,istep                                                 
-         sum = sum + ts(i)                                                      
-         sumabs = sumabs + dabs(ts(i))                                          
-   30 continue                                                                  
-      t(l,1) = t(l-1,1)*half+sum/fn                                             
-      tabs = tabs*half+sumabs/fn                                                
-      n = n2                                                                    
-c                                  get preliminary value for *vint*             
-c                                    from last trapezoid sum and update         
-c                                    the error requirement *ergoal*             
-c                                    for this subinterval.                      
-      it = 1                                                                    
-      vint = step*t(l,1)                                                        
-      tabtlm = tabs*ten                                                         
-      fnsize = dmax1(fnsize,dabs(t(l,1)))                                       
-      ergl = astep*fnsize*ten                                                   
-      ergoal = stage*dmax1(erra,errr*dabs(curest+vint))                         
-c                                  complete row l and column l of *t*           
-c                                    array.                                     
-      fextrp = one                                                              
-      do 35 i=1,lm1                                                             
-         fextrp = fextrp*four                                                   
-         t(i,l) = t(l,i) - t(l-1,i)                                             
-         t(l,i+1) = t(l,i) + t(i,l)/(fextrp-one)                                
-   35 continue                                                                  
-      errer = astep*dabs(t(1,l))                                                
-c                                  preliminary decision procedure               
-c                                    if l = 2 and t(2,1) = t(1,1),              
-c                                    go to 135 to follow up the                 
-c                                    impression that intergrand is              
-c                                    straight line.                             
-      if (l .gt. 2) go to 40                                                    
-      hrerr = tabs+p1*dabs(t(1,2))                                              
-      if (hrerr .eq. tabs) go to 135                                            
-      go to 15                                                                  
-c                                  caculate next ratios for                     
-c                                    columns 1,...,l-2 of t-table               
-c                                    ratio is set to zero if difference         
-c                                    in last two entries of column is           
-c                                    about zero                                 
-   40 do 45 i=2,lm1                                                             
-         diff = zero                                                            
-         hrerr = tabtlm+dabs(t(i-1,l))                                          
-         if (hrerr .ne. tabtlm) diff = t(i-1,lm1)/t(i-1,l)                      
-         t(i-1,lm1) = diff                                                      
-   45 continue                                                                  
-      if (dabs(four-t(1,lm1)) .le. h2tol) go to 60                              
-      if (t(1,lm1) .eq. zero) go to 55                                          
-      if (dabs(two-dabs(t(1,lm1))) .lt. jumptl) go to 130                       
-      if (l .eq. 3) go to 15                                                    
-      h2conv = .false.                                                          
-      if (dabs((t(1,lm1)-t(1,l-2))/t(1,lm1)) .le. aittol) go to 75              
-   50 if (reglar) go to 55                                                      
-      if (l .eq. 4) go to 15                                                    
-      hrerr = ergl+errer                                                        
-   55 if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
-      go to 145                                                                 
-c                                  cautious romberg extrapolation               
-   60 if (h2conv) go to 65                                                      
-      aitken = .false.                                                          
-      h2conv = .true.                                                           
-   65 fextrp = four                                                             
-   70 it = it + 1                                                               
-      vint = step*t(l,it)                                                       
-      errer = dabs(step/(fextrp-one)*t(it-1,l))                                 
-      if (errer .le. ergoal) go to 160                                          
-      hrerr = ergl+errer                                                        
-      if (hrerr .eq. ergl) go to 160                                            
-      if (it .eq. lm1) go to 125                                                
-      if (t(it,lm1) .eq. zero) go to 70                                         
-      if (t(it,lm1) .le. fextrp) go to 125                                      
-      if (dabs(t(it,lm1)/four-fextrp)/fextrp .lt. aittol)                       
-     1       fextrp = fextrp*four                                               
-      go to 70                                                                  
-c                                  integrand may have x**alpha type             
-c                                    singularity                                
-c                                    resulting in a ratio of *sing*  =          
-c                                    2**(alpha + 1)                             
-   75 if (t(1,lm1) .lt. aitlow) go to 175                                       
-      if (aitken) go to 80                                                      
-      h2conv = .false.                                                          
-      aitken = .true.                                                           
-   80 fextrp = t(l-2,lm1)                                                       
-      if (fextrp .gt. fourp5) go to 65                                          
-      if (fextrp .lt. aitlow) go to 175                                         
-      if (dabs(fextrp-t(l-3,lm1))/t(1,lm1) .gt. h2tol) go to 175                
-      sing = fextrp                                                             
-      fextm1 = one/(fextrp - one)                                               
-      ait(1) = zero                                                             
-      do 85 i=2,l                                                               
-         ait(i) = t(i,1) + (t(i,1)-t(i-1,1))*fextm1                             
-         r(i) = t(1,i-1)                                                        
-         dif(i) = ait(i) - ait(i-1)                                             
-   85 continue                                                                  
-      it = 2                                                                    
-   90 vint = step*ait(l)                                                        
-      errer = errer*fextm1                                                      
-      hrerr = ergl+errer                                                        
-      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 95                     
-      ier = max0(ier,65)                                                        
-      go to 160                                                                 
-   95 it = it + 1                                                               
-      if (it .eq. lm1) go to 125                                                
-      if (it .gt. 3) go to 100                                                  
-      h2next = four                                                             
-      singnx = sing+sing                                                        
-  100 if (h2next .lt. singnx) go to 105                                         
-      fextrp = singnx                                                           
-      singnx = singnx+singnx                                                    
-      go to 110                                                                 
-  105 fextrp = h2next                                                           
-      h2next = four*h2next                                                      
-  110 do 115 i=it,lm1                                                           
-         r(i+1) = zero                                                          
-         hrerr = tabtlm+dabs(dif(i+1))                                          
-         if (hrerr .ne. tabtlm) r(i+1) = dif(i)/dif(i+1)                        
-  115 continue                                                                  
-      h2tfex = -h2tol*fextrp                                                    
-      if (r(l) - fextrp .lt. h2tfex) go to 125                                  
-      if (r(l-1)-fextrp .lt. h2tfex) go to 125                                  
-      errer = astep*dabs(dif(l))                                                
-      fextm1 = one/(fextrp - one)                                               
-      do 120 i=it,l                                                             
-         ait(i) = ait(i) + dif(i)*fextm1                                        
-         dif(i) = ait(i) - ait(i-1)                                             
-  120 continue                                                                  
-      go to 90                                                                  
-c                                  current trapezoid sum and resulting          
-c                                    extrapolated values did not give           
-c                                    a small enough *errer*.                    
-c                                    note -- having prever .lt. errer           
-c                                    is an almost certain sign of               
-c                                    beginning trouble with in the func-        
-c                                    tion values. hence, a watch for,           
-c                                    and control of, noise should               
-c                                    begin here.                                
-  125 fextrp = dmax1(prever/errer,aitlow)                                       
-      prever = errer                                                            
-      if (l .lt. 5) go to 15                                                    
-      if (l-it .gt. 2 .and. istage .lt. mxstge) go to 170                       
-      erret = errer/(fextrp**(maxtbl-l))                                        
-      hrerr = ergl+erret                                                        
-      if (erret .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
-      go to 15                                                                  
-c                                  integrand has jump (see notes)               
-  130 hrerr = ergl+errer                                                        
-      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 170                    
-c                                  note that  2*fn = 2**l                       
-      diff = dabs(t(1,l))*(fn+fn)                                               
-      go to 160                                                                 
-c                                  integrand is straight line                   
-c                                    test this assumption by comparing          
-c                                    the value of the integrand at              
-c                                    four *randomly chosen* points with         
-c                                    the value of the straight line             
-c                                    interpolating the integrand at the         
-c                                    two end points of the sub-interval.        
-c                                    if test is passed, accept *vint*           
-  135 slope = (fend-fbeg)*two                                                   
-      fbeg2 = fbeg+fbeg                                                         
-      do 140 i=1,4                                                              
-         diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                     
-         hrerr = tabtlm+diff                                                    
-         if(hrerr .ne. tabtlm) go to 155                                        
-  140 continue                                                                  
-      go to 160                                                                 
-c                                  noise may be dominant feature                
-c                                    estimate noise level by comparing          
-c                                    the value of the integrand at              
-c                                    four *randomly chosen* points with         
-c                                    the value of the straight line             
-c                                    interpolating the integrand at the         
-c                                    two endpoints. if small enough,            
-c                                    accept *vint*                              
-  145 slope = (fend-fbeg)*two                                                   
-      fbeg2 = fbeg+fbeg                                                         
-      i = 1                                                                     
-  150 diff = dabs(f(beg+rn(i)*step) - fbeg2-rn(i)*slope)                        
-  155 errer = dmax1(errer,astep*diff)                                           
-      hrerr = ergl+errer                                                        
-      if (errer .gt. ergoal .and. hrerr .ne. ergl) go to 175                    
-      i = i+1                                                                   
-      if (i .le. 4) go to 150                                                   
-      ier = 66                                                                  
-c                                  intergration over current sub-               
-c                                    interval successful                        
-c                                    add *vint* to *dcadre* and *errer*         
-c                                    to *error*, then set up next sub-          
-c                                    interval, if any.                          
-  160 cadre = cadre + vint                                                      
-      error = error + errer                                                     
-      if (right) go to 165                                                      
-      istage = istage - 1                                                       
-      if (istage .eq. 0) go to 220                                              
-      reglar = reglsv(istage)                                                   
-      beg = begin(istage)                                                       
-      edn = finis(istage)                                                       
-      curest = curest - est(istage+1) + vint                                    
-      iend = ibeg - 1                                                           
-      fend = ts(iend)                                                           
-      ibeg = ibegs(istage)                                                      
-      go to 180                                                                 
-  165 curest = curest + vint                                                    
-      stage = stage+stage                                                       
-      iend = ibeg                                                               
-      ibeg = ibegs(istage)                                                      
-      edn = beg                                                                 
-      beg = begin(istage)                                                       
-      fend = fbeg                                                               
-      fbeg = ts(ibeg)                                                           
-      go to 5                                                                   
-c                                  integration over current subinterval         
-c                                    is unsuccessful. mark subinterval          
-c                                    for further subdivision. set up            
-c                                    next subinterval.                          
-  170 reglar = .true.                                                           
-  175 if (istage .eq. mxstge) go to 205                                         
-      if (right) go to 185                                                      
-      reglsv(istage+1) = reglar                                                 
-      begin(istage) = beg                                                       
-      ibegs(istage) = ibeg                                                      
-      stage = stage*half                                                        
-  180 right = .true.                                                            
-      beg = (beg+edn)*half                                                      
-      ibeg = (ibeg+iend)/2                                                      
-      ts(ibeg) = ts(ibeg)*half                                                  
-      fbeg = ts(ibeg)                                                           
-      go to 10                                                                  
-  185 nnleft = ibeg - ibegs(istage)                                             
-      if (iend+nnleft .ge. maxts) go to 200                                     
-      iii = ibegs(istage)                                                       
-      ii = iend                                                                 
-      do 190 i=iii,ibeg                                                         
-         ii = ii + 1                                                            
-         ts(ii) = ts(i)                                                         
-  190 continue                                                                  
-      do 195 i=ibeg,ii                                                          
-         ts(iii) = ts(i)                                                        
-         iii = iii + 1                                                          
-  195 continue                                                                  
-      iend = iend + 1                                                           
-      ibeg = iend - nnleft                                                      
-      fend = fbeg                                                               
-      fbeg = ts(ibeg)                                                           
-      finis(istage) = edn                                                       
-      edn = beg                                                                 
-      beg = begin(istage)                                                       
-      begin(istage) = edn                                                       
-      reglsv(istage) = reglar                                                   
-      istage = istage + 1                                                       
-      reglar = reglsv(istage)                                                   
-      est(istage) = vint                                                        
-      curest = curest + est(istage)                                             
-      go to 5                                                                   
-c                                  failure to handle given integra-             
-c                                    tion problem                               
-  200 ier = 131                                                                 
-      go to 215                                                                 
-  205 ier = 132                                                                 
-      go to 215                                                                 
-  210 ier = 133                                                                 
-  215 cadre = curest + vint                                                     
-  220 dcadre = cadre                                                            
- 9000 continue                                                                  
-!      if (ier .ne. 0) call uertst (ier,6hdcadre)                                
- 9005 return                                                                    
-      end     
-
-
-******************************************************************************
-
-	subroutine uertst (ier,name)                                              
-c                                  specifications for arguments                 
-      integer            ier                                                    
-      integer            name(2)                                                
-c                                  specifications for local variables           
-      integer            i,ieq,ieqdf,iounit,level,levold,nameq(6),              
-     *                   namset(6),namupk(6),nin,nmtb                           
-      data               namset/1hu,1he,1hr,1hs,1he,1ht/                        
-      data               nameq/6*1h /                                           
-      data               level/4/,ieqdf/0/,ieq/1h=/                             
-c                                  unpack name into namupk                      
-c                                  first executable statement                   
-      call uspkd (name,6,namupk,nmtb)                                           
-c                                  get output unit number                       
-      call ugetio(1,nin,iounit)                                                 
-c                                  check ier                                    
-      if (ier.gt.999) go to 25                                                  
-      if (ier.lt.-32) go to 55                                                  
-      if (ier.le.128) go to 5                                                   
-      if (level.lt.1) go to 30                                                  
-c                                  print terminal message                       
-      if (ieqdf.eq.1) write(iounit,35) ier,nameq,ieq,namupk                     
-      if (ieqdf.eq.0) write(iounit,35) ier,namupk                               
-      go to 30                                                                  
-    5 if (ier.le.64) go to 10                                                   
-      if (level.lt.2) go to 30                                                  
-c                                  print warning with fix message               
-c      if (ieqdf.eq.1) write(iounit,40) ier,nameq,ieq,namupk                     
-c      if (ieqdf.eq.0) write(iounit,40) ier,namupk                               
-      if (ieqdf.eq.1) continue 
-      if (ieqdf.eq.0) continue 
-      go to 30                                                                  
-   10 if (ier.le.32) go to 15                                                   
-c                                  print warning message                        
-      if (level.lt.3) go to 30                                                  
-      if (ieqdf.eq.1) write(iounit,45) ier,nameq,ieq,namupk                     
-      if (ieqdf.eq.0) write(iounit,45) ier,namupk                               
-      go to 30                                                                  
-   15 continue                                                                  
-c                                  check for uerset call                        
-      do 20 i=1,6                                                               
-         if (namupk(i).ne.namset(i)) go to 25                                   
-   20 continue                                                                  
-      levold = level                                                            
-      level = ier                                                               
-      ier = levold                                                              
-      if (level.lt.0) level = 4                                                 
-      if (level.gt.4) level = 4                                                 
-      go to 30                                                                  
-   25 continue                                                                  
-      if (level.lt.4) go to 30                                                  
-c                                  print non-defined message                    
-      if (ieqdf.eq.1) write(iounit,50) ier,nameq,ieq,namupk                     
-      if (ieqdf.eq.0) write(iounit,50) ier,namupk                               
-   30 ieqdf = 0                                                                 
-      return                                                                    
-   35 format(19h *** terminal error,10x,7h(ier = ,i3,                           
-     1       20h) from imsl routine ,6a1,a1,6a1)                                
-   40 format(27h *** warning with fix error,2x,7h(ier = ,i3,                    
-     1       20h) from imsl routine ,6a1,a1,6a1)                                
-   45 format(18h *** warning error,11x,7h(ier = ,i3,                            
-     1       20h) from imsl routine ,6a1,a1,6a1)                                
-   50 format(20h *** undefined error,9x,7h(ier = ,i5,                           
-     1       20h) from imsl routine ,6a1,a1,6a1)                                
-c                                                                               
-c                                  save p for p = r case                        
-c                                    p is the page namupk                       
-c                                    r is the routine namupk                    
-   55 ieqdf = 1                                                                 
-      do 60 i=1,6                                                               
-   60 nameq(i) = namupk(i)                                                      
-   65 return                                                                    
-      end                          
-
-
-************************************************************************
-
-      subroutine uspkd  (packed,nchars,unpakd,nchmtb)                           
-c                                  specifications for arguments                 
-      integer            nc,nchars,nchmtb                                       
-c                                                                               
-c      integer            unpakd(1),iblank                                       
-      integer            unpakd(nchars),iblank                                       
-      character          packed(1)           ! Modificado el 29-Ago-2001 porque
-!      integer            packed(1)            esto deberia ser CHARACTER, no??
-      data               iblank /1h /                                           
-c                                  initialize nchmtb                            
-      nchmtb = 0                                                                
-c                                  return if nchars is le zero                  
-      if(nchars.le.0) return                                                    
-c                                  set nc=number of chars to be decoded         
-      nc = min0 (129,nchars)                                                   
-!      decode (nc,150,packed) (unpakd(i),i=1,nc)                                
-      read (packed,150) (unpakd(i),i=1,nc)                                
-  150 format (129a1)                                                           
-c                                  check unpakd array and set nchmtb            
-c                                  based on trailing blanks found               
-      do 200 n = 1,nc                                                           
-         nn = nc - n + 1                                                        
-         if(unpakd(nn) .ne. 536870912) go to 210                                
-  200 continue                                                                  
-  210 nchmtb = nn                                                               
-      return                                                                    
-      end            
-
-
-****************************************************************************
-
-      subroutine ugetio(iopt,nin,nout)                                          
-c                                  specifications for arguments                 
-      integer            iopt,nin,nout                                          
-c                                  specifications for local variables           
-      integer            nind,noutd                                             
-      data               nind/5/,noutd/6/                                       
-c                                  first executable statement                   
-      if (iopt.eq.3) go to 10                                                   
-      if (iopt.eq.2) go to 5                                                    
-      if (iopt.ne.1) go to 9005                                                 
-      nin = nind                                                                
-      nout = noutd                                                              
-      go to 9005                                                                
-    5 nind = nin                                                                
-      go to 9005                                                                
-   10 noutd = nout                                                              
- 9005 return                                                                    
-      end       
Index: trunk/LMDZ.MARS/libf/aeronomars/chemthermos.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/chemthermos.F	(revision 633)
+++ 	(revision )
@@ -1,200 +1,0 @@
-      SUBROUTINE chemthermos(ig,lswitch,zycol,ztemp,zdens,zpress,
-     $                       zlocal,zenit,ptimestep,zday)
-
-       IMPLICIT NONE
-c=======================================================================
-c   subject:
-c   --------
-c   Computing chemical variations in the thermosphere
-c
-c   author:  MAC July 2003
-c   ------
-c   modifications:
-c   -------------
-c     Ehouarn Sept 2008: added handling of tracers by their names
-c=======================================================================
-c
-c    0.  Declarations :
-c    ------------------
-c
-#include "dimensions.h"
-#include "dimphys.h"
-#include "comcstfi.h"
-#include "callkeys.h"
-#include "comdiurn.h"
-#include "param.h"
-#include "param_v3.h"
-#include "chimiedata.h"
-#include "conc.h"
-#include"tracer.h"
-c-----------------------------------------------------------------------
-c    Input/Output
-c    ------------
-      INTEGER lswitch,ig
-
-      REAL zday,zycol(nlayermx,nqmx)
-      REAL ptimestep
-      real zenit
-      real ztemp(nlayermx)
-      real zdens(nlayermx)
-      real zpress(nlayermx)			! in mbar
-c
-c    Local variables :
-c    -----------------
-      INTEGER nlayer,l,nesptherm,iq
-      parameter (nesptherm = 11)
-      real tmean
-      real aux1(nlayermx),aux2(nlayermx)
-      real zlocal(nlayermx)
-      real rm(nlayermx,nesptherm) 		!number density (cm-3)
-
-      logical,save :: firstcall=.true.
-
-! Tracer indexes in the GCM:
-      integer,save :: g_co2=0
-      integer,save :: g_co=0
-      integer,save :: g_o=0
-      integer,save :: g_o1d=0
-      integer,save :: g_o2=0
-!      integer,save :: g_o3=0
-      integer,save :: g_h=0
-      integer,save :: g_h2=0
-      integer,save :: g_oh=0
-      integer,save :: g_ho2=0
-      integer,save :: g_h2o2=0
-!      integer,save :: g_n2=0
-      integer,save :: g_h2o_vap=0
-! Tracer indexes in the thermospheric chemistry:
-      integer,parameter :: i_co2=1
-      integer,parameter :: i_o2=2
-      integer,parameter :: i_o=3
-      integer,parameter :: i_co=4
-      integer,parameter :: i_h=5
-      integer,parameter :: i_oh=6
-      integer,parameter :: i_ho2=7
-      integer,parameter :: i_h2=8
-      integer,parameter :: i_h2o=9
-      integer,parameter :: i_h2o2=10
-      integer,parameter :: i_o1d=11
-
-
-! Initializations at first call
-      if (firstcall) then
-c        call param_read
-        ! get the indexes of the tracers we'll need
-        g_co2=igcm_co2
-        if (g_co2.eq.0) then
-          write(*,*) "chemthermos: Error; no CO2 tracer !!!"
-          stop
-        endif
-        g_co=igcm_co
-        if (g_co.eq.0) then
-          write(*,*) "chemthermos: Error; no CO tracer !!!"
-          stop
-        endif
-        g_o=igcm_o
-        if (g_o.eq.0) then
-          write(*,*) "chemthermos: Error; no O tracer !!!"
-          stop
-        endif
-        g_o1d=igcm_o1d
-        if (g_o1d.eq.0) then
-          write(*,*) "chemthermos: Error; no O1D tracer !!!"
-          stop
-        endif
-        g_o2=igcm_o2
-        if (g_o2.eq.0) then
-          write(*,*) "chemthermos: Error; no O2 tracer !!!"
-          stop
-        endif
-        g_h=igcm_h
-        if (g_h.eq.0) then
-          write(*,*) "chemthermos: Error; no H tracer !!!"
-          stop
-        endif
-        g_h2=igcm_h2
-        if (g_h2.eq.0) then
-          write(*,*) "chemthermos: Error; no H2 tracer !!!"
-          stop
-        endif
-        g_oh=igcm_oh
-        if (g_oh.eq.0) then
-          write(*,*) "chemthermos: Error; no OH tracer !!!"
-          stop
-        endif
-        g_ho2=igcm_ho2
-        if (g_ho2.eq.0) then
-          write(*,*) "chemthermos: Error; no HO2 tracer !!!"
-          stop
-        endif
-        g_h2o2=igcm_h2o2
-        if (g_h2o2.eq.0) then
-          write(*,*) "chemthermos: Error; no H2O2 tracer !!!"
-          stop
-        endif
-        g_h2o_vap=igcm_h2o_vap
-        if (g_h2o_vap.eq.0) then
-          write(*,*) "chemthermos: Error; no water vapor tracer !!!"
-          stop
-        endif
-
-        firstcall= .false.
-      endif ! of if (firstcall)
-
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-
-      nlayer=nlayermx
-c      zlocal(1)=0.00625
-c      do l=2,nlayer
-c        tmean=ztemp(l)
-c        if(ztemp(l).ne.ztemp(l-1))
-c     &    tmean=(ztemp(l)-ztemp(l-1))/log(ztemp(l)/ztemp(l-1))
-c        zlocal(l)= zlocal(l-1)-log(zpress(l)/zpress(l-1))
-c     &                         *Rnew(ig,l-1)*tmean/g/1000.
-c      enddo
-
-      do l=1,nlayer
-        aux1(l)=0.
-        aux2(l)=0.
-        rm(l,i_co2)  = zycol(l,g_co2)    *zdens(l)  
-        rm(l,i_co)   = zycol(l,g_co)     *zdens(l) 
-        rm(l,i_o)    = zycol(l,g_o)      *zdens(l)
-        rm(l,i_o1d)  = zycol(l,g_o1d)    *zdens(l) 
-        rm(l,i_o2)   = zycol(l,g_o2)     *zdens(l)
-        rm(l,i_h)    = zycol(l,g_h)      *zdens(l) 
-        rm(l,i_h2)   = zycol(l,g_h2)     *zdens(l) 
-        rm(l,i_oh)   = zycol(l,g_oh)     *zdens(l) 
-        rm(l,i_ho2)  = zycol(l,g_ho2)    *zdens(l)
-        rm(l,i_h2o2) = zycol(l,g_h2o2)   *zdens(l) 
-        rm(l,i_h2o)  = zycol(l,g_h2o_vap)*zdens(l) 
-      enddo
-         
-      call flujo(solarcondate+zday/365.)
-
-      call jthermcalc
-     $ (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),rm(1,i_h2),rm(1,i_h2o),
-     &  rm(1,i_h2o2),aux1,aux2,ztemp,nlayermx,zlocal,
-     &  solarcondate+zday/365.,zenit)
-
-      call paramfoto(lswitch,zdens,ztemp,ptimestep/3600.,zenit,
-     &             nlayer,rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
-     &             rm(1,i_co),rm(1,i_h),rm(1,i_oh),rm(1,i_ho2),
-     &             rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),rm(1,i_o1d))
-
-      do l=lswitch,nlayer
-        zycol(l,g_co2)     = max(rm(l,i_co2)  / zdens(l) , 1.e-30)
-        zycol(l,g_co)      = max(rm(l,i_co)   / zdens(l) , 1.e-30)
-        zycol(l,g_o2)      = max(rm(l,i_o2)   / zdens(l) , 1.e-30)
-        zycol(l,g_h2)      = max(rm(l,i_h2)   / zdens(l) , 1.e-30)
-        zycol(l,g_h)       = max(rm(l,i_h)    / zdens(l) , 1.e-30)
-        zycol(l,g_oh)      = max(rm(l,i_oh)   / zdens(l) , 1.e-30)
-        zycol(l,g_ho2)     = max(rm(l,i_ho2)  / zdens(l) , 1.e-30)
-        zycol(l,g_h2o_vap) = max(rm(l,i_h2o)  / zdens(l) , 1.e-30)
-        zycol(l,g_h2o2)    = max(rm(l,i_h2o2) / zdens(l) , 1.e-30)
-        zycol(l,g_o1d)     = max(rm(l,i_o1d)  / zdens(l) , 1.e-30)
-        zycol(l,g_o)       = max(rm(l,i_o)    / zdens(l) , 1.e-30)
-       enddo	!nlayer
-
-
-      return
-      end 
Index: trunk/LMDZ.MARS/libf/aeronomars/chemthermos.F90
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/chemthermos.F90	(revision 635)
+++ trunk/LMDZ.MARS/libf/aeronomars/chemthermos.F90	(revision 635)
@@ -0,0 +1,518 @@
+      SUBROUTINE chemthermos(ig,lswitch,chemthermod,zycol,ztemp,zdens,  &
+           zpress,zlocal,zenit,ptimestep,zday)
+
+      IMPLICIT NONE
+!=======================================================================
+!   subject: 
+!   --------
+!   Computing chemical variations in the thermosphere
+!
+!   author:  MAC July 2003
+!   ------
+!   modifications:
+!   -------------
+!     Ehouarn Sept 2008: added handling of tracers by their names
+!     Francisco Sept 2009: added ionosphere and N chemistry
+!     Francisco Mar 2012: Different chemical schemes possible according to 
+!                         traceur.def
+!=======================================================================
+!
+!    0.  Declarations :
+!    ------------------
+!
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v4.h"
+#include"tracer.h"
+!-----------------------------------------------------------------------
+!    Input/Output
+!    ------------
+      integer :: lswitch,ig,chemthermod
+      real :: zycol(nlayermx,nqmx)
+      real :: ztemp(nlayermx)
+      real :: zdens(nlayermx)
+      real :: zpress(nlayermx)			! in mbar
+      real :: zlocal(nlayermx)
+      real :: zenit
+      real :: ptimestep
+      real :: zday 
+!
+!    Local variables :
+!    -----------------
+      integer :: l,iq
+      integer,save :: nesptherm
+      real,allocatable :: rm(:,:) 		!number density (cm-3)
+      logical,save :: firstcall=.true.
+
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_co=0
+      integer,save :: g_o=0
+      integer,save :: g_o1d=0
+      integer,save :: g_o2=0
+      integer,save :: g_o3=0
+      integer,save :: g_h=0
+      integer,save :: g_h2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_n2=0
+      integer,save :: g_h2o_vap=0
+      integer,save :: g_n=0
+      integer,save :: g_no=0
+      integer,save :: g_no2=0
+      integer,save :: g_n2d=0
+      integer,save :: g_co2plus=0
+      integer,save :: g_oplus=0
+      integer,save :: g_o2plus=0
+      integer,save :: g_coplus=0
+      integer,save :: g_cplus=0
+      integer,save :: g_nplus=0
+      integer,save :: g_noplus=0
+      integer,save :: g_n2plus=0
+      integer,save :: g_hplus=0
+      integer,save :: g_hco2plus=0
+      integer,save :: g_elec=0
+      
+! Tracer indexes in the thermospheric chemistry:
+!!! IMPORTANT. These values have to be the same than in
+!!! jthermcal.F, column.F, paramfoto_compact.F, euvheat.F
+!!! and hrtherm.F
+!!! If some value is changed here, the same change has to 
+!!! be made into the other subroutines
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_oh=6
+      integer,parameter :: i_ho2=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o1d=11
+      integer,parameter :: i_o3=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_n=14
+      integer,parameter :: i_no=15
+      integer,parameter :: i_n2d=16
+      integer,parameter :: i_no2=17
+      integer,parameter :: i_co2plus=18
+      integer,parameter :: i_oplus=19
+      integer,parameter :: i_o2plus=20
+      integer,parameter :: i_coplus=21
+      integer,parameter :: i_cplus=22
+      integer,parameter :: i_nplus=23
+      integer,parameter :: i_noplus=24
+      integer,parameter :: i_n2plus=25
+      integer,parameter :: i_hplus=26
+      integer,parameter :: i_hco2plus=27
+      integer,parameter :: i_elec=28
+
+      
+! Initializations at first call
+      if (firstcall) then
+         !Number of species to consider
+         nesptherm=0
+         ! get the indexes of the tracers we'll need
+         ! It is not really necessary to check if the species are present,
+         ! as it is already done in calchim.F90. But we include it to double-check
+
+         ! Species always included if photochemistry
+         g_co2=igcm_co2
+         if (g_co2.eq.0) then
+            write(*,*) "chemthermos: Error; no CO2 tracer !!!"
+            write(*,*) "CO2 must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_co=igcm_co
+         if (g_co.eq.0) then
+            write(*,*) "chemthermos: Error; no CO tracer !!!"
+            write(*,*) "CO must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_o=igcm_o
+         if (g_o.eq.0) then
+            write(*,*) "chemthermos: Error; no O tracer !!!"
+            write(*,*) "O must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_o1d=igcm_o1d
+         if (g_o1d.eq.0) then
+            write(*,*) "chemthermos: Error; no O1D tracer !!!"
+            write(*,*) "O1D must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_o2=igcm_o2
+         if (g_o2.eq.0) then
+            write(*,*) "chemthermos: Error; no O2 tracer !!!"
+            write(*,*) "O2 must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_h=igcm_h
+         if (g_h.eq.0) then
+            write(*,*) "chemthermos: Error; no H tracer !!!"
+            write(*,*) "H must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_h2=igcm_h2
+         if (g_h2.eq.0) then
+            write(*,*) "chemthermos: Error; no H2 tracer !!!"
+            write(*,*) "H2 must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_oh=igcm_oh
+         if (g_oh.eq.0) then
+            write(*,*) "chemthermos: Error; no OH tracer !!!"
+            write(*,*) "OH must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_ho2=igcm_ho2
+         if (g_ho2.eq.0) then
+            write(*,*) "chemthermos: Error; no HO2 tracer !!!"
+            write(*,*) "HO2 must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_h2o2=igcm_h2o2
+         if (g_h2o2.eq.0) then
+            write(*,*) "chemthermos: Error; no H2O2 tracer !!!"
+            write(*,*) "H2O2 must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         g_h2o_vap=igcm_h2o_vap
+         if (g_h2o_vap.eq.0) then
+            write(*,*) "chemthermos: Error; no water vapor tracer !!!"
+            write(*,*) "H2O must always be present if thermochem=T"
+            stop
+         else
+            nesptherm=nesptherm+1  
+         endif
+         !Verify if O3 chemistry wanted
+         g_o3=igcm_o3
+         if(chemthermod.ge.1) then
+            if (g_o3.eq.0) then
+               write(*,*) "chemthermos: Error; no O3 tracer !!!"
+               write(*,*) "O3 must be present if NO is in traceur.def"
+               stop
+            else
+               nesptherm=nesptherm+1
+            endif
+         else
+            if(g_o3 == 0) then
+               write(*,*) "chemthermos: No O3 chemistry"
+            else               
+               write(*,*) "chemthermos: O3 chemistry included"
+               nesptherm=nesptherm+1  
+               chemthermod=1
+            endif
+         endif    ! Of if(chemthermod.ge.1)
+            
+         ! N chemistry
+         if(chemthermod.ge.2) then
+            g_n2=igcm_n2
+            if (g_n2.eq.0) then
+               write(*,*) "chemthermos: Error; no N2 tracer !!!"
+               write(*,*) "N2 must be present if NO is in traceur.def"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_n=igcm_n
+            if (g_n.eq.0) then
+               write(*,*) "chemthermos: Error; no N tracer !!!"
+               write(*,*) "N must be present if NO is in traceur.def"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_no=igcm_no
+            if (g_no.eq.0) then
+               write(*,*) "chemthermos: Error; no NO tracer !!!"
+               write(*,*) "NO must be present if N chemistry wanted"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_no2=igcm_no2
+            if (g_no2.eq.0) then
+               write(*,*) "chemthermos: Error; no NO2 tracer !!!"
+               write(*,*) "NO must be present if NO is in traceur.def"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_n2d=igcm_n2d
+            if (g_n2d.eq.0) then
+               write(*,*) "chemthermos: Error; no N2D tracer !!!"
+               write(*,*) "NO must be present if NO is in traceur.def"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+         endif   ! Of if(chemthermod.ge.2)
+         
+         !Ion chemistry
+         if(chemthermod.eq.3) then
+            g_co2plus=igcm_co2plus
+            if (g_co2plus.eq.0 .and. chemthermod.ge.3) then
+               write(*,*) "chemthermos: Error; no CO2+ tracer !!!"
+               write(*,*) "CO2+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_oplus=igcm_oplus
+            if (g_oplus.eq.0 .and. chemthermod.ge.3) then
+               write(*,*) "chemthermos: Error; no O+ tracer !!!"
+               write(*,*) "O+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_o2plus=igcm_o2plus
+            if (g_o2plus.eq.0 .and. chemthermod.ge.3) then
+               write(*,*) "chemthermos: Error; no O2+ tracer !!!"
+               write(*,*) "O2+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_coplus=igcm_coplus
+            if (g_coplus.eq.0) then
+               write(*,*) "chemthermos: Error; no CO+ tracer !!!"
+               write(*,*) "CO+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_cplus=igcm_cplus
+            if (g_cplus.eq.0) then
+               write(*,*) "chemthermos: Error; no C+ tracer !!!"
+               write(*,*) "C+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_nplus=igcm_nplus
+            if (g_nplus.eq.0) then
+               write(*,*) "chemthermos: Error; no N+ tracer !!!"
+               write(*,*) "N+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_noplus=igcm_noplus
+            if (g_noplus.eq.0) then
+               write(*,*) "chemthermos: Error; no NO+ tracer !!!"
+               write(*,*) "NO+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_n2plus=igcm_n2plus
+            if (g_n2plus.eq.0) then
+               write(*,*) "chemthermos: Error; no N2+ tracer !!!"
+               write(*,*) "N2+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_hplus=igcm_hplus
+            if (g_hplus.eq.0) then
+               write(*,*) "chemthermos: Error; no H+ tracer !!!"
+               write(*,*) "H+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_hco2plus=igcm_hco2plus
+            if (g_hco2plus.eq.0 .and. chemthermod.ge.3) then
+               write(*,*) "chemthermos: Error; no HCO2+ tracer !!!"
+               write(*,*) "HCO2+ must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+            g_elec=igcm_elec
+            if (g_elec.eq.0) then
+               write(*,*) "chemthermos: Error; no e- tracer !!!"
+               write(*,*) "e- must be present if chemthermod=3"
+               stop
+            else
+               nesptherm=nesptherm+1  
+            endif
+         endif
+
+         !Check if number of species is as expected
+         select case(chemthermod)
+         case(0)
+            if(nesptherm.ne.11) then
+               write(*,*)"chemthermos: Error:" 
+               write(*,*)"Number of tracers not correct"
+               write(*,*)"There are",nesptherm," tracers"
+               write(*,*)"There should be 11 tracers"
+               stop
+            else
+               write(*,*)"chemthermos:",nesptherm," species"
+            endif
+         case(1)            
+            if(nesptherm.ne.12) then
+               write(*,*)"chemthermos: Error:" 
+               write(*,*)"Number of tracers not correct"
+               write(*,*)"There are",nesptherm," tracers"
+               write(*,*)"There should be 12 tracers"
+               stop
+            else
+               write(*,*)"chemthermos:",nesptherm," species"
+            endif
+         case(2)
+            if(nesptherm.ne.17) then
+               write(*,*)"chemthermos: Error:" 
+               write(*,*)"Number of tracers not correct"
+               write(*,*)"There are",nesptherm," tracers"
+               write(*,*)"There should be 17 tracers"
+               stop
+            else
+               write(*,*)"chemthermos:",nesptherm," species"
+            endif
+         case(3)
+            if(nesptherm.ne.28) then
+               write(*,*)"chemthermos: Error:" 
+               write(*,*)"Number of tracers not correct"
+               write(*,*)"There are",nesptherm," tracers"
+               write(*,*)"There should be 28 tracers"
+               stop
+            else
+               write(*,*)"chemthermos:",nesptherm," species"
+            endif
+         end select
+         firstcall= .false.
+         write(*,*)'chemthermos: chemthermod=',chemthermod
+      endif                     ! of if (firstcall)
+      
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      !Allocate density vector
+      allocate(rm(nlayermx,nesptherm))
+
+      do l=1,nlayermx
+        rm(l,i_co2)     = max(zycol(l,g_co2)*zdens(l),1.e-30)
+        rm(l,i_co)      = max(zycol(l,g_co)*zdens(l),1.e-30) 
+        rm(l,i_o)       = max(zycol(l,g_o)*zdens(l),1.e-30)
+        rm(l,i_o1d)     = max(zycol(l,g_o1d)*zdens(l),1.e-30) 
+        rm(l,i_o2)      = max(zycol(l,g_o2)*zdens(l),1.e-30)
+        rm(l,i_h)       = max(zycol(l,g_h)*zdens(l),1.e-30) 
+        rm(l,i_h2)      = max(zycol(l,g_h2)*zdens(l),1.e-30)
+        rm(l,i_oh)      = max(zycol(l,g_oh)*zdens(l),1.e-30) 
+        rm(l,i_ho2)     = max(zycol(l,g_ho2)*zdens(l),1.e-30)
+        rm(l,i_h2o2)    = max(zycol(l,g_h2o2)*zdens(l),1.e-30) 
+        rm(l,i_h2o)     = max(zycol(l,g_h2o_vap)*zdens(l),1.e-30)
+        if(chemthermod.ge.1)  &
+             rm(l,i_o3)      = max(zycol(l,g_o3)*zdens(l),1.e-30)
+        if(chemthermod.ge.2) then
+           rm(l,i_n2)      = max(zycol(l,g_n2)*zdens(l),1.e-30)
+           rm(l,i_n)       = max(zycol(l,g_n)*zdens(l),1.e-30)
+           rm(l,i_no)      = max(zycol(l,g_no)*zdens(l),1.e-30)
+           rm(l,i_co)      = max(zycol(l,g_co)*zdens(l),1.e-30)
+           rm(l,i_n2d)     = max(zycol(l,g_n2d)*zdens(l),1.e-30)
+           rm(l,i_no2)     = max(zycol(l,g_no2)*zdens(l),1.e-30)
+        endif
+        if(chemthermod.eq.3) then
+           rm(l,i_co2plus) = max(zycol(l,g_co2plus)*zdens(l),1.e-30)
+           rm(l,i_oplus)   = max(zycol(l,g_oplus)*zdens(l),1.e-30)
+           rm(l,i_o2plus)  = max(zycol(l,g_o2plus)*zdens(l),1.e-30)
+           rm(l,i_coplus)  = max(zycol(l,g_coplus)*zdens(l),1.e-30)
+           rm(l,i_cplus)   = max(zycol(l,g_cplus)*zdens(l),1.e-30)
+           rm(l,i_nplus)   = max(zycol(l,g_nplus)*zdens(l),1.e-30)
+           rm(l,i_noplus)  = max(zycol(l,g_noplus)*zdens(l),1.e-30)
+           rm(l,i_n2plus)  = max(zycol(l,g_n2plus)*zdens(l),1.e-30)
+           rm(l,i_hplus)   = max(zycol(l,g_hplus)*zdens(l),1.e-30)
+           rm(l,i_hco2plus)= max(zycol(l,g_hco2plus)*zdens(l),1.e-30)
+           rm(l,i_elec)    = max(zycol(l,g_elec)*zdens(l),1.e-30)
+        endif
+        if(chemthermod.gt.3.or.chemthermod.lt.0) then
+           write(*,*)'chemthermos: bad value for chemthermod. Stop'
+           stop
+        endif
+      enddo
+
+      !Solar flux calculation
+      call flujo(solarcondate)!+zday/365.)
+
+      !Photoabsorption coefficients
+      call jthermcalc(ig,chemthermod,rm,nesptherm,ztemp,zlocal,zenit)
+
+      !Chemistry
+      call paramfoto_compact  &
+           (ig,chemthermod,lswitch,ztemp,ptimestep,zenit,zlocal,rm,nesptherm)
+
+      !Concentrations back to GCM
+      do l=lswitch,nlayermx
+        zycol(l,g_co2)     = max(rm(l,i_co2)     / zdens(l) , 1.e-30)
+        zycol(l,g_co)      = max(rm(l,i_co)      / zdens(l) , 1.e-30)
+        zycol(l,g_o2)      = max(rm(l,i_o2)      / zdens(l) , 1.e-30)
+        zycol(l,g_h2)      = max(rm(l,i_h2)      / zdens(l) , 1.e-30)
+        zycol(l,g_h)       = max(rm(l,i_h)       / zdens(l) , 1.e-30)
+        zycol(l,g_oh)      = max(rm(l,i_oh)      / zdens(l) , 1.e-30)
+        zycol(l,g_ho2)     = max(rm(l,i_ho2)     / zdens(l) , 1.e-30)
+        zycol(l,g_h2o_vap) = max(rm(l,i_h2o)     / zdens(l) , 1.e-30)
+        zycol(l,g_h2o2)    = max(rm(l,i_h2o2)    / zdens(l) , 1.e-30)
+        zycol(l,g_o1d)     = max(rm(l,i_o1d)     / zdens(l) , 1.e-30)
+        zycol(l,g_o)       = max(rm(l,i_o)       / zdens(l) , 1.e-30)
+        if(chemthermod.ge.1) &
+             zycol(l,g_o3) = max(rm(l,i_o3)      / zdens(l) , 1.e-30)
+        if(chemthermod.ge.2) then
+           zycol(l,g_n2)      = max(rm(l,i_n2)      / zdens(l) , 1.e-30)
+           zycol(l,g_n)       = max(rm(l,i_n)       / zdens(l) , 1.e-30)
+           zycol(l,g_no)      = max(rm(l,i_no)      / zdens(l) , 1.e-30)
+           zycol(l,g_no2)     = max(rm(l,i_no2)     / zdens(l) , 1.e-30)
+           zycol(l,g_n2d)     = max(rm(l,i_n2d)     / zdens(l) , 1.e-30)
+        endif
+        if(chemthermod.ge.3) then
+           zycol(l,g_co2plus) = max(rm(l,i_co2plus) / zdens(l) , 1.e-30)
+           zycol(l,g_oplus)   = max(rm(l,i_oplus)   / zdens(l) , 1.e-30)
+           zycol(l,g_o2plus)  = max(rm(l,i_o2plus)  / zdens(l) , 1.e-30)
+           zycol(l,g_coplus)  = max(rm(l,i_coplus)  / zdens(l) , 1.e-30)
+           zycol(l,g_cplus)   = max(rm(l,i_cplus)   / zdens(l) , 1.e-30)
+           zycol(l,g_nplus)   = max(rm(l,i_nplus)   / zdens(l) , 1.e-30)
+           zycol(l,g_noplus)  = max(rm(l,i_noplus)  / zdens(l) , 1.e-30)
+           zycol(l,g_n2plus)  = max(rm(l,i_n2plus)  / zdens(l) , 1.e-30)
+           zycol(l,g_hplus)   = max(rm(l,i_hplus)   / zdens(l) , 1.e-30)
+           zycol(l,g_hco2plus)= max(rm(l,i_hco2plus)/ zdens(l) , 1.e-30)
+           zycol(l,g_elec)    = max(rm(l,i_elec)    / zdens(l) , 1.e-30)
+        endif
+      enddo                     !nlayer
+
+      !Deallocations
+      deallocate(rm)
+
+      return
+      end 
+
+
+
+
Index: trunk/LMDZ.MARS/libf/aeronomars/column.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/column.F	(revision 633)
+++ 	(revision )
@@ -1,153 +1,0 @@
-c**********************************************************************
-
-      subroutine column
-     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx,o2colx,
-     $ o3pcolx,h2o2colx)
-
-
-c     nov 2002        fgg           first version
-
-c**********************************************************************
-
-      implicit none
-
-
-c     common variables and constants
-
-      include 'param.h'
-      include 'param_v3.h'
-
-
-
-c    local parameters and variables
-
-
-
-c     input and output variables
-
-      integer    nz
-      real       co2colx(nz)                 !column density of CO2 (cm^-2)
-      real       o2colx(nz)                  !column density of O2(cm^-2)
-      real       o3pcolx(nz)                 !column density of O(3P)(cm^-2)
-      real       h2o2colx(nz)                !column density of H2O2(cm^-2)
-      real       co2x(nz)                    !density of CO2(cm^-3)
-      real       o2x(nz)                     !density of O2(cm^-3)
-      real       o3px(nz)                    !density of O(3P)(cm^-3)
-      real       h2x(nz)                     !density of H2(cm^-3)
-      real       h2ox(nz)                    !density of H2O(cm^-3)
-      real       h2o2x(nz)                   !density of H2O2(cm^-3)
-      real       jtot(nz)                    !output: heating rate(erg/s)
-      real       tx(nz)                      !temperature profile
-      real       iz(nz+1)                    !height profile
-      real       zenit
-
-c     local variables
-
-      real       xx
-      real       grav(nzmax)
-      real       ntx(nzmax)
-      real       pmmixx(nzmax)
-      real       Hmix(nzmax)
-      real       nint(nzmax)
-      real       co2vmrx(nzmax)
-      real       o2vmrx(nzmax)
-      real       o3pvmrx(nzmax)
-      real       h2vmrx(nzmax)
-      real       h2ovmrx(nzmax)
-      real       h2o2vmrx(nzmax)
-      real       Hco2
-      real       Ho3p
-      real       Ho2
-      real       Hh2o2
-      real       chapm(nzmax)
-
-
-
-c     local variables
-
-      integer    i,j,k,icol,indexint          !indexes
-      real*8     znt
-
-c External functions
-
-       external    ch
-       real        ch
-
-
-c*************************PROGRAM STARTS*******************************
-
-      do i=1,nz
-         xx = ( radio + iz(i) ) * 1.e5
-         ntx(i)=co2x(i)+o2x(i)+o3px(i)+h2x(i)+h2ox(i)+h2o2x(i)
-         co2vmrx(i)=co2x(i)/ntx(i)
-         o2vmrx(i)=o2x(i)/ntx(i)
-         o3pvmrx(i)=o3px(i)/ntx(i)
-         h2vmrx(i)=h2x(i)/ntx(i)
-         h2ovmrx(i)=h2ox(i)/ntx(i)
-         h2o2vmrx(i)=h2o2x(i)/ntx(i)
-         pmmixx(i) = (pmco2*co2x(i)+pmo2*o2x(i) 
-     $                + pmo3p*o3px(i))/ntx(i)
-         grav(i) = gg * masa /(xx**2)
-         Hmix(i) = kboltzman*tx(i)*n_avog / (pmmixx(i)*grav(i))
-         nint(i) = -Hmix(i)*ntx(i)*
-     $   (exp((iz(i)-iz(i+1))*1e5/Hmix(i))-1)
-      end do
-
-      xx = kboltzman * tx(nz) * n_avog / grav(nz)
-      Ho3p = xx / pmo3p 
-      Hco2 = xx / pmco2
-      Ho2  = xx / pmo2
-      Hh2o2 = xx / pmh2o2
-      o3pcolx(nz) = o3px(nz) * Ho3p
-      co2colx(nz) = co2x(nz) * Hco2
-      h2o2colx(nz) = h2o2x(nz) * Hh2o2
-      o2colx(nz) = o2x(nz) * Ho2
-      do i=1,nz-1
-         co2colx(i) = co2colx(nz)
-         o2colx(i) = o2colx(nz)
-         o3pcolx(i) = o3pcolx(nz)
-         h2o2colx(i) = h2o2colx(nz)
-         do j=i,nz-1
-            co2colx(i) = co2colx(i) + nint(j) 
-     $                   * ((co2vmrx(j+1) + co2vmrx(j)) / 2.)
-            o2colx(i) = o2colx(i) + nint(j)
-     $                  * ((o2vmrx(j+1) + o2vmrx(j)) / 2.)
-            o3pcolx(i) = o3pcolx(i) + nint(j)
-     $                   * ((o3pvmrx(j+1) + o3pvmrx(j)) /2.)
-            h2o2colx(i) = h2o2colx(i) +nint(j)
-     $                     * ((h2o2vmrx(j+1) + h2o2vmrx(j)) / 2.)
-         end do
-      end do
-
-      znt=zenit*3.1416/180.
-      if(zenit.gt.80.0) then
-         do i=1,nz
-            chapm(i) =  
-     $           ch( (iz(i)+radio)/(Hmix(i)*1.e-5),znt)
-         enddo
-      end if
-      znt=zenit*3.1416/180.
-      do i=1,nz
-         if(zenit.le.80.0) then
-            co2colx(i)=co2colx(i)/cos(znt)
-            o2colx(i)=o2colx(i)/cos(znt)
-            o3pcolx(i)=o3pcolx(i)/cos(znt)
-            h2o2colx(i)=h2o2colx(i)/cos(znt)
-         else
-            co2colx(i)=co2colx(i)*chapm(i)
-            o2colx(i)=o2colx(i)*chapm(i)
-            o3pcolx(i)=o3pcolx(i)*chapm(i)
-            h2o2colx(i)=h2o2colx(i)*chapm(i)
-         end if
-      end do
-
-
-      return
-
-
-      end
-
-
-
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/concentrations.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/concentrations.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/concentrations.F	(revision 635)
@@ -132,4 +132,90 @@
             cpi(nbq) = 1.870e3
          end if
+         if (igcm_n /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_n
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_no /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_no
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_no2 /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_no2
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_n2d /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_n2d
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_co2plus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_co2plus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_oplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_oplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_o2plus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_o2plus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_coplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_coplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_cplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_cplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_nplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_nplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_noplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_noplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_n2plus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_n2plus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_hplus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_hplus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         if(igcm_hco2plus /= 0) then
+            nbq = nbq + 1
+            niq(nbq) = igcm_hco2plus
+            aki(nbq) = 0.0
+            cpi(nbq) = 0.0
+         endif
+         
+            
 
          firstcall = .false.
Index: trunk/LMDZ.MARS/libf/aeronomars/euvheat.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/euvheat.F	(revision 633)
+++ 	(revision )
@@ -1,204 +1,0 @@
-      SUBROUTINE euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
-     $     mu0,ptimestep,ptime,zday,pq,pdq,pdteuv)
-
-       IMPLICIT NONE
-c=======================================================================
-c   subject:
-c   --------
-c   Computing heating rate due to EUV absorption
-c
-c   author:  MAC 2002
-c   ------
-c
-c   input:
-c   ----- 
-c   dist_sol		  sun-Mars distance (AU)
-c   mu0(ngridmx)           
-c   pplay(ngrid,nlayer)   pressure at middle of layers (Pa)
-c
-c   output:
-c   -------
-c
-c   pdteuv(ngrid,nlayer)      Heating rate (K/s)
-c
-c=======================================================================
-c
-c    0.  Declarations :
-c    ------------------
-c
-#include "dimensions.h"
-#include "dimphys.h"
-#include "comcstfi.h"
-#include "callkeys.h"
-#include "comdiurn.h"
-#include "param.h"
-#include "param_v3.h"
-#include "chimiedata.h"
-#include "tracer.h"
-#include "conc.h"
-c-----------------------------------------------------------------------
-c    Input/Output
-c    ------------
-
-      REAL pplay(ngridmx,nlayermx)
-      REAL zzlay(ngridmx,nlayermx)
-      real pplev(ngridmx,nlayermx+1)
-      REAL pt(ngridmx,nlayermx)
-      REAL pdt(ngridmx,nlayermx)
-      real zday
-      REAL dist_sol
-      real mu0(ngridmx)
-      real pq(ngridmx,nlayermx,nqmx)
-      real pdq(ngridmx,nlayermx,nqmx)
-      real ptimestep,ptime
-
-
-      REAL pdteuv(ngridmx,nlayermx)
-c
-c    Local variables :
-c    -----------------
-      integer nespeuv
-      parameter (nespeuv=6)
-
-      INTEGER l,iq,ig,n,inif ! , ngrid, nlayer
-      real rm(nlayermx,nespeuv)		! number density (cm-3)
-      real zq(ngridmx,nlayermx,nqmx) ! local updated tracer quantity
-      real zt(ngridmx,nlayermx) ! local updated atmospheric temperature
-      real zlocal(nlayermx)
-      real zenit
-      real aux1(nlayermx)
-      real aux2(nlayermx)
-      real jtot(nlayermx)
-      real dens						! amu/cm-3
-      real tx(nlayermx)
-      real tmean
-      
-! tracer indexes for the EUV heating:
-      integer,parameter :: i_co2=1
-      integer,parameter :: i_o2=2
-      integer,parameter :: i_o=3
-      integer,parameter :: i_h2=4
-      integer,parameter :: i_h2o=5
-      integer,parameter :: i_h2o2=6
-      
-! Tracer indexes in the GCM:
-      integer,save :: g_co2=0
-      integer,save :: g_o=0
-      integer,save :: g_o2=0
-      integer,save :: g_h2=0
-      integer,save :: g_h2o2=0
-      integer,save :: g_h2o=0
-
-
-      logical,save :: firstcall=.true.
-
-! Initializations and sanity checks:
-
-      if (firstcall) then
-        if ((nespeuv.gt.nqmx).or.(nespeuv.gt.ncomp)) then
-          print*,'******* Dimension problem in EUVHEAT ********'
-          STOP
-        endif
-
-        ! identify the indexes of the tracers we'll need
-        g_co2=igcm_co2
-        if (g_co2.eq.0) then
-          write(*,*) "euvheat: Error; no CO2 tracer !!!"
-          stop
-        endif
-        g_o=igcm_o
-        if (g_o.eq.0) then
-          write(*,*) "euvheat: Error; no O tracer !!!"
-          stop
-        endif
-        g_o2=igcm_o2
-        if (g_o2.eq.0) then
-          write(*,*) "euvheat: Error; no O2 tracer !!!"
-          stop
-        endif
-        g_h2=igcm_h2
-        if (g_h2.eq.0) then
-          write(*,*) "euvheat: Error; no H2 tracer !!!"
-          stop
-        endif
-        g_h2o2=igcm_h2o2
-        if (g_h2o2.eq.0) then
-          write(*,*) "euvheat: Error; no H2O2 tracer !!!"
-          stop
-        endif
-        g_h2o=igcm_h2o_vap
-        if (g_h2o.eq.0) then
-          write(*,*) "euvheat: Error; no water vapor tracer !!!"
-          stop
-        endif
-        
-        firstcall= .false.
-!        print*,'EUV',nlayer,nlayermx,ngrid,ngridmx   
-      endif ! of if (firstcall)
-
-c
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      ! build local updated values of tracers and temperature
-      do l=1,nlayermx
-        do ig=1,ngridmx
-          ! chemical species
-          zq(ig,l,g_co2)=pq(ig,l,g_co2)+pdq(ig,l,g_co2)*ptimestep
-          zq(ig,l,g_o2)=pq(ig,l,g_o2)+pdq(ig,l,g_o2)*ptimestep
-          zq(ig,l,g_o)=pq(ig,l,g_o)+pdq(ig,l,g_o)*ptimestep
-          zq(ig,l,g_h2)=pq(ig,l,g_h2)+pdq(ig,l,g_h2)*ptimestep
-          zq(ig,l,g_h2o2)=pq(ig,l,g_h2o2)+pdq(ig,l,g_h2o2)*ptimestep
-          zq(ig,l,g_h2o)=pq(ig,l,g_h2o)+pdq(ig,l,g_h2o)*ptimestep
-          ! atmospheric temperature
-          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
-        enddo
-      enddo
-
-      call flujo(solarcondate)
-c     call flujo(solarcondate+zday/365.) ! version with EUV time evolution
-
-      do ig=1,ngridmx
-
-        zenit=acos(mu0(ig))*180./acos(-1.)
- 
-        do l=1,nlayermx
-          dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21
-          rm(l,i_co2)  = zq(ig,l,g_co2)  * dens / mmol(g_co2)
-          rm(l,i_o2)   = zq(ig,l,g_o2)   * dens / mmol(g_o2)
-          rm(l,i_o)    = zq(ig,l,g_o)    * dens / mmol(g_o)
-          rm(l,i_h2)   = zq(ig,l,g_h2)   * dens / mmol(g_h2)
-          rm(l,i_h2o)  = zq(ig,l,g_h2o)  * dens / mmol(g_h2o)
-          rm(l,i_h2o2) = zq(ig,l,g_h2o2) * dens / mmol(g_h2o2)
-        enddo
-
-c        zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))
-c     &            *Rnew(ig,1)*zt(ig,1)/g
-        zlocal(1)=zzlay(ig,1)
-        zlocal(1)=zlocal(1)/1000.
-        tx(1)=zt(ig,1)
-
-        do l=2,nlayermx
-          tx(l)=zt(ig,l)
-          tmean=tx(l)
-          if(tx(l).ne.tx(l-1))
-     &    tmean=(tx(l)-tx(l-1))/log(tx(l)/tx(l-1))
-c          zlocal(l)= zlocal(l-1)
-c     &   -log(pplay(ig,l)/pplay(ig,l-1))*Rnew(ig,l-1)*tmean/g/1000.
-        zlocal(l)=zzlay(ig,l)/1000.
-        enddo
-
-        call hrtherm (rm(1,i_co2),rm(1,i_o2),rm(1,i_o),
-     &                rm(1,i_h2),rm(1,i_h2o),rm(1,i_h2o2),
-     &                aux1,aux2,tx,nlayermx,zlocal,
-     &                solarcondate+zday/365.,zenit,jtot)
-
-        do l=1,nlayermx
-          pdteuv(ig,l)=euveff*jtot(l)/10.
-     &            /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l)))
-     &                  *(1.52/dist_sol)**2 
-
-        enddo	
-
-      enddo  ! of do ig=1,ngridmx
-
-      return
-      end 
Index: trunk/LMDZ.MARS/libf/aeronomars/euvheat.F90
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/euvheat.F90	(revision 635)
+++ trunk/LMDZ.MARS/libf/aeronomars/euvheat.F90	(revision 635)
@@ -0,0 +1,429 @@
+      SUBROUTINE euvheat(pt,pdt,pplev,pplay,zzlay, &
+           mu0,ptimestep,ptime,zday,pq,pdq,pdteuv)
+
+      IMPLICIT NONE
+!=======================================================================
+!   subject:
+!   --------
+!   Computing heating rate due to EUV absorption
+!
+!   author:  MAC 2002
+!   ------
+!
+!   input:
+!   ----- 
+!   mu0(ngridmx)           
+!   pplay(ngrid,nlayer)   pressure at middle of layers (Pa)
+!
+!   output:
+!   -------
+!
+!   pdteuv(ngrid,nlayer)      Heating rate (K/s)
+!
+!=======================================================================
+!
+!    0.  Declarations :
+!    ------------------
+!
+#include "dimensions.h"
+#include "dimphys.h"
+#include "comcstfi.h"
+#include "callkeys.h"
+#include "comdiurn.h"
+#include "param.h"
+#include "param_v4.h"
+#include "chimiedata.h"
+#include "tracer.h"
+#include "conc.h"
+!-----------------------------------------------------------------------
+!    Input/Output
+!    ------------
+
+      real :: pt(ngridmx,nlayermx)
+      real :: pdt(ngridmx,nlayermx)
+      real :: pplev(ngridmx,nlayermx+1)
+      real :: pplay(ngridmx,nlayermx)
+      real :: zzlay(ngridmx,nlayermx)
+      real :: mu0(ngridmx)
+      real :: ptimestep,ptime
+      real :: zday
+      real :: pq(ngridmx,nlayermx,nqmx)
+      real :: pdq(ngridmx,nlayermx,nqmx)
+
+      real :: pdteuv(ngridmx,nlayermx)
+!
+!    Local variables :
+!    -----------------
+      integer,save :: nespeuv    ! Number of species considered
+
+      INTEGER :: l,ig,n
+      integer,save :: euvmod
+      real, allocatable :: rm(:,:)   ! number density (cm-3)
+      real :: zq(ngridmx,nlayermx,nqmx) ! local updated tracer quantity
+      real :: zt(ngridmx,nlayermx)      ! local updated atmospheric temperature
+      real :: zlocal(nlayermx)
+      real :: zenit
+      real :: jtot(nlayermx)
+      real :: dens						! amu/cm-3
+      real :: tx(nlayermx)
+!      real euveff     !UV heating efficiency
+      
+! tracer indexes for the EUV heating:
+!!! ATTENTION. These values have to be identical to those in chemthermos.F90
+!!! If the values are changed there, the same has to be done here  !!!
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_oh=6
+      integer,parameter :: i_ho2=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o1d=11
+      integer,parameter :: i_o3=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_n=14
+      integer,parameter :: i_no=15
+      integer,parameter :: i_n2d=16
+      integer,parameter :: i_no2=17
+
+      
+! Tracer indexes in the GCM:
+      integer,save :: g_co2=0
+      integer,save :: g_o=0
+      integer,save :: g_o2=0
+      integer,save :: g_h2=0
+      integer,save :: g_h2o2=0
+      integer,save :: g_h2o=0
+      integer,save :: g_o3=0
+      integer,save :: g_n2=0
+      integer,save :: g_n=0
+      integer,save :: g_no=0
+      integer,save :: g_co=0
+      integer,save :: g_h=0
+      integer,save :: g_no2=0
+      integer,save :: g_oh=0
+      integer,save :: g_ho2=0
+      integer,save :: g_o1d=0
+      integer,save :: g_n2d=0
+
+
+      logical,save :: firstcall=.true.
+
+! Initializations and sanity checks:
+
+
+      if (firstcall) then
+         nespeuv=0
+        ! identify the indexes of the tracers we'll need
+         g_co2=igcm_co2
+         if (g_co2.eq.0) then
+            write(*,*) "euvheat: Error; no CO2 tracer !!!"
+            write(*,*) "CO2 is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_o=igcm_o
+         if (g_o.eq.0) then
+            write(*,*) "euvheat: Error; no O tracer !!!"
+            write(*,*) "O is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_o2=igcm_o2
+         if (g_o2.eq.0) then
+            write(*,*) "euvheat: Error; no O2 tracer !!!"
+            write(*,*) "O2 is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_h2=igcm_h2
+         if (g_h2.eq.0) then
+            write(*,*) "euvheat: Error; no H2 tracer !!!"
+            write(*,*) "H2 is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_oh=igcm_oh
+         if (g_oh.eq.0) then
+            write(*,*) "euvheat: Error; no OH tracer !!!"
+            write(*,*) "OH must always be present if thermochem=T"
+            stop
+         else
+            nespeuv=nespeuv+1  
+         endif
+         g_ho2=igcm_ho2
+         if (g_ho2.eq.0) then
+            write(*,*) "euvheat: Error; no HO2 tracer !!!"
+            write(*,*) "HO2 must always be present if thermochem=T"
+            stop
+         else
+            nespeuv=nespeuv+1  
+         endif
+         g_h2o2=igcm_h2o2
+         if (g_h2o2.eq.0) then
+            write(*,*) "euvheat: Error; no H2O2 tracer !!!"
+            write(*,*) "H2O2 is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_h2o=igcm_h2o_vap
+         if (g_h2o.eq.0) then
+            write(*,*) "euvheat: Error; no water vapor tracer !!!"
+            write(*,*) "H2O is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_o1d=igcm_o1d
+         if (g_o1d.eq.0) then
+            write(*,*) "euvheat: Error; no O1D tracer !!!"
+            write(*,*) "O1D must always be present if thermochem=T"
+            stop
+         else
+            nespeuv=nespeuv+1  
+         endif
+         g_co=igcm_co
+         if (g_co.eq.0) then
+            write(*,*) "euvheat: Error; no CO tracer !!!"
+            write(*,*) "CO is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         g_h=igcm_h
+         if (g_h.eq.0) then
+            write(*,*) "euvheat: Error; no H tracer !!!"
+            write(*,*) "H is always needed if calleuv=.true."
+            stop
+         else
+            nespeuv=nespeuv+1
+         endif
+         
+         euvmod = 0             !Default: C/O/H chemistry 
+         !Check if O3 is present
+         g_o3=igcm_o3
+         if (g_o3.eq.0) then
+            write(*,*) "euvheat: Error; no O3 tracer !!!"
+            write(*,*) "O3 must be present if calleuv=.true."
+            stop
+         else 
+            nespeuv=nespeuv+1
+            euvmod=1
+         endif
+
+         !Nitrogen species
+         !NO is used to determine if N chemistry is wanted
+         !euvmod=2 -> N chemistry
+         g_no=igcm_no
+         if (g_no.eq.0) then
+            write(*,*) "euvheat: no NO tracer"
+            write(*,*) "No N species in UV heating"
+         else if(g_no.ne.0) then
+            nespeuv=nespeuv+1
+            euvmod=2
+         endif
+         ! n2
+         g_n2=igcm_n2
+         if(euvmod.eq.2) then
+            if (g_n2.eq.0) then
+               write(*,*) "euvheat: Error; no N2 tracer !!!"
+               write(*,*) "N2 needed if NO is in traceur.def"
+               stop
+            else
+               nespeuv=nespeuv+1
+            endif
+         endif  ! Of if(euvmod.eq.2)
+         ! N
+         g_n=igcm_n
+         if(euvmod == 2) then
+            if (g_n.eq.0) then
+               write(*,*) "euvheat: Error; no N tracer !!!"
+               write(*,*) "N needed if NO is in traceur.def"
+               stop
+            else if(g_n.ne.0) then
+               nespeuv=nespeuv+1
+            endif
+         else
+            if(g_n /= 0) then
+               write(*,*) "euvheat: Error: N present, but NO not!!!"
+               write(*,*) "Both must be in traceur.def"
+               stop
+            endif
+         endif   !Of if(euvmod==2)
+         !NO2
+         g_no2=igcm_no2
+         if(euvmod == 2) then
+            if (g_no2.eq.0) then
+               write(*,*) "euvheat: Error; no NO2 tracer !!!"
+               write(*,*) "NO2 needed if NO is in traceur.def"
+               stop
+            else if(g_no2.ne.0) then
+               nespeuv=nespeuv+1
+            endif
+         else
+            if(g_no2 /= 0) then
+               write(*,*) "euvheat: Error: NO2 present, but NO not!!!"
+               write(*,*) "Both must be in traceur.def"
+               stop
+            endif
+         endif   !Of if(euvmod==2)
+         !N2D
+         g_n2d=igcm_n2d
+         if(euvmod == 2) then
+            if (g_n2d.eq.0) then
+               write(*,*) "euvheat: Error; no N2D tracer !!!"
+               write(*,*) "N2D needed if NO is in traceur.def"
+               stop
+            else
+               nespeuv=nespeuv+1  
+            endif
+         else
+            if(g_n2d /= 0) then
+               write(*,*) "euvheat: Error: N2D present, but NO not!!!"
+               write(*,*) "Both must be in traceur.def"
+               stop
+            endif
+         endif   !Of if(euvmod==2)
+
+         !Check if nespeuv is appropriate for the value of euvmod
+         select case(euvmod)
+         case(0)
+            if(nespeuv.ne.11) then
+               write(*,*)'euvheat: Wrong number of tracers!'
+               stop
+            else
+               write(*,*)'euvheat: Computing absorption by',nespeuv, &
+                    ' species'
+            endif
+         case(1)
+            if(nespeuv.ne.12) then
+               write(*,*)'euvheat: Wrong number of tracers!',nespeuv
+               stop
+            else
+               write(*,*)'euvheat: Computing absorption by',nespeuv,  &
+                    ' species'
+            endif
+         case(2)
+            if(nespeuv.ne.17) then
+               write(*,*)'euvheat: Wrong number of tracers!'
+               stop
+            else
+               write(*,*)'euvheat: Computing absorption by',nespeuv,  &
+                    ' species'
+            endif
+         end select
+        
+         firstcall= .false.
+      endif                     ! of if (firstcall)
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      !Number of species if not firstcall
+
+
+      !Allocate density vector
+      allocate(rm(nlayermx,nespeuv))
+      ! build local updated values of tracers and temperature
+      do l=1,nlayermx
+        do ig=1,ngridmx
+          ! chemical species
+          zq(ig,l,g_co2)=pq(ig,l,g_co2)+pdq(ig,l,g_co2)*ptimestep
+          zq(ig,l,g_o2)=pq(ig,l,g_o2)+pdq(ig,l,g_o2)*ptimestep
+          zq(ig,l,g_o)=pq(ig,l,g_o)+pdq(ig,l,g_o)*ptimestep
+          zq(ig,l,g_h2)=pq(ig,l,g_h2)+pdq(ig,l,g_h2)*ptimestep
+          zq(ig,l,g_h2o2)=pq(ig,l,g_h2o2)+pdq(ig,l,g_h2o2)*ptimestep
+          zq(ig,l,g_h2o)=pq(ig,l,g_h2o)+pdq(ig,l,g_h2o)*ptimestep
+          zq(ig,l,g_n2)=pq(ig,l,g_n2)+pdq(ig,l,g_n2)*ptimestep
+          zq(ig,l,g_co)=pq(ig,l,g_co)+pdq(ig,l,g_co)*ptimestep
+          zq(ig,l,g_h)=pq(ig,l,g_h)+pdq(ig,l,g_h)*ptimestep
+          if(euvmod.ge.1)   &
+               zq(ig,l,g_o3)=pq(ig,l,g_o3)+pdq(ig,l,g_o3)*ptimestep
+          if(euvmod.eq.2) then
+             zq(ig,l,g_n)=pq(ig,l,g_n)+pdq(ig,l,g_n)*ptimestep
+             zq(ig,l,g_no)=pq(ig,l,g_no)+pdq(ig,l,g_no)*ptimestep
+             zq(ig,l,g_no2)=pq(ig,l,g_no2)+pdq(ig,l,g_no2)*ptimestep
+          endif
+          if(euvmod.gt.2.or.euvmod.lt.0) then
+             write(*,*)'euvheat: bad value for euvmod. Stop'
+             stop
+          endif
+          ! atmospheric temperature
+          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
+        enddo
+      enddo
+      
+      !Solar flux calculation
+      call flujo(solarcondate)
+
+                                         ! Not recommended for long runs 
+                                         ! (e.g. to build the MCD), as the
+                                         ! solar conditions at the end will 
+                                         ! be different to the ones initially
+                                         ! set
+      
+      do ig=1,ngridmx
+         zenit=acos(mu0(ig))*180./acos(-1.)
+         
+         do l=1,nlayermx
+            !Conversion to number density
+            dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21
+            rm(l,i_co2)  = zq(ig,l,g_co2)  * dens / mmol(g_co2)
+            rm(l,i_o2)   = zq(ig,l,g_o2)   * dens / mmol(g_o2)
+            rm(l,i_o)    = zq(ig,l,g_o)    * dens / mmol(g_o)
+            rm(l,i_h2)   = zq(ig,l,g_h2)   * dens / mmol(g_h2)
+            rm(l,i_h2o)  = zq(ig,l,g_h2o)  * dens / mmol(g_h2o)
+            rm(l,i_h2o2) = zq(ig,l,g_h2o2) * dens / mmol(g_h2o2)
+            rm(l,i_co)   = zq(ig,l,g_co)   * dens / mmol(g_co)
+            rm(l,i_h)    = zq(ig,l,g_h)    * dens / mmol(g_h)
+            !Only if O3, N or ion chemistry requested
+            if(euvmod.ge.1)   &
+                 rm(l,i_o3)   = zq(ig,l,g_o3)   * dens / mmol(g_o3)
+            !Only if N or ion chemistry requested
+            if(euvmod.ge.2) then
+               rm(l,i_n2)   = zq(ig,l,g_n2)   * dens / mmol(g_n2)
+               rm(l,i_n)    = zq(ig,l,g_n)    * dens / mmol(g_n)
+               rm(l,i_no)   = zq(ig,l,g_no)   * dens / mmol(g_no)          
+               rm(l,i_no2)  = zq(ig,l,g_no2)  * dens / mmol(g_no2)
+            endif
+         enddo
+
+!        zlocal(1)=-log(pplay(ig,1)/pplev(ig,1))
+!     &            *Rnew(ig,1)*zt(ig,1)/g
+         zlocal(1)=zzlay(ig,1)
+         zlocal(1)=zlocal(1)/1000.
+         tx(1)=zt(ig,1)
+
+         do l=2,nlayermx
+            tx(l)=zt(ig,l)
+            zlocal(l)=zzlay(ig,l)/1000.
+         enddo
+        !Routine to calculate the UV heating
+         call hrtherm (ig,euvmod,rm,nespeuv,tx,zlocal,zenit,jtot)
+
+!        euveff=0.16    !UV heating efficiency. Following Fox et al. ASR 1996
+                       !should vary between 19% and 23%. Lower values 
+                       !(i.e. 16%) can be used to compensate underestimation 
+                       !of 15-um cooling (see Forget et al. JGR 2009 and 
+                       !Gonzalez-Galindo et al. JGR 2009) for details
+        !Calculates the UV heating from the total photoabsorption coefficient
+        do l=1,nlayermx
+          pdteuv(ig,l)=euveff*jtot(l)/10.                  &
+               /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l)))
+!     &                  *(1.52/dist_sol)**2  !The solar flux calculated in 
+                                              !flujo.F is already corrected for
+                                              !the actual Mars-Sun distance
+        enddo	
+      enddo  ! of do ig=1,ngridmx
+      !Deallocations
+      deallocate(rm)
+
+      return
+      end 
Index: trunk/LMDZ.MARS/libf/aeronomars/flujo.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/flujo.F	(revision 633)
+++ 	(revision )
@@ -1,48 +1,0 @@
-c***************************************************
-
-      subroutine flujo(date)
-
-
-c     fgg           nov 2002     first version
-c***************************************************
-
-      implicit none
-
-
-c     common variables and constants
-
-      include 'param.h'
-      include 'param_v3.h'
-
-
-c     Arguments
-
-      real date
-
-
-c     Local variable and constants
-
-      integer i
-      integer inter
-      real    nada
-
-c*************************************************
-
-      if(date.lt.1985.) date=1985.
-      if(date.gt.2001.) date=2001.
-      
-      do i=1,ninter
-        if(i.le.24) then
-          fluxtop(i)=(((ct1(i)+p1(i)*date)/2.)
-     $                *sin(2.*3.1416/11.*(date-1985.-3.1416))
-     $                +(ct2(i)+p2(i)*date)+1.)*fluxtophr(i)
-        else
-          fluxtop(i)=fluxtophr(i)
-        end if
-      end do
-     
-      return
-      end
-      
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/getch.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/getch.F	(revision 633)
+++ 	(revision )
@@ -1,76 +1,0 @@
-c***************************************************************************
-       subroutine getch (tt)
-
-c	NOV 98	MALV 		First Version. From the work:
-c                               Rodrigo et al, Atmosfera, 3, pp.31-43, 19990
-c       apr 02  FGG             New reactions
-c       jul 03  MAC             Updated to agree with lower atmosphere
-c***************************************************************************
-	
-      implicit none
-
-      include 'param.h'
-      include 'param_v3.h'
-
-c Arguments 	
-      real*8 		tt		! Temperature 
-
-
-c**************************************************************************
-
-ch2: h + o2 + co2 --> ho2 + co2
-      ch2 = 1.3d-31 * exp(tt / 300.) ** (-1.6)
-
-ch3: o + ho2 --> oh + o2
-      ch3 = 3.0d-11 * exp(200.d0 / tt)
-
-ch4: co + oh --> co2 + h
-      ch4 = 1.57d-13 + 3.54d-33
-
-ch5: ho2 + ho2 --> h2o2 + o2
-      ch5 = 1.5d-12 * exp(19.d0 / tt)
-
-ch7: oh + ho2 --> h2o + o2
-      ch7 = 4.8d-11 * exp(250.d0 / tt)
-
-ch9: o(1d) + h2o --> 2oh
-      ch9 = 2.2d-10
-
-ch10: o + o + co2 --> o2 + co2
-      ch10 = 2.5 * 5.2d-35 * exp(900. / tt) 
-
-ch11: o + oh --> o2 + h
-      ch11 = 2.2d-11 * exp(120.d0 / tt)
-
-ch13: h + ho2 --> h2 + o2
-      ch13 = 6.48d-12
-
-ch14: o(1d) + h2 --> h + oh
-      ch14 = 1.1d-10
-
-ch15: oh + h2 --> h + h2o
-      ch15 = 5.5d-12 * exp (-2000.d0 / tt)
-
-ch18: oh + h2o2 --> h2o + ho2
-      ch18 = 2.9d-12 * exp (-160.d0 / tt)
-
-ch19: o(1d) + co2 --> o + co2
-      ch19 = 7.4d-11 * exp(120.d0 / tt)
-
-ch20: o(1d) + o2 --> o + o2
-      ch20 = 3.2d-11 * exp (70.d0 / tt)
-
-ch21: o + o2 + co2 --> o3 + co2
-      ch21 = 2.5 * 6.0d-34 * (tt / 300.) ** (-2.4) 
-
-      return 
-      end
-
-
-
-
-
-
-
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/hrtherm.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/hrtherm.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/hrtherm.F	(revision 635)
@@ -1,6 +1,5 @@
 c**********************************************************************
 
-      subroutine hrtherm
-     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit,jtot)
+      subroutine hrtherm(ig,euvmod,rm,nespeuv,tx,iz,zenit,jtot)
 
 
@@ -14,14 +13,15 @@
 c     common variables and constants
 
+
+      include 'dimensions.h'
+      include 'dimphys.h'
       include 'param.h'
-      include 'param_v3.h'
-      include 'callkeys.h'
+      include 'param_v4.h'
 
 
 c    local parameters and variables
 
-      real       xabsi(nabs,nzmax) 			!densities
-      real       nada
-      real       jergs(ninter,nabs,nzmax)
+      real       xabsi(nabs,nlayermx) 			!densities
+      real       jergs(ninter,nabs,nlayermx)
       
       integer    i,j,k,indexint          !indexes
@@ -31,31 +31,33 @@
 c     input and output variables
 
-      integer    nz                          !number of layers
-      real       co2x(nz)                    !density of CO2(cm^-3)
-      real       o2x(nz)                     !density of O2(cm^-3)
-      real       o3px(nz)                    !density of O(3P)(cm^-3)
-      real       h2x(nz)                     !density of H2(cm^-3)
-      real       h2ox(nz)                    !density of H2O(cm^-3)
-      real       h2o2x(nz)                   !density of H2O2(cm^-3)
-      real       aux1(nz)	  	             !auxiliar variable
-      real       aux2(nz)                    !auxiliar variable
-      real       jtot(nz)                    !output: heating rate(erg/s)
-      real       tx(nz)                      !temperature
-      real       date
+      integer    ig  ,euvmod 
+      integer    nespeuv
+      real       rm(nlayermx,nespeuv)              !density matrix (cm^-3)
+      real       jtot(nlayermx)                    !output: heating rate(erg/s)
+      real       tx(nlayermx)                      !temperature
       real       zenit
-      real       iz(nz)
+      real       iz(nlayermx)
 
-      logical firstcall
-      save firstcall
-      data firstcall /.true./
+      ! tracer indexes for the EUV heating:
+!!! ATTENTION. These values have to be identical to those in chemthermos.F90
+!!! If the values are changed there, the same has to be done here  !!!
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o3=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_n=14
+      integer,parameter :: i_no=15
+      integer,parameter :: i_no2=17
 
 c*************************PROGRAM STARTS*******************************
 
-c      if (firstcall) then
-c        if(.not. thermochem) call param_read
-c        firstcall= .false.
-c      endif
-
-      if(zenit.gt.100.) then
+      !If nighttime, photoabsorption coefficient set to 0
+      if(zenit.gt.140.) then
          dn='n'
          else
@@ -63,28 +65,45 @@
       end if
       if(dn.eq.'n') then
-        do i=1,nz                                    
+        do i=1,nlayermx                                    
 	      jtot(i)=0.
         enddo       
         return
       endif 
-     
-      do i=1,nz
-         xabsi(1,i) = co2x(i)
-         xabsi(2,i) = o2x(i)
-         xabsi(3,i) = o3px(i)
-         xabsi(4,i) = h2ox(i)
-         xabsi(5,i) = h2x(i)
-         xabsi(6,i) = h2o2x(i)
-         jtot(i) = 0.
+
+      !initializations
+      jergs(:,:,:)=0.
+      xabsi(:,:)=0.
+      jtot(:)=0.
+      !All number densities to a single array, xabsi(species,layer)
+      do i=1,nlayermx
+         xabsi(1,i)  = rm(i,i_co2)
+         xabsi(2,i)  = rm(i,i_o2)
+         xabsi(3,i)  = rm(i,i_o)
+         xabsi(4,i)  = rm(i,i_h2o)
+         xabsi(5,i)  = rm(i,i_h2)
+         xabsi(6,i)  = rm(i,i_h2o2)
+         !Only if O3, N or ion chemistry requested
+         if(euvmod.ge.1) then
+            xabsi(7,i)  = rm(i,i_o3)
+         endif
+         !Only if N or ion chemistry requested
+         if(euvmod.ge.2) then
+            xabsi(8,i)  = rm(i,i_n2)
+            xabsi(9,i)  = rm(i,i_n)
+            xabsi(10,i) = rm(i,i_no)
+            xabsi(13,i) = rm(i,i_no2)
+         endif
+         xabsi(11,i) = rm(i,i_co)
+         xabsi(12,i) = rm(i,i_h)
       end do
 
-      if(.not. thermochem) then
-        call jthermcalc
-     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
-      endif
+      !Calculation of photoabsortion coefficient
+      call jthermcalc(ig,euvmod,rm,nespeuv,tx,iz,zenit)
 
-      do i=1,nz
+      !Total photoabsorption coefficient
+      do i=1,nlayermx
+         jtot(i)=0.
         do j=1,nabs
-          do indexint=1,33
+          do indexint=1,ninter
             jergs(indexint,j,i) = jfotsout(indexint,j,i) 
      $              * xabsi (j,i) * fluxtop(indexint)  
Index: trunk/LMDZ.MARS/libf/aeronomars/interpfast.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/interpfast.F	(revision 633)
+++ 	(revision )
@@ -1,29 +1,0 @@
-      subroutine interpfast(escout,p,nlayer,escin,pin,nl,limdown,limup)
-C
-C subroutine to perform linear interpolation in pressure from 1D profile 
-C escin(nl) sampled on pressure grid pin(nl) to profile
-C escout(nlayer) on pressure grid p(nlayer).
-C
-      real escout(nlayer),p(nlayer)
-      real escin(nl),pin(nl),wm,wp
-      real limup,limdown
-      integer nl,nlayer,n1,n,nm,np
-      nm=1
-      do 5 n1=1,nlayer
-         if(p(n1) .gt. limup .or. p(n1) .lt. limdown) then
-            escout(n1) = 0.0
-         else
-            do n = nm,nl-1
-               if (p(n1).ge.pin(n).and.p(n1).le.pin(n+1)) then
-                  nm=n
-                  np=n+1
-                  wm=abs(pin(nm)-p(n1))/(pin(np)-pin(nm))
-                  wp=1.0 - wm
-                  goto 33
-               endif
-            enddo
- 33         escout(n1) = escin(np)*wm + escin(nm)*wp
-         endif
-    5 continue
-      return
-      end
Index: trunk/LMDZ.MARS/libf/aeronomars/iono.h
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/iono.h	(revision 635)
+++ trunk/LMDZ.MARS/libf/aeronomars/iono.h	(revision 635)
@@ -0,0 +1,47 @@
+      common/eqF/ o1d_eq,ho2_eq,oh_eq,h_eq,n2d_eq,no2_eq,
+     $ o3_eq,no_eq,
+     $ cplus_eq,coplus_eq,oplus_eq,n2plus_eq,hplus_eq,co2plus_eq,
+     $ o2plus_eq,noplus_eq,nplus_eq,hco2plus_eq
+
+	character*1 o1d_eq(nlayermx),ho2_eq(nlayermx),oh_eq(nlayermx)
+      character*1 h_eq(nlayermx),n2d_eq(nlayermx),no2_eq(nlayermx)
+      character*1 o3_eq(nlayermx),no_eq(nlayermx),cplus_eq(nlayermx)
+      character*1 coplus_eq(nlayermx),oplus_eq(nlayermx)
+      character*1 n2plus_eq(nlayermx)
+      character*1 hplus_eq(nlayermx),co2plus_eq(nlayermx)
+      character*1 o2plus_eq(nlayermx)
+      character*1 noplus_eq(nlayermx), nplus_eq(nlayermx) 
+      character*1 hco2plus_eq(nlayermx)      
+
+      common/taus/ tauco2,tauo2,tauo3p,tauco,tauh,tauoh,tauho2,tauh2,
+     $ tauh2o,tauo1d,tauh2o2,tauo3,taun,tauno,taun2,taun2d,tauno2,
+     $ tauco2plus,tauoplus,tauo2plus,taucoplus,taucplus,taunplus,
+     $ taunoplus,taun2plus,tauhplus,tauhco2plus
+
+      real*8    tauco2(nlayermx,nreact)
+      real*8    tauo2(nlayermx,nreact)
+      real*8    tauo3p(nlayermx,nreact)
+      real*8    tauco(nlayermx,nreact)
+      real*8    tauh(nlayermx,nreact)
+      real*8    tauoh(nlayermx,nreact)
+      real*8    tauho2(nlayermx,nreact)
+      real*8    tauh2(nlayermx,nreact)
+      real*8    tauh2o(nlayermx,nreact)
+      real*8    tauo1d(nlayermx,nreact)
+      real*8    tauh2o2(nlayermx,nreact)
+      real*8    tauo3(nlayermx,nreact)
+      real*8    taun(nlayermx,nreact)
+      real*8    tauno(nlayermx,nreact)
+      real*8    taun2(nlayermx,nreact)
+      real*8    taun2d(nlayermx,nreact)
+      real*8    tauno2(nlayermx,nreact)
+      real*8    tauco2plus(nlayermx,nreact)
+      real*8    tauoplus(nlayermx,nreact)
+      real*8    tauo2plus(nlayermx, nreact)
+      real*8    taucoplus(nlayermx, nreact)
+      real*8    taucplus(nlayermx, nreact)
+      real*8    taunplus(nlayermx, nreact) 
+      real*8    taunoplus(nlayermx, nreact)
+      real*8    taun2plus(nlayermx, nreact)
+      real*8    tauhplus(nlayermx, nreact)
+      real*8    tauhco2plus(nlayermx, nreact)
Index: trunk/LMDZ.MARS/libf/aeronomars/jthermcalc.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/jthermcalc.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/jthermcalc.F	(revision 635)
@@ -1,6 +1,5 @@
 c**********************************************************************
 
-      subroutine jthermcalc
-     $ (co2x,o2x,o3px,h2x,h2ox,h2o2x,aux1,aux2,tx,nz,iz,date,zenit)
+      subroutine jthermcalc(ig,chemthermod,rm,nesptherm,tx,iz,zenit)
 
 
@@ -15,45 +14,46 @@
 
 c     common variables and constants
-
+      include "dimensions.h"
+      include "dimphys.h"
       include 'param.h'
-      include 'param_v3.h'
+      include 'param_v4.h'
+
+c     input and output variables
+
+      integer    ig
+      integer    chemthermod
+      integer    nesptherm                      !Number of species considered
+      real       rm(nlayermx,nesptherm)         !Densities (cm-3)
+      real       tx(nlayermx)                   !temperature
+      real       zenit                          !SZA
+      real       iz(nlayermx)                   !Local altitude
+
 
 c    local parameters and variables
 
-      real       xabsi(nabs,nzmax) !densities
-      real       nada
-      real       co2colx2(nzmax,ninter)
-      real       o2colx2(nzmax,ninter)
-      real       o3pcolx2(nzmax,ninter)
-      real       co2colx(nzmax)              !column density of CO2 (cm^-2)
-      real       o2colx(nzmax)               !column density of O2(cm^-2)
-      real       o3pcolx(nzmax)              !column density of O(3P)(cm^-2)
-      real       h2o2colx(nzmax)             !column density of H2O2(cm^-2)
-      real       t2(nzmax)
-      real       coltemp(nzmax)
-      real       dt(nzmax)
-      real       sigma(ninter,nzmax)
-      real       alfa(ninter,nzmax)
-      real       xx
-      real       grav(nzmax)
+      real       aux1(nlayermx)	                !auxiliar variable
+      real       aux2(nlayermx)                 !auxiliar variable
+      real       co2colx(nlayermx)              !column density of CO2 (cm^-2)
+      real       o2colx(nlayermx)               !column density of O2(cm^-2)
+      real       o3pcolx(nlayermx)              !column density of O(3P)(cm^-2)
+      real       h2colx(nlayermx)               !H2 column density (cm-2)
+      real       h2ocolx(nlayermx)              !H2O column density (cm-2)
+      real       h2o2colx(nlayermx)             !column density of H2O2(cm^-2)
+      real       o3colx(nlayermx)               !O3 column density (cm-2)
+      real       n2colx(nlayermx)               !N2 column density (cm-2)
+      real       ncolx(nlayermx)                !N column density (cm-2)
+      real       nocolx(nlayermx)               !NO column density (cm-2)
+      real       cocolx(nlayermx)               !CO column density (cm-2)
+      real       hcolx(nlayermx)                !H column density (cm-2)
+      real       no2colx(nlayermx)              !NO2 column density (cm-2)
+      real       t2(nlayermx)
+      real       coltemp(nlayermx)
+      real       sigma(ninter,nlayermx)
+      real       alfa(ninter,nlayermx)
       
-      integer    i,j,k,icol,indexint          !indexes
+      integer    i,j,k,indexint                 !indexes
       character  dn
 
-c     input and output variables
-
-      integer    nz                          !number of layers
-      real       co2x(nz)                    !density of CO2(cm^-3)
-      real       o2x(nz)                     !density of O2(cm^-3)
-      real       o3px(nz)                    !density of O(3P)(cm^-3)
-      real       h2x(nz)                     !density of H2(cm^-3)
-      real       h2ox(nz)                    !density of H2O(cm^-3)
-      real       h2o2x(nz)                   !density of H2O2(cm^-3)
-      real       aux1(nz)	             !auxiliar variable
-      real       aux2(nz)                    !auxiliar variable
-      real       tx(nz)                      !temperature
-      real       date
-      real       zenit
-      real       iz(nz)
+
 
 
@@ -65,7 +65,11 @@
       real       limup                        !        ""
 
+      !!!ATTENTION. Here i_co2 has to have the same value than in chemthermos.F90
+      !!!If the value is changed there, if has to be changed also here !!!!
+      integer,parameter :: i_co2=1
+
 c*************************PROGRAM STARTS*******************************
-
-      if(zenit.gt.100.) then
+      
+      if(zenit.gt.140.) then
          dn='n'
          else
@@ -74,81 +78,87 @@
       if(dn.eq.'n') then
         return
-      endif 
-     
-      do i=1,nz
-         xabsi(1,i) = co2x(i)
-         xabsi(2,i) = o2x(i)
-         xabsi(3,i) = o3px(i)
-         xabsi(4,i) = h2ox(i)
-         xabsi(5,i) = h2x(i)
-         xabsi(6,i) = h2o2x(i)
-      end do
-
-      do i=1,nz
+      endif
+      
+      !Initializing the photoabsorption coefficients
+      jfotsout(:,:,:)=0.
+
+      !Auxiliar temperature to take into account the temperature dependence
+      !of CO2 cross section
+      do i=1,nlayermx
          t2(i)=tx(i)
-         if(t0(i).lt.195.0) t0(i)=195.0
-         if(t0(i).gt.295.0) t0(i)=295.0
          if(t2(i).lt.195.0) t2(i)=195.0
          if(t2(i).gt.295.0) t2(i)=295.0
       end do
 
-
-c    COLUMN CALCULATION 
-
-      call column(co2x,o2x,o3px,h2x,h2ox,h2o2x,tx,nz,iz,zenit,co2colx
-     $,o2colx,o3pcolx,h2o2colx)
-
-      coltemp(nz)=co2colx(nz)*abs(t2(nz)-t0(nz))
-      dt(nz)=coltemp(nz)/co2colx(nz)
-      do i=nz-1,1,-1
-        coltemp(i)=coltemp(i+1)+ 
-     $         ( co2x(i) + co2x(i+1) ) * 0.5 
+      !Calculation of column amounts 
+      call column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
+     $     co2colx,o2colx,o3pcolx,h2colx,h2ocolx,
+     $     h2o2colx,o3colx,n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)
+
+      !Auxiliar column to include the temperature dependence 
+      !of CO2 cross section
+      coltemp(nlayermx)=co2colx(nlayermx)*abs(t2(nlayermx)-t0(nlayermx))
+      do i=nlayermx-1,1,-1
+        coltemp(i)=!coltemp(i+1)+     PQ SE ELIMINA? REVISAR 
+     $         ( rm(i,i_co2) + rm(i+1,i_co2) ) * 0.5 
      $         * 1e5 * (iz(i+1)-iz(i)) * abs(t2(i)-t0(i))
-        dt(i)=coltemp(i)/co2colx(i)
-      end do
-
-
-c     Calculo la seccion eficaz de CO2 a la temperatura t0 a cada altura
-c CALCULATION OF CO2 CROSS-SECTION AT TEMPERATURE T0 AT EACH HEIGHT
-
-      do i=1,nz
+      end do
+      
+      !Calculation of CO2 cross section at temperature t0(i)
+      do i=1,nlayermx
          do indexint=24,32
-           sigma(indexint,i)=co2crsc195(indexint-23)*
-     $         (1+((co2crsc295(indexint-23)/co2crsc195(indexint-23))-1.)
-     $         *(t0(i)-195.)/100.)
-           if(t0(i).ne.295.) then
-             alfa(indexint,i)=((co2crsc295(indexint-23)
-     $                        /sigma(indexint,i))-1.)/(295.-t0(i))
-           else 
-             alfa(indexint,i)=0.
-           end if
-         end do
-      end do
-
-
-c     Comienza la interpolacion
-c INTERPOLATION BEGINS
+           sigma(indexint,i)=co2crsc195(indexint-23)
+           alfa(indexint,i)=((co2crsc295(indexint-23)
+     $          /sigma(indexint,i))-1.)/(295.-t0(i))
+        end do
+      end do
+
+! Interpolation to the tabulated photoabsorption coefficients for each species
+! in each spectral interval
+
+!AQUI SE PODRIAN AGRUPAR CALCULOS PARA AHORRAR TIEMPO DE CPU
+!P.EJ. LOS CALCULOS DE AUX2 y AUX4 NO ES NECESARIO REPETIRLOS
+!PARA CADA ESPECIE EN UN INTERVALO.
+!REVISAR
+
+!TAMBIEN SE PODRIA PONER, EN LUGAR DE CONDICIONES SOBRE CHEMTHERMOD
+!PARA VER QUE ESPECIES SE CONSIDERAN, PONER CONDICION SOBRE LA EXISTENCIA DE 
+!CADA ESPECIE EN TRACEUR.DEF. ASI SE CALCULARIA LA FOTOABSORCION DE TODAS LAS
+!ESPECIES INCLUIDAS, AUNQUE LUEGO NO SE TENGA EN CUENTA EN LA QUIMICA (P.EJ.,
+!SI HAY NO2 PERO NO NO, NO SE CALCULARIA QUIMICA DEL NITROGENO PERO SE PODRIA
+!TENER EN CUENTA PARA EL CALENTAMIENTO
+!ESTUDIAR EN EL FUTURO
+
+!OTRA POSIBILIDAD ES SUSTITUIR LA ESCRITURA EN DURO DE LOS INDICES
+!DE LAS ESPECIES EN JABSIFOTS, CRSCABSI, ETC. POR INDICES DEL TIPO I_*
+!ESTUDIAR EN EL FUTURO
 c************************************************
-c     o2,0.1,5.0
+c     co2,0.1,6.0
 c************************************************
-      
+
       indexint=1
       limdown=1e-20
       limup=1e26
-       do i=1,nz
-         aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
-       end do
-       do i=1,nz2
-         aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
-         aux4(i) = c23(nz2-i+1)
-       enddo
-       call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
-       do i=1,nz
-         jfotsout(indexint,2,i) = aux1(nz-i+1)
-       enddo
+      do i=1,nlayermx
+         aux1(i)=0.
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint) +
+     $        o2colx(i)*crscabsi2(2,indexint) + 
+     $        o3pcolx(i)*crscabsi2(3,indexint) + 
+     $        h2colx(i)*crscabsi2(5,indexint) + 
+     $        ncolx(i)*crscabsi2(9,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+      enddo
 
 c************************************************
-c     o3p,0.1,5.0
+c     o2,0.1,6.0
 c************************************************
 
@@ -156,200 +166,698 @@
       limdown=1e-20
       limup=1e26
-         do i=1,nz
-            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
-            aux4(i) = c23(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup)
-         do i=1,nz
-            jfotsout(indexint,3,i) = aux1(nz-i+1)
-         enddo
-
-
-c************************************************
-c     h2,0.1,5.0
-c************************************************
+      do i=1,nlayermx
+         aux1(i)=0.
+         aux2(nlayermx-i+1) =  co2colx(i)*crscabsi2(1,indexint) +
+     $        o2colx(i)*crscabsi2(2,indexint) + 
+     $        o3pcolx(i)*crscabsi2(3,indexint) + 
+     $        h2colx(i)*crscabsi2(5,indexint) + 
+     $        ncolx(i)*crscabsi2(9,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
+      enddo
+
+c**************************************************         
+c     o3p,0.1,6.0
+c**************************************************
 
       indexint=1
       limdown=1e-20
       limup=1e26
-         do i=1,nz
-            aux2(nz-i+1) = o2colx(i) + o3pcolx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
-            aux4(i) = c23(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,5,i) = aux1(nz-i+1)
-         enddo
-
-
-c************************************************
-c     interpola para el o2 entre 5 y 90.8nm
-c************************************************
-
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) =  co2colx(i)*crscabsi2(1,indexint) +
+     $        o2colx(i)*crscabsi2(2,indexint) + 
+     $        o3pcolx(i)*crscabsi2(3,indexint) + 
+     $        h2colx(i)*crscabsi2(5,indexint) + 
+     $        ncolx(i)*crscabsi2(9,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,3,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,3,i) = aux1(nlayermx-i+1)
+      enddo
+
+      
+c**************************************************
+c     h2,0.1,6.0
+c**************************************************
+
+      indexint=1
       limdown=1e-20
-      limup=1e12
-      do indexint=2,16
-         co2colx2(nz,indexint)= co2colx(nz) 
-     $              * crscabsi2(1,indexint)
-         o2colx2(nz,indexint)= o2colx(nz) 
-     $              * crscabsi2(2,indexint)
-         o3pcolx2(nz,indexint)= o3pcolx(nz) 
-     $              * crscabsi2(3,indexint)
-         do i=nz-1,1,-1
-            co2colx2(i,indexint) = co2colx2(i+1,indexint) + 
-     $         ( xabsi(1,i) + xabsi(1,i+1) ) * 0.5 
-     $           * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(1,indexint)
-            o2colx2(i,indexint) = o2colx2(i+1,indexint) + 
-     $         ( xabsi(2,i) + xabsi(2,i+1) ) * 0.5 
-     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(2,indexint)
-            o3pcolx2(i,indexint) = o3pcolx2(i+1,indexint) + 
-     $         ( xabsi(3,i) + xabsi(3,i+1) ) * 0.5 
-     $         * 1e5 * (iz(i+1)-iz(i)) * crscabsi2(3,indexint)
-         end do
-         do i=1,nz
-            aux2(nz-i+1) = co2colx2(i,indexint)+
-     $      o2colx2(i,indexint)+
-     $      o3pcolx2(i,indexint)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
-            aux4(i) = c123(indexint,nz2-i+1)
+      limup=1e26
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) =  co2colx(i)*crscabsi2(1,indexint) +
+     $        o2colx(i)*crscabsi2(2,indexint) + 
+     $        o3pcolx(i)*crscabsi2(3,indexint) + 
+     $        h2colx(i)*crscabsi2(5,indexint) + 
+     $        ncolx(i)*crscabsi2(9,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,5,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,5,i) = aux1(nlayermx-i+1)
+      enddo
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     n,0.1,6.0
+c**************************************************
+
+
+         indexint=1
+         limdown=1e-20
+         limup=1e26
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) =  co2colx(i)*crscabsi2(1,indexint) +
+     $           o2colx(i)*crscabsi2(2,indexint) + 
+     $           o3pcolx(i)*crscabsi2(3,indexint) + 
+     $           h2colx(i)*crscabsi2(5,indexint) + 
+     $           ncolx(i)*crscabsi2(9,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,9,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,9,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif  !Of chemthermod >= 2
+      
+
+c**************************************************
+c     o2, 5-80.5nm
+c**************************************************
+
+      limdown=1e-20
+      limup=1e26
+      do indexint=2,15
+         do i=nlayermx-1,1,-1
+         end do
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
          enddo
           call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-          do i=1,nz
-            jfotsout(indexint,2,i) = aux1(nz-i+1) 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+          do i=1,nlayermx
+            jfotsout(indexint,2,i) = aux1(nlayermx-i+1) 
           enddo
       end do
       
 
-c************************************************
-c     idem para o3p entre 5 y 90.8nm
-c************************************************
-
-      do indexint=2,16
-         do i=1,nz
-            aux2(nz-i+1) = co2colx2(i,indexint) +
-     $      o2colx2(i,indexint) +
-     $      o3pcolx2(i,indexint)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,3,nz2-i+1)
-            aux4(i) = c123(indexint,nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,3,i) = aux1(nz-i+1)
-         enddo
-      end do
-
-
-c************************************************
-c     idem para co2 entre 5 y 90.8nm
-c************************************************
-
-      do indexint=2,16
-         do i=1,nz
-            aux2(nz-i+1) = co2colx2(i,indexint) +
-     $      o2colx2(i,indexint) +
-     $      o3pcolx2(i,indexint)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
-            aux4(i) = c123(indexint,nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,1,i) = aux1(nz-i+1)
-         enddo
-      end do
-
-
-c************************************************
-c     idem para h2 entre 5 y 80.6nm
-c************************************************
+c**************************************************
+c     o3p, 5-80.5nm
+c**************************************************
 
       do indexint=2,15
-         do i=1,nz
-            aux2(nz-i+1) = co2colx2(i,indexint) +
-     $      o2colx2(i,indexint) +
-     $      o3pcolx2(i,indexint)
-         end do
-         do i=1,nabs
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,5,nz2-i+1)
-            aux4(i) = c123(indexint,nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,5,i) = aux1(nz-i+1)
-         enddo
-      end do
-
-
-c************************************************
-c      co2,90.9,119.5
-c************************************************
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,3,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,3,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+c**************************************************
+c     co2, 5-80.5nm
+c**************************************************
+
+      do indexint=2,15
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+
+c**************************************************
+c     h2, 5-80.5nm
+c**************************************************
+
+      do indexint=2,15
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,5,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,5,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+
+c**************************************************
+c     n2, 5-80.5nm
+c**************************************************
+
+      do indexint=2,15
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,8,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,8,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+
+c**************************************************
+c     co, 5-80.5nm
+c**************************************************
+
+      do indexint=2,15
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,11,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,11,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+
+c**************************************************
+c     h, 5-80.5nm
+c**************************************************
+
+      do indexint=2,15
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           h2colx(i)*crscabsi2(5,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,12,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,12,i) = aux1(nlayermx-i+1)
+         enddo
+      end do
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+c**************************************************
+c     n, 5-80.5nm
+c**************************************************
+
+         do indexint=2,15
+            do i=1,nlayermx
+               aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $              o2colx(i)*crscabsi2(2,indexint)+
+     $              o3pcolx(i)*crscabsi2(3,indexint)+
+     $              h2colx(i)*crscabsi2(5,indexint)+
+     $              n2colx(i)*crscabsi2(8,indexint)+
+     $              ncolx(i)*crscabsi2(9,indexint)+
+     $              nocolx(i)*crscabsi2(10,indexint)+
+     $              cocolx(i)*crscabsi2(11,indexint)+
+     $              hcolx(i)*crscabsi2(12,indexint)+
+     $              no2colx(i)*crscabsi2(13,indexint)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,9,nz2-i+1)
+               aux4(i) = c1_16(nz2-i+1,indexint)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               jfotsout(indexint,9,i) = aux1(nlayermx-i+1)
+            enddo
+         end do
+
+
+c**************************************************
+c     no, 5-80.5nm
+c**************************************************
+
+         do indexint=2,15
+            do i=1,nlayermx
+               aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $              o2colx(i)*crscabsi2(2,indexint)+
+     $              o3pcolx(i)*crscabsi2(3,indexint)+
+     $              h2colx(i)*crscabsi2(5,indexint)+
+     $              n2colx(i)*crscabsi2(8,indexint)+
+     $              ncolx(i)*crscabsi2(9,indexint)+
+     $              nocolx(i)*crscabsi2(10,indexint)+
+     $              cocolx(i)*crscabsi2(11,indexint)+
+     $              hcolx(i)*crscabsi2(12,indexint)+
+     $              no2colx(i)*crscabsi2(13,indexint)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+               aux4(i) = c1_16(nz2-i+1,indexint)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+            enddo
+         end do
+
+c**************************************************
+c     no2, 5-80.5nm
+c**************************************************
+
+         do indexint=2,15
+            do i=1,nlayermx
+               aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $              o2colx(i)*crscabsi2(2,indexint)+
+     $              o3pcolx(i)*crscabsi2(3,indexint)+
+     $              h2colx(i)*crscabsi2(5,indexint)+
+     $              n2colx(i)*crscabsi2(8,indexint)+
+     $              ncolx(i)*crscabsi2(9,indexint)+
+     $              nocolx(i)*crscabsi2(10,indexint)+
+     $              cocolx(i)*crscabsi2(11,indexint)+
+     $              hcolx(i)*crscabsi2(12,indexint)+
+     $              no2colx(i)*crscabsi2(13,indexint)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+               aux4(i) = c1_16(nz2-i+1,indexint)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+            enddo
+         end do
+      
+         endif  !Of chemthermod >= 2
+
+         
+c**************************************************
+c     o2, 80.6-90.8nm
+c**************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,2,i) = aux1(nlayermx-i+1) 
+      enddo
+
+
+c**************************************************
+c     co2, 80.6-90.8nm
+c**************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,1,i) = aux1(nlayermx-i+1) 
+      enddo
+
+
+c**************************************************
+c     o3p, 80.6-90.8nm
+c**************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,3,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,3,i) = aux1(nlayermx-i+1) 
+      enddo
+      
+
+c**************************************************
+c     n2, 80.6-90.8nm
+c**************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,8,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,8,i) = aux1(nlayermx-i+1) 
+      enddo
+
+
+c**************************************************
+c     co, 80.6-90.8nm
+c************************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,11,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,11,i) = aux1(nlayermx-i+1) 
+      enddo
+
+
+c**************************************************
+c     h, 80.6-90.8nm
+c**************************************************
+
+      indexint=16
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $        o2colx(i)*crscabsi2(2,indexint)+
+     $        o3pcolx(i)*crscabsi2(3,indexint)+
+     $        n2colx(i)*crscabsi2(8,indexint)+
+     $        ncolx(i)*crscabsi2(9,indexint)+
+     $        nocolx(i)*crscabsi2(10,indexint)+
+     $        cocolx(i)*crscabsi2(11,indexint)+
+     $        hcolx(i)*crscabsi2(12,indexint)+
+     $        no2colx(i)*crscabsi2(13,indexint)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,12,nz2-i+1)
+         aux4(i) = c1_16(nz2-i+1,indexint)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,12,i) = aux1(nlayermx-i+1) 
+      enddo
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     n, 80.6-90.8nm
+c**************************************************
+
+         indexint=16
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,9,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,9,i) = aux1(nlayermx-i+1) 
+         enddo
+
+
+c**************************************************
+c     no, 80.6-90.8nm
+c**************************************************
+
+         indexint=16
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,10,i) = aux1(nlayermx-i+1) 
+         enddo
+
+
+c***********************************************************
+c     no2, 80.6-90.8nm
+c**************************************************
+
+         indexint=16
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i)*crscabsi2(1,indexint)+
+     $           o2colx(i)*crscabsi2(2,indexint)+
+     $           o3pcolx(i)*crscabsi2(3,indexint)+
+     $           n2colx(i)*crscabsi2(8,indexint)+
+     $           ncolx(i)*crscabsi2(9,indexint)+
+     $           nocolx(i)*crscabsi2(10,indexint)+
+     $           cocolx(i)*crscabsi2(11,indexint)+
+     $           hcolx(i)*crscabsi2(12,indexint)+
+     $           no2colx(i)*crscabsi2(13,indexint)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c1_16(nz2-i+1,indexint)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,13,i) = aux1(nlayermx-i+1) 
+         enddo
+      
+         endif !Of chemthermod >= 2
+
+c**************************************************
+c      co2, 90.9-119.5nm
+c**************************************************
 
       limdown=1e-20
       limup=1e26
       do indexint=17,24
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i) + o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-c           print*,indexint,i,aux2(i),aux1(i),aux3(i),aux4(i)
-           jfotsout(indexint,1,i) = aux1(nz-i+1)
-           if(indexint.eq.24) then
-           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-             jfotsout(indexint,1,i) = aux1(nz-i+1)
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + n2colx(i) +
+     $           nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+            aux4(i) = c17_24(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+            if(indexint.eq.24) then
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
      $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
-           else 
-             jfotsout(indexint,1,i)=0.
-           end if
-           end if
-c           print*,indexint,i,(jfotsout(indexint,j,i),j=1,nabs)
-         enddo
-      end do
-
-
-c************************************************
-c     o2,90.9,119.5
-c************************************************
+               else 
+                  jfotsout(indexint,1,i)=0.
+               end if
+            end if
+         enddo
+      end do
+
+
+c**************************************************
+c     o2, 90.9-119.5nm
+c**************************************************
       
       do indexint=17,24
-         do i=1,nz
-            aux2(nz-i+1) = o2colx(i) + co2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,2,i) = aux1(nz-i+1)
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = o2colx(i) + co2colx(i) + n2colx(i) +
+     $           nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+            aux4(i) = c17_24(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
             if(indexint.eq.24) then
-           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-               jfotsout(indexint,2,i) = aux1(nz-i+1)
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
                else
@@ -361,23 +869,147 @@
 
 
-c************************************************
-c      co2,119.6,202.5
-c************************************************
-
-      do indexint=25,31
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i) + o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-               jfotsout(indexint,1,i) = aux1(nz-i+1)
-     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
-     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
+c**************************************************
+c     n2, 90.9-119.5nm
+c**************************************************
+     
+      do indexint=17,24
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = o2colx(i) + co2colx(i) + n2colx(i) +
+     $           nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,8,nz2-i+1)
+            aux4(i) = c17_24(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,8,i) = aux1(nlayermx-i+1)
+            if(indexint.eq.24) then
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,8,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,8,i)=0.
+               end if
+            end if
+         enddo
+      end do
+
+
+c**************************************************
+c     co, 90.9-119.5nm
+c**************************************************
+     
+      do indexint=17,24
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = o2colx(i) + co2colx(i) + n2colx(i) +
+     $           nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,11,nz2-i+1)
+            aux4(i) = c17_24(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,11,i) = aux1(nlayermx-i+1)
+            if(indexint.eq.24) then
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,11,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,11,i)=0.
+               end if
+            end if
+         enddo
+      end do
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     no, 90.9-119.5nm
+c**************************************************
+     
+         do indexint=17,24
+            do i=1,nlayermx
+               aux2(nlayermx-i+1) = o2colx(i) + co2colx(i) + n2colx(i) +
+     $              nocolx(i) + cocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+               aux4(i) = c17_24(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+               if(indexint.eq.24) then
+                  if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $                 .lt.60.) then
+                     jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+     $             *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+                  else
+                     jfotsout(indexint,10,i)=0.
+                  end if
+               end if
+            enddo
+         end do
+
+
+c**************************************************
+c     no2, 90.9-119.5nm
+c**************************************************
+     
+         do indexint=17,24
+            do i=1,nlayermx
+               aux2(nlayermx-i+1) = o2colx(i) + co2colx(i) + n2colx(i) +
+     $              nocolx(i) + cocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+               aux4(i) = c17_24(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+               if(indexint.eq.24) then
+                  if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $                 .lt.60.) then
+                     jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+     $              *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+                  else
+                     jfotsout(indexint,13,i)=0.
+                  end if
+               end if
+            enddo
+         end do
+
+         endif !Of chemthermod >= 2
+
+
+c**************************************************
+c      co2, 119.6-167.0nm
+c**************************************************
+
+      do indexint=25,29
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) + 
+     $           h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+            aux4(i) = c25_29(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+     $           *(1+alfa(indexint,i)*(t2(i)-t0(i)))               
             else
                jfotsout(indexint,1,i) = 0.
@@ -387,21 +1019,22 @@
 
 
-c************************************************
-c      o2,119.6,202.5
-c************************************************
-
-      do indexint=25,31
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i) + o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,2,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
+c**************************************************
+c      o2, 119.6-167.0nm
+c**************************************************
+
+      do indexint=25,29
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+            aux4(i) = c25_29(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-            jfotsout(indexint,2,i) = aux1(nz-i+1)
+            jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
             else
@@ -412,21 +1045,22 @@
 
 
-c************************************************
-c      h2o,119.6,202.5
-c************************************************
-
-      do indexint=25,31
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i) + o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,4,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
+c**************************************************
+c      h2o, 119.6-167.0nm
+c**************************************************
+
+      do indexint=25,29
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,4,nz2-i+1)
+            aux4(i) = c25_29(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-            jfotsout(indexint,4,i) = aux1(nz-i+1) 
+            jfotsout(indexint,4,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
             else
@@ -437,21 +1071,22 @@
 
 
-c************************************************
-c      h2o2,119.6,202.5
-c************************************************
-
-      do indexint=25,31
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i) + o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
-            aux4(i) = c12(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
+c**************************************************
+c      h2o2,119.6-167.0nm
+c**************************************************
+
+      do indexint=25,29
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+            aux4(i) = c25_29(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+            jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
             else
@@ -462,73 +1097,672 @@
 
 
-c************************************************
-c     co2,202.6,210.0
-c************************************************
-
-      indexint=32
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,1,nz2-i+1)
-            aux4(i) = c1(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
+c**************************************************
+c      co, 119.6-167.0nm
+c**************************************************
+
+      do indexint=25,29
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,11,nz2-i+1)
+            aux4(i) = c25_29(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-               jfotsout(indexint,1,i) = aux1(nz-i+1)
-     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))*
-     $           (1+alfa(indexint,i)*(t2(i)-t0(i)))
-            else
-               jfotsout(indexint,1,i)=0.
-            end if
-         enddo
-
-
-c************************************************
-c     h2o2,202.6,210.0
-c************************************************
-
-      indexint=32
-         do i=1,nz
-            aux2(nz-i+1) = co2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
-            aux4(i) = c1(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
-            jfotsout(indexint,6,i) = aux1(nz-i+1) 
+            jfotsout(indexint,11,i) = aux1(nlayermx-i+1)
      $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
             else
-               jfotsout(indexint,6,i)=0.
+               jfotsout(indexint,11,i) = 0.
             end if
          enddo
-
-
-c************************************************
-c     h2o2,210.1,337.5
-c************************************************
+      end do
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c      no, 119.6-167.0nm
+c**************************************************
+
+         do indexint=25,29
+            do i=1,nlayermx
+               aux2(nlayermx-i+1)=co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $              h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+               aux4(i) = c25_29(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $              .lt.60.) then
+                  jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+     $             *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,10,i) = 0.
+               end if
+            enddo
+         end do
+
+
+c**************************************************
+c      no2, 119.6-167.0nm
+c**************************************************
+
+         do indexint=25,29
+            do i=1,nlayermx
+               aux2(nlayermx-i+1)=co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $              h2o2colx(i) + nocolx(i) + cocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+               aux4(i) = c25_29(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $              .lt.60.) then
+                  jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+     $             *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,13,i) = 0.
+               end if
+            enddo
+         end do
+
+         endif !Of chemthermod >= 2
+
+
+c**************************************************
+c      co2, 167.0-202.5nm
+c**************************************************
+
+      do indexint=30,31
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) + 
+     $           h2o2colx(i) + nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+            aux4(i) = c30_31(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+          if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+               jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+     $           *(1+alfa(indexint,i)*(t2(i)-t0(i)))               
+            else
+               jfotsout(indexint,1,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c**************************************************
+c      o2, 167.0-202.5nm
+c**************************************************
+
+      do indexint=30,31
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+            aux4(i) = c30_31(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,2,i)=0.
+            end if
+         enddo
+      end do
+
+
+c**************************************************
+c      h2o, 167.0-202.5nm
+c**************************************************
+
+      do indexint=30,31
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,4,nz2-i+1)
+            aux4(i) = c30_31(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,4,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,4,i) = 0.
+            end if
+         enddo
+      end do
+
+
+c**************************************************
+c      h2o2, 167.0-202.5nm
+c**************************************************
+
+      do indexint=30,31
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $           h2o2colx(i) + nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+            aux4(i) = c30_31(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+           if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
+     $            *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,6,i) = 0.
+            end if
+         enddo
+      end do
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+      
+c**************************************************
+c      no, 167.0-202.5nm
+c**************************************************
+
+         do indexint=30,31
+            do i=1,nlayermx
+               aux2(nlayermx-i+1)=co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $              h2o2colx(i) + nocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+               aux4(i) = c30_31(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $              .lt.60.) then
+                  jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+     $              *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,10,i) = 0.
+               end if
+            enddo
+         end do
+
+
+c**************************************************
+c      no2, 167.0-202.5nm
+c**************************************************
+
+         do indexint=30,31
+            do i=1,nlayermx
+               aux2(nlayermx-i+1)=co2colx(i) + o2colx(i) + h2ocolx(i) +
+     $              h2o2colx(i) + nocolx(i) + no2colx(i)
+            end do
+            do i=1,nz2
+               aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+               aux4(i) = c30_31(nz2-i+1)
+            enddo
+            call interpfast 
+     $           (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+            do i=1,nlayermx
+               if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $              .lt.60.) then
+                  jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+     $              *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+               else
+                  jfotsout(indexint,13,i) = 0.
+               end if
+            enddo
+         end do
+         
+      endif !Of chemthermod >= 2
+
+c**************************************************
+c     co2, 202.6-210.0nm
+c**************************************************
+
+      indexint=32
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2o2colx(i) + 
+     $        nocolx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,1,nz2-i+1)
+         aux4(i) = c32(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,1,i) = aux1(nlayermx-i+1)
+     $           *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+     $           *(1+alfa(indexint,i)*(t2(i)-t0(i)))
+         else
+            jfotsout(indexint,1,i)=0.
+         end if
+      enddo
+
+
+c**************************************************
+c     o2, 202.6-210.0nm
+c**************************************************
+
+      indexint=32
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2o2colx(i) + 
+     $        nocolx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+         aux4(i) = c32(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
+     $           *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+         else
+            jfotsout(indexint,2,i)=0.
+         end if
+      enddo
+
+
+c**************************************************
+c     h2o2, 202.6-210.0nm
+c**************************************************
+
+      indexint=32
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2o2colx(i) + 
+     $        nocolx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+         aux4(i) = c32(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i).lt.60.) then
+            jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
+     $           *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+         else
+            jfotsout(indexint,6,i)=0.
+         end if
+      enddo
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.eq.2) then
+
+c**************************************************
+c     no, 202.6-210.0nm
+c**************************************************
+
+         indexint=32
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2o2colx(i) + 
+     $           nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,10,nz2-i+1)
+            aux4(i) = c32(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $           .lt.60.) then
+               jfotsout(indexint,10,i) = aux1(nlayermx-i+1)
+     $              *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,10,i)=0.
+            end if
+         enddo
+
+
+c**************************************************
+c     no2, 202.6-210.0nm
+c**************************************************
+
+         indexint=32
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = co2colx(i) + o2colx(i) + h2o2colx(i) + 
+     $           nocolx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c32(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            if(sigma(indexint,i)*alfa(indexint,i)*coltemp(i)
+     $           .lt.60.) then
+               jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+     $              *exp(-sigma(indexint,i)*alfa(indexint,i)*coltemp(i))
+            else
+               jfotsout(indexint,13,i)=0.
+            end if
+         enddo
+         
+      endif !Of chemthermod >= 2
+
+
+c**************************************************
+c     o2, 210.0-231.0nm
+c**************************************************
+
+      indexint=33
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = o2colx(i) + h2o2colx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+         aux4(i) = c33(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
+      enddo
+
+
+c**************************************************
+c     h2o2, 210.1-231.0nm
+c**************************************************
 
       indexint=33
       limdown=1.e-20
       limup=1e25
-         do i=1,nz
-            aux2(nz-i+1) = h2o2colx(i)
-         end do
-         do i=1,nz2
-            aux3(i) = jabsifotsint(indexint,6,nz2-i+1)
-            aux4(i) = ch2o2(nz2-i+1)
-         enddo
-         call interpfast 
-     $        ( aux1, aux2, nz,  aux3, aux4, nz2 , limdown , limup )
-         do i=1,nz
-            jfotsout(indexint,6,i) = aux1(nz-i+1)
-         enddo
-
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+         aux4(i) = c33(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
+      enddo
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     no2, 210.1-231.0nm
+c**************************************************
+
+         indexint=33
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c33(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod >= 2
+
+
+c**************************************************
+c     o2, 231.-240.nm
+c**************************************************
+
+      indexint=34
+      limdown=1.e-20
+      limup=1e25
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + o3colx(i) + 
+     $        no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,2,nz2-i+1)
+         aux4(i) = c34(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,2,i) = aux1(nlayermx-i+1)
+      enddo
+
+
+c**************************************************
+c     h2o2, 231.0-240.nm
+c**************************************************
+
+      indexint=34
+      limdown=1.e-20
+      limup=1e25
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + o3colx(i) + 
+     $        no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+         aux4(i) = c34(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
+      enddo
+
+
+      !Only if Ozone, Nitrogen or ionospheric chem. requested
+      if(chemthermod.ge.1) then
+
+c**************************************************
+c     o3, 231.0-240.nm
+c**************************************************
+
+         indexint=34
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + o3colx(i) + 
+     $           no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,7,nz2-i+1)
+            aux4(i) = c34(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,7,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod.ge.1
+
+
+      !Only if nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     no2, 231.0-240.nm
+c**************************************************
+
+         indexint=34
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = h2o2colx(i) + o2colx(i) + o3colx(i) + 
+     $           no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c34(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod >= 2
+
+
+c**************************************************
+c     h2o2, 240.0-337.7nm
+c**************************************************
+
+      indexint=35
+      limdown=1.e-20
+      limup=1e25
+      do i=1,nlayermx
+         aux2(nlayermx-i+1) = h2o2colx(i) + o3colx(i) + no2colx(i)
+      end do
+      do i=1,nz2
+         aux3(i) = jabsifotsintpar(indexint,6,nz2-i+1)
+         aux4(i) = c35(nz2-i+1)
+      enddo
+      call interpfast 
+     $     (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+      do i=1,nlayermx
+         jfotsout(indexint,6,i) = aux1(nlayermx-i+1)
+      enddo
+      
+
+      !Only if Ozone, Nitrogen or ionospheric chem. requested
+      if(chemthermod.ge.1) then
+
+c**************************************************
+c     o3, 240.0-337.7nm
+c**************************************************
+
+         indexint=35
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = h2o2colx(i) + o3colx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,7,nz2-i+1)
+            aux4(i) = c35(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,7,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod.ge.1
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     no2, 240.0-337.7nm
+c**************************************************
+
+         indexint=35
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = h2o2colx(i) + o3colx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c35(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod.ge.2
+
+
+      !Only if Ozone, Nitrogen or ionospheric chem. requested
+      if(chemthermod.ge.1) then
+
+c**************************************************
+c     o3, 337.7-800.0nm
+c**************************************************
+
+         indexint=36
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = o3colx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,7,nz2-i+1)
+            aux4(i) = c36(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,7,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif
+
+
+      !Only if Nitrogen or ionospheric chemistry requested
+      if(chemthermod.ge.2) then
+
+c**************************************************
+c     no2, 337.7-800.0nm
+c**************************************************
+
+         indexint=36
+         limdown=1.e-20
+         limup=1e25
+         do i=1,nlayermx
+            aux2(nlayermx-i+1) = o3colx(i) + no2colx(i)
+         end do
+         do i=1,nz2
+            aux3(i) = jabsifotsintpar(indexint,13,nz2-i+1)
+            aux4(i) = c36(nz2-i+1)
+         enddo
+         call interpfast 
+     $        (aux1,aux2,nlayermx,aux3,aux4,nz2,limdown,limup)
+         do i=1,nlayermx
+            jfotsout(indexint,13,i) = aux1(nlayermx-i+1)
+         enddo
+
+      endif !Of chemthermod.ge.2
       return
 
@@ -537,21 +1771,702 @@
 
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+c**********************************************************************
+c**********************************************************************
+
+      subroutine column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
+     $     co2colx,o2colx,o3pcolx,h2colx,h2ocolx,h2o2colx,o3colx,
+     $     n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)
+
+c     nov 2002        fgg           first version
+
+c**********************************************************************
+
+      implicit none
+
+
+c     common variables and constants
+      include "dimensions.h"
+      include "dimphys.h"
+      include "tracer.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'callkeys.h'
+
+
+
+c    local parameters and variables
+
+
+
+c     input and output variables
+
+      integer    ig
+      integer    chemthermod
+      integer    nesptherm                      !# of species undergoing chemistry, input
+      real       rm(nlayermx,nesptherm)         !densities (cm-3), input
+      real       tx(nlayermx)                   !temperature profile, input
+      real       iz(nlayermx+1)                 !height profile, input
+      real       zenit                          !SZA, input
+      real       co2colx(nlayermx)              !column density of CO2 (cm^-2), output
+      real       o2colx(nlayermx)               !column density of O2(cm^-2), output
+      real       o3pcolx(nlayermx)              !column density of O(3P)(cm^-2), output
+      real       h2colx(nlayermx)               !H2 column density (cm-2), output
+      real       h2ocolx(nlayermx)              !H2O column density (cm-2), output
+      real       h2o2colx(nlayermx)             !column density of H2O2(cm^-2), output
+      real       o3colx(nlayermx)               !O3 column density (cm-2), output
+      real       n2colx(nlayermx)               !N2 column density (cm-2), output
+      real       ncolx(nlayermx)                !N column density (cm-2), output
+      real       nocolx(nlayermx)               !NO column density (cm-2), output
+      real       cocolx(nlayermx)               !CO column density (cm-2), output
+      real       hcolx(nlayermx)                !H column density (cm-2), output
+      real       no2colx(nlayermx)              !NO2 column density (cm-2), output
+      
+
+c     local variables
+
+      real       xx
+      real       grav(nlayermx)
+      real       Hco2,Ho3p,Ho2,Hh2,Hh2o,Hh2o2
+      real       Ho3,Hn2,Hn,Hno,Hco,Hh,Hno2
+
+      real       co2x(nlayermx)
+      real       o2x(nlayermx)
+      real       o3px(nlayermx)
+      real       cox(nlayermx)
+      real       hx(nlayermx)
+      real       h2x(nlayermx)
+      real       h2ox(nlayermx)
+      real       h2o2x(nlayermx)
+      real       o3x(nlayermx)
+      real       n2x(nlayermx)
+      real       nx(nlayermx)
+      real       nox(nlayermx)
+      real       no2x(nlayermx)
+
+      integer    i,j,k,icol,indexint          !indexes
+
+c     variables for optical path calculation
+
+      integer    nz3
+!      parameter  (nz3=nz*2)
+
+      integer    jj
+      real*8      esp(nlayermx*2)
+      real*8      ilayesp(nlayermx*2)
+      real*8      szalayesp(nlayermx*2)
+      integer     nlayesp
+      real*8      zmini
+      real*8      depth
+      real*8      espco2, espo2, espo3p, esph2, esph2o, esph2o2,espo3
+      real*8      espn2,espn,espno,espco,esph,espno2
+      real*8      rcmnz, rcmmini
+      real*8      szadeg
+
+
+      ! Tracer indexes in the thermospheric chemistry:
+      !!! ATTENTION. These values have to be identical to those in chemthermos.F90
+      !!! If the values are changed there, the same has to be done here  !!!
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o3=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_n=14
+      integer,parameter :: i_no=15
+      integer,parameter :: i_no2=17
+
+
+c*************************PROGRAM STARTS*******************************
+
+      nz3 = nlayermx*2
+      szadeg = zenit*180./3.141592
+      do i=1,nlayermx
+         xx = ( radio + iz(i) ) * 1.e5
+         grav(i) = gg * masa /(xx**2)
+      end do
+
+      !Scale heights
+      xx = kboltzman * tx(nlayermx) * n_avog / grav(nlayermx)
+      Ho3p  = xx / mmol(igcm_o) 
+      Hco2  = xx / mmol(igcm_co2)
+      Ho2   = xx / mmol(igcm_o2)
+      Hh2   = xx / mmol(igcm_h2)
+      Hh2o  = xx / mmol(igcm_h2o_vap)
+      Hh2o2 = xx / mmol(igcm_h2o2)
+      Hco   = xx / mmol(igcm_co)
+      Hh    = xx / mmol(igcm_h)
+      !Only if O3 chem. required
+      if(chemthermod.ge.1) 
+     $     Ho3   = xx / mmol(igcm_o3)
+      !Only if N or ion chem.
+      if(chemthermod.ge.2) then
+         Hn2   = xx / mmol(igcm_n2)
+         Hn    = xx / mmol(igcm_n)
+         Hno   = xx / mmol(igcm_no)
+         Hno2  = xx / mmol(igcm_no2)
+      endif
+      do i=nlayermx,1,-1
+         !Column initialisation
+         co2colx(i)  = 0.
+         o2colx(i)   = 0.
+         o3pcolx(i)  = 0.
+         h2colx(i)   = 0.
+         h2ocolx(i)  = 0.
+         h2o2colx(i) = 0.
+         o3colx(i)   = 0.
+         n2colx(i)   = 0.
+         ncolx(i)    = 0.
+         nocolx(i)   = 0.
+         cocolx(i)   = 0.
+         hcolx(i)    = 0.
+         no2colx(i)  = 0.
+         !Densities
+         co2x(i)  = rm(i,i_co2)
+         o2x(i)   = rm(i,i_o2)
+         o3px(i)  = rm(i,i_o)
+         h2x(i)   = rm(i,i_h2)
+         h2ox(i)  = rm(i,i_h2o)
+         h2o2x(i) = rm(i,i_h2o2)
+         cox(i)   = rm(i,i_co)
+         hx(i)    = rm(i,i_h)
+         !Only if O3 chem. required
+         if(chemthermod.ge.1) 
+     $        o3x(i)   = rm(i,i_o3)
+         !Only if Nitrogen of ion chemistry requested
+         if(chemthermod.ge.2) then
+            n2x(i)   = rm(i,i_n2)
+            nx(i)    = rm(i,i_n)
+            nox(i)   = rm(i,i_no)
+            no2x(i)  = rm(i,i_no2)
+         endif
+         !Routine to calculate the geometrical length of each layer
+         call espesor_optico_A(ig,i,zenit,iz(i),nz3,iz,esp,ilayesp,
+     $         szalayesp,nlayesp, zmini)
+         if(ilayesp(nlayesp).eq.-1) then
+            co2colx(i)=1.e25
+            o2colx(i)=1.e25
+            o3pcolx(i)=1.e25
+            h2colx(i)=1.e25
+            h2ocolx(i)=1.e25
+            h2o2colx(i)=1.e25
+            o3colx(i)=1.e25
+            n2colx(i)=1.e25
+            ncolx(i)=1.e25
+            nocolx(i)=1.e25
+            cocolx(i)=1.e25
+            hcolx(i)=1.e25
+            no2colx(i)=1.e25
+         else
+            rcmnz = ( radio + iz(nlayermx) ) * 1.e5
+            rcmmini = ( radio + zmini ) * 1.e5
+            !Column calculation taking into account the geometrical depth 
+            !calculated before
+            do j=1,nlayesp
+               jj=ilayesp(j)
+               !Top layer
+               if(jj.eq.nlayermx) then
+                  if(szadeg.le.60.) then 
+                     o3pcolx(i)=o3pcolx(i)+o3px(nlayermx)*Ho3p*esp(j)
+     $                    *1.e-5
+                     co2colx(i)=co2colx(i)+co2x(nlayermx)*Hco2*esp(j)
+     $                    *1.e-5
+                     h2o2colx(i)=h2o2colx(i)+
+     $                    h2o2x(nlayermx)*Hh2o2*esp(j)*1.e-5
+                     o2colx(i)=o2colx(i)+o2x(nlayermx)*Ho2*esp(j)
+     $                    *1.e-5
+                     h2colx(i)=h2colx(i)+h2x(nlayermx)*Hh2*esp(j)
+     $                    *1.e-5
+                     h2ocolx(i)=h2ocolx(i)+h2ox(nlayermx)*Hh2o*esp(j)
+     $                    *1.e-5                     
+                     cocolx(i)=cocolx(i)+cox(nlayermx)*Hco*esp(j)
+     $                    *1.e-5
+                     hcolx(i)=hcolx(i)+hx(nlayermx)*Hh*esp(j)
+     $                    *1.e-5
+                     !Only if O3 chemistry required
+                     if(chemthermod.ge.1) o3colx(i)=
+     $                    o3colx(i)+o3x(nlayermx)*Ho3*esp(j)
+     $                    *1.e-5
+                     !Only if N or ion chemistry requested
+                     if(chemthermod.ge.2) then
+                        n2colx(i)=n2colx(i)+n2x(nlayermx)*Hn2*esp(j)
+     $                    *1.e-5
+                        ncolx(i)=ncolx(i)+nx(nlayermx)*Hn*esp(j)
+     $                       *1.e-5
+                        nocolx(i)=nocolx(i)+nox(nlayermx)*Hno*esp(j)
+     $                       *1.e-5
+                        no2colx(i)=no2colx(i)+no2x(nlayermx)*Hno2*esp(j)
+     $                       *1.e-5
+                     endif
+                  else if(szadeg.gt.60.) then
+                     espco2 =sqrt((rcmnz+Hco2)**2 -rcmmini**2) - esp(j)
+                     espo2  = sqrt((rcmnz+Ho2)**2 -rcmmini**2) - esp(j)
+                     espo3p = sqrt((rcmnz+Ho3p)**2 -rcmmini**2)- esp(j)
+                     esph2  = sqrt((rcmnz+Hh2)**2 -rcmmini**2) - esp(j)
+                     esph2o = sqrt((rcmnz+Hh2o)**2 -rcmmini**2)- esp(j)
+                     esph2o2= sqrt((rcmnz+Hh2o2)**2-rcmmini**2)- esp(j)
+                     espco  = sqrt((rcmnz+Hco)**2 -rcmmini**2) - esp(j)
+                     esph   = sqrt((rcmnz+Hh)**2 -rcmmini**2)  - esp(j)
+                     !Only if O3 chemistry required
+                     if(chemthermod.ge.1)                     
+     $                   espo3=sqrt((rcmnz+Ho3)**2-rcmmini**2)-esp(j)
+                     !Only if N or ion chemistry requested
+                     if(chemthermod.ge.2) then
+                        espn2 =sqrt((rcmnz+Hn2)**2-rcmmini**2)-esp(j)
+                        espn  =sqrt((rcmnz+Hn)**2-rcmmini**2)  - esp(j)
+                        espno =sqrt((rcmnz+Hno)**2-rcmmini**2) - esp(j)
+                        espno2=sqrt((rcmnz+Hno2)**2-rcmmini**2)- esp(j)
+                     endif
+                     co2colx(i) = co2colx(i) + espco2*co2x(nlayermx)
+                     o2colx(i)  = o2colx(i)  + espo2*o2x(nlayermx)
+                     o3pcolx(i) = o3pcolx(i) + espo3p*o3px(nlayermx)
+                     h2colx(i)  = h2colx(i)  + esph2*h2x(nlayermx)
+                     h2ocolx(i) = h2ocolx(i) + esph2o*h2ox(nlayermx)
+                     h2o2colx(i)= h2o2colx(i)+ esph2o2*h2o2x(nlayermx)
+                     cocolx(i)  = cocolx(i)  + espco*cox(nlayermx)
+                     hcolx(i)   = hcolx(i)   + esph*hx(nlayermx)
+                     !Only if O3 chemistry required
+                     if(chemthermod.ge.1)                      
+     $                  o3colx(i) = o3colx(i)  + espo3*o3x(nlayermx)
+                     !Only if N or ion chemistry requested
+                     if(chemthermod.ge.2) then
+                        n2colx(i)  = n2colx(i)  + espn2*n2x(nlayermx)
+                        ncolx(i)   = ncolx(i)   + espn*nx(nlayermx)
+                        nocolx(i)  = nocolx(i)  + espno*nox(nlayermx)
+                        no2colx(i) = no2colx(i) + espno2*no2x(nlayermx)
+                     endif
+                  endif !Of if szadeg.lt.60
+               !Other layers
+               else 
+                  co2colx(i)  = co2colx(i) + 
+     $                 esp(j) * (co2x(jj)+co2x(jj+1)) / 2.
+                  o2colx(i)   = o2colx(i) + 
+     $                 esp(j) * (o2x(jj)+o2x(jj+1)) / 2.
+                  o3pcolx(i)  = o3pcolx(i) + 
+     $                 esp(j) * (o3px(jj)+o3px(jj+1)) / 2.
+                  h2colx(i)   = h2colx(i) + 
+     $                 esp(j) * (h2x(jj)+h2x(jj+1)) / 2.
+                  h2ocolx(i)  = h2ocolx(i) + 
+     $                 esp(j) * (h2ox(jj)+h2ox(jj+1)) / 2.
+                  h2o2colx(i) = h2o2colx(i) + 
+     $                 esp(j) * (h2o2x(jj)+h2o2x(jj+1)) / 2.
+                  cocolx(i)   = cocolx(i) + 
+     $                 esp(j) * (cox(jj)+cox(jj+1)) / 2.
+                  hcolx(i)    = hcolx(i) + 
+     $                 esp(j) * (hx(jj)+hx(jj+1)) / 2.
+                  !Only if O3 chemistry required
+                  if(chemthermod.ge.1) 
+     $                 o3colx(i) = o3colx(i) + 
+     $                 esp(j) * (o3x(jj)+o3x(jj+1)) / 2.
+                  !Only if N or ion chemistry requested
+                  if(chemthermod.ge.2) then
+                     n2colx(i)   = n2colx(i) + 
+     $                 esp(j) * (n2x(jj)+n2x(jj+1)) / 2.
+                     ncolx(i)    = ncolx(i) + 
+     $                    esp(j) * (nx(jj)+nx(jj+1)) / 2.
+                     nocolx(i)   = nocolx(i) + 
+     $                    esp(j) * (nox(jj)+nox(jj+1)) / 2.
+                     no2colx(i)  = no2colx(i) + 
+     $                    esp(j) * (no2x(jj)+no2x(jj+1)) / 2.
+                  endif
+               endif  !Of if jj.eq.nlayermx
+            end do    !Of do j=1,nlayesp
+         endif        !Of ilayesp(nlayesp).eq.-1
+      enddo           !Of do i=nlayermx,1,-1
+      return
+
+
+      end
+
+
+c**********************************************************************
+c**********************************************************************
+      subroutine interpfast(escout,p,nlayer,escin,pin,nl,limdown,limup)
+C
+C subroutine to perform linear interpolation in pressure from 1D profile 
+C escin(nl) sampled on pressure grid pin(nl) to profile
+C escout(nlayer) on pressure grid p(nlayer).
+C
+      real escout(nlayer),p(nlayer)
+      real escin(nl),pin(nl),wm,wp
+      real limup,limdown
+      integer nl,nlayer,n1,n,nm,np
+      nm=1
+      do 5 n1=1,nlayer
+         if(p(n1) .gt. limup .or. p(n1) .lt. limdown) then
+            escout(n1) = 0.0
+         else
+            do n = nm,nl-1
+               if (p(n1).ge.pin(n).and.p(n1).le.pin(n+1)) then
+                  nm=n
+                  np=n+1
+                  wm=abs(pin(nm)-p(n1))/(pin(np)-pin(nm))
+                  wp=1.0 - wm
+                  goto 33
+               endif
+            enddo
+ 33         escout(n1) = escin(np)*wm + escin(nm)*wp
+         endif
+    5 continue
+      return
+      end
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine espesor_optico_A (ig,capa, szadeg,z,
+     @                   nz3,iz,esp,ilayesp,szalayesp,nlayesp, zmini)
+
+c     fgg              nov 03      Adaptation to Martian model
+c     malv             jul 03      Corrected z grid. Split in alt & frec codes
+c     fgg              feb 03      first version
+*************************************************************************
+
+      implicit none
+
+
+c     common variables and constants
+
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+
+c     arguments
+
+      real        szadeg                ! I. SZA [rad]
+      real        z                     ! I. altitude of interest [km]
+      integer     nz3,ig                   ! I. dimension of esp, ylayesp, etc...
+                                        !  (=2*nlayermx= max# of layers in ray path)
+      real     iz(nlayermx+1)              ! I. Altitude of each layer
+      real*8        esp(nz3)            ! O. layer widths after geometrically 
+                                        !    amplified; in [cm] except at TOA
+                                        !    where an auxiliary value is used
+      real*8        ilayesp(nz3)        ! O. Indexes of layers along ray path
+      real*8        szalayesp(nz3)      ! O. SZA [deg]    "     "       "
+      integer       nlayesp
+!      real*8        nlayesp             ! O. # layers along ray path at this z
+      real*8        zmini               ! O. Minimum altitud of ray path [km]
+
+
+c     local variables and constants
+
+        integer     j,i,capa
+        integer     jmin                  ! index of min.altitude along ray path
+        real*8      szarad                ! SZA [deg]
+        real*8      zz
+        real*8      diz(nlayermx+1)
+        real*8      rkmnz                 ! distance TOA to center of Planet [km]
+        real*8      rkmmini               ! distance zmini to center of P [km] 
+        real*8      rkmj                  ! intermediate distance to C of P [km]
+
+c external function
+        external  grid_R8          ! Returns index of layer containing the altitude
+                                ! of interest, z; for example, if 
+                                ! zkm(i)=z or zkm(i)<z<zkm(i+1) => grid(z)=i 
+        integer   grid_R8
+
+*************************************************************************     
+        szarad = dble(szadeg)*3.141592d0/180.d0
+        zz=dble(z)
+        do i=1,nlayermx
+           diz(i)=dble(iz(i))
+        enddo
+        do j=1,nz3 
+          esp(j) = 0.d0
+          szalayesp(j) = 777.d0
+          ilayesp(j) = 0
+        enddo
+        nlayesp = 0
+
+        ! First case: szadeg<60
+        ! The optical thickness will be given by  1/cos(sza)
+        ! We deal with 2 different regions:
+        !   1: First, all layers between z and ztop ("upper part of ray")
+        !   2: Second, the layer at ztop
+        if(szadeg.lt.60.d0) then
+
+           zmini = zz
+           if(abs(zz-diz(nlayermx)).lt.1.d-3) goto 1357
+           ! 1st Zone: Upper part of ray
+           !
+           do j=grid_R8(zz,diz,nlayermx),nlayermx-1
+             nlayesp = nlayesp + 1 
+             ilayesp(nlayesp) = j
+             esp(nlayesp) = (diz(j+1)-diz(j)) / cos(szarad)        ! [km]
+             esp(nlayesp) = esp(nlayesp) * 1.d5                    ! [cm]
+             szalayesp(nlayesp) = szadeg
+           end do
+
+           ! 
+           ! 2nd Zone: Top layer
+ 1357      continue
+           nlayesp = nlayesp + 1 
+           ilayesp(nlayesp) = nlayermx
+           esp(nlayesp) = 1.d0 / cos(szarad)         ! aux. non-dimens. factor
+           szalayesp(nlayesp) = szadeg
+
+
+        ! Second case:  60 < szadeg < 90
+        ! The optical thickness is evaluated.
+        !    (the magnitude of the effect of not using cos(sza) is 3.e-5 
+        !     for z=60km & sza=30, and 5e-4 for z=60km & sza=60, approximately)
+        ! We deal with 2 different regions:
+        !   1: First, all layers between z and ztop ("upper part of ray")
+        !   2: Second, the layer at ztop ("uppermost layer")
+        else if(szadeg.le.90.d0.and.szadeg.ge.60.d0) then
+
+           zmini=(radio+zz)*sin(szarad)-radio
+           rkmmini = radio + zmini
+
+           if(abs(zz-diz(nlayermx)).lt.1.d-4) goto 1470
+
+           ! 1st Zone: Upper part of ray
+           !
+           do j=grid_R8(zz,diz,nlayermx),nlayermx-1
+              nlayesp = nlayesp + 1 
+              ilayesp(nlayesp) = j
+              esp(nlayesp) = 
+     #             sqrt( (radio+diz(j+1))**2 - rkmmini**2 ) -
+     #             sqrt( (radio+diz(j))**2 - rkmmini**2 )           ! [km]
+              esp(nlayesp) = esp(nlayesp) * 1.d5                    ! [cm]
+              rkmj = radio+diz(j)
+              szalayesp(nlayesp) = asin( rkmmini/rkmj )             ! [rad]
+              szalayesp(nlayesp) = szalayesp(nlayesp) * 180.d0/3.141592 ! [deg]
+           end do
+ 1470      continue
+           ! 2nd Zone:  Uppermost layer of ray.
+           !
+           nlayesp = nlayesp + 1 
+           ilayesp(nlayesp) = nlayermx
+           rkmnz = radio+diz(nlayermx)
+           esp(nlayesp)  =  sqrt( rkmnz**2 - rkmmini**2 )       ! aux.factor[km]
+           esp(nlayesp)  =  esp(nlayesp) * 1.d5                 ! aux.f. [cm]
+           szalayesp(nlayesp) = asin( rkmmini/rkmnz )           ! [rad]
+           szalayesp(nlayesp) = szalayesp(nlayesp) * 180.d0/3.141592! [deg]
+
+
+        ! Third case:  szadeg > 90
+        ! The optical thickness is evaluated.
+        ! We deal with 5 different regions:
+        !   1: all layers between z and ztop ("upper part of ray")
+        !   2: the layer at ztop ("uppermost layer")
+        !   3: the lowest layer, at zmini
+        !   4: the layers increasing from zmini to z (here SZA<90)
+        !   5: the layers decreasing from z to zmini (here SZA>90)
+        else if(szadeg.gt.90.d0) then
+
+           zmini=(radio+zz)*sin(szarad)-radio
+           rkmmini = radio + zmini
+
+           if(zmini.lt.diz(1)) then         ! Can see the sun?  No => esp(j)=inft
+             nlayesp = nlayesp + 1 
+             ilayesp(nlayesp) = - 1     ! Value to mark "no sun on view"
+!             esp(nlayesp) = 1.e30
+
+           else
+              jmin=grid_R8(zmini,diz,nlayermx)+1
+              
+
+              if(abs(zz-diz(nlayermx)).lt.1.d-4) goto 9876
+
+              ! 1st Zone: Upper part of ray
+              !
+              do j=grid_R8(zz,diz,nlayermx),nlayermx-1
+                nlayesp = nlayesp + 1 
+                ilayesp(nlayesp) = j
+                esp(nlayesp) = 
+     $                sqrt( (radio+diz(j+1))**2 - rkmmini**2 ) -
+     $                sqrt( (radio+diz(j))**2 - rkmmini**2 )          ! [km]
+                esp(nlayesp) = esp(nlayesp) * 1.d5                    ! [cm]
+                rkmj = radio+diz(j)
+                szalayesp(nlayesp) = asin( rkmmini/rkmj )              ! [rad]
+                szalayesp(nlayesp) = szalayesp(nlayesp) *180.d0/3.141592      ! [deg]
+              end do
+
+ 9876         continue
+              ! 2nd Zone:  Uppermost layer of ray.
+              !
+              nlayesp = nlayesp + 1 
+              ilayesp(nlayesp) = nlayermx
+              rkmnz = radio+diz(nlayermx)
+              esp(nlayesp) =  sqrt( rkmnz**2 - rkmmini**2 )      !aux.factor[km]
+              esp(nlayesp) = esp(nlayesp) * 1.d5                 !aux.f.[cm]
+              szalayesp(nlayesp) = asin( rkmmini/rkmnz )           ! [rad]
+              szalayesp(nlayesp) = szalayesp(nlayesp) *180.d0/3.141592 ! [deg]
+
+              ! 3er Zone: Lowestmost layer of ray
+              !
+              if ( jmin .ge. 2 ) then      ! If above the planet's surface
+                j=jmin-1
+                nlayesp = nlayesp + 1 
+                ilayesp(nlayesp) = j
+                esp(nlayesp) = 2. * 
+     $                 sqrt( (radio+diz(j+1))**2 -rkmmini**2 )       ! [km]
+                esp(nlayesp) = esp(nlayesp) * 1.d5                   ! [cm]
+                rkmj = radio+diz(j+1)
+                szalayesp(nlayesp) = asin( rkmmini/rkmj ) ! [rad]
+                szalayesp(nlayesp) = szalayesp(nlayesp) *180.d0/3.141592 ! [deg]
+              endif
+
+              ! 4th zone: Lower part of ray, increasing from zmin to z
+              !    ( layers with SZA < 90 deg )
+              do j=jmin,grid_R8(zz,diz,nlayermx)-1
+                nlayesp = nlayesp + 1 
+                ilayesp(nlayesp) = j
+                esp(nlayesp) = 
+     $                    sqrt( (radio+diz(j+1))**2 - rkmmini**2 )
+     $                  - sqrt( (radio+diz(j))**2 - rkmmini**2 )       ! [km]
+                esp(nlayesp) = esp(nlayesp) * 1.d5                     ! [cm]
+                rkmj = radio+diz(j)
+                szalayesp(nlayesp) = asin( rkmmini/rkmj )              ! [rad]
+                szalayesp(nlayesp) = szalayesp(nlayesp) *180.d0/3.141592 ! [deg]
+              end do
+
+              ! 5th zone: Lower part of ray, decreasing from z to zmin
+              !    ( layers with SZA > 90 deg )
+              do j=grid_R8(zz,diz,nlayermx)-1, jmin, -1
+                nlayesp = nlayesp + 1 
+                ilayesp(nlayesp) = j
+                esp(nlayesp) = 
+     $                    sqrt( (radio+diz(j+1))**2 - rkmmini**2 )
+     $                  - sqrt( (radio+diz(j))**2 - rkmmini**2 )        ! [km]
+                esp(nlayesp) = esp(nlayesp) * 1.d5                      ! [cm]
+                rkmj = radio+diz(j)
+                szalayesp(nlayesp) = 3.141592 - asin( rkmmini/rkmj )          ! [rad]
+                szalayesp(nlayesp) = szalayesp(nlayesp)*180.d0/3.141592 ! [deg]
+              end do
+
+           end if
+
+        end if
+
+        return
+
+        end
+
+
+
+c**********************************************************************
+c***********************************************************************
+
+        function grid_R8 (z, zgrid, nz)
+
+c Returns the index where z is located within vector zgrid
+c The vector zgrid must be monotonously increasing, otherwise program stops.
+c If z is outside zgrid limits, or zgrid dimension is nz<2, the program stops. 
+c
+c FGG     Aug-2004     Correct z.lt.zgrid(i) to .le. 
+c MALV    Jul-2003
+c***********************************************************************
+
+        implicit none
+
+c Arguments 
+        integer   nz
+        real*8      z
+        real*8      zgrid(nz)
+        integer   grid_R8
+
+c Local  
+        integer   i, nz1, nznew
+
+c*** CODE START 
+
+        if ( z .lt. zgrid(1) .or. z.gt.zgrid(nz) ) then 
+           write (*,*) ' GRID/ z outside bounds of zgrid '
+           write (*,*) ' z,zgrid(1),zgrid(nz) =', z,zgrid(1),zgrid(nz)
+           stop ' Serious error in GRID.F '
+        endif
+        if ( nz .lt. 2 ) then 
+           write (*,*) ' GRID/ zgrid needs 2 points at least ! '
+           stop ' Serious error in GRID.F '
+        endif
+        if ( zgrid(1) .ge. zgrid(nz) ) then 
+           write (*,*) ' GRID/ zgrid must increase with index'
+           stop ' Serious error in GRID.F '
+        endif
+
+        nz1 = 1
+        nznew = nz/2
+        if ( z .gt. zgrid(nznew) ) then
+           nz1 = nznew
+           nznew = nz
+        endif
+        do i=nz1+1,nznew
+           if ( z. eq. zgrid(i) ) then
+              grid_R8=i
+              return
+              elseif ( z .le. zgrid(i) ) then
+              grid_R8 = i-1
+              return
+           endif
+        enddo
+        grid_R8 = nz
+        return
+
+
+
+        end
+
+
+
+!c***************************************************
+!c***************************************************
+
+      subroutine flujo(date)
+
+
+!c     fgg           nov 2002     first version
+!c***************************************************
+
+      implicit none
+
+
+!     common variables and constants
+      include "dimensions.h"
+      include "dimphys.h"
+      include "comsaison.h"
+      include 'param.h'
+      include 'param_v4.h'
+
+
+!     Arguments
+
+      real date
+
+
+!     Local variable and constants
+
+      integer i
+      integer inter
+      real    nada
+
+!c*************************************************
+
+      if(date.lt.1985.) date=1985.
+      if(date.gt.2001.) date=2001.
+      
+      do i=1,ninter
+         fluxtop(i)=1.
+         !Variation of solar flux with 11 years solar cycle
+         !For more details, see Gonzalez-Galindo et al. 2005
+         !To be improved in next versions
+        if(i.le.24) then
+          fluxtop(i)=(((ct1(i)+p1(i)*date)/2.)                  
+     $        *sin(2.*3.1416/11.*(date-1985.-3.1416))          
+     $        +(ct2(i)+p2(i)*date)+1.)*fluxtop(i)
+        end if
+        fluxtop(i)=fluxtop(i)*(1.52/dist_sol)**2
+      end do
+!      fluxtop(1)=fluxtop(1)*10.
+!      fluxtop(2)=fluxtop(2)*5.
+     
+      return
+      end
Index: trunk/LMDZ.MARS/libf/aeronomars/param.h
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/param.h	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/param.h	(revision 635)
@@ -1,17 +1,17 @@
-c***********************************************
+!***********************************************
 
-c	param.par
+!	param.par
 
-c	Parameters for paramhr.f
-c***********************************************
+!	Parameters for paramhr.f
+!***********************************************
 
 	integer    ninter
-	parameter  (ninter=33)
+	parameter  (ninter=36)
 
 	integer    nabs
-	parameter  (nabs=6)
+	parameter  (nabs=13)
 
 	integer    nz2
-	parameter  (nz2=203)
+	parameter  (nz2=253)
 
 	integer    ninter2
@@ -33,30 +33,8 @@
 	parameter  (radio = 3390.)           !radio de Marte(km)
 
-	real       pmco2
-	parameter  (pmco2 = 44.)
-
-	real       pmo3p
-	parameter  (pmo3p = 16.)
-
-	real       pmo2
-	parameter  (pmo2 = 32.)
-
-	real       pmh2o2
-	parameter  (pmh2o2 = 36.)
-
-	real       cpco2
-	parameter  (cpco2=20.0e6)
-
-	real       cpo2
-	parameter  (cpo2=0.9194e7)
-
-	real       cpo3p
-	parameter  (cpo3p=1.30e7)
-
 	integer	   nreact
-	parameter  (nreact=22)
-
-	integer    nzmax
-	parameter  (nzmax=210)
+	parameter  (nreact=93)
 
 
+
+
Index: trunk/LMDZ.MARS/libf/aeronomars/param_read.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/param_read.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/param_read.F	(revision 635)
@@ -5,65 +5,96 @@
 
 c     common variables and constants
-
-#include "param.h"
-#include "param_v3.h"
-#include "datafile.h"
-
-
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'datafile.h'
+ 
+ 
 c     local variables
 
       integer    i,j,k,inter                          !indexes
-      integer ierr 
+      integer ierr,lnblnk 
       real       nada
-      logical,save :: firstcall=.true.
-
-     
+  
+      
 c*************************+PROGRAM STARTS**************************
 
 
-c     data
-      if (firstcall) then
-      anchint(:)=(/4.9,5.3,6.1,12.8,2.0,6.9,11.8,0.4,1.9,4.9,0.9,4.0,
-     $6.9,4.9,4.9,10.2,5.6,1.9,0.9,0.9,0.9,0.9,3.7
-     $,13.1,3.9,6.0,4.8,23.9,8.4,8.5,26.8,7.5,127.6/)
-
-      crscabsi2(1,1:ninter2)=(/0.0,4.42e-18,7.51e-18
-     $,1.498e-17,2.344e-17,2.388e-17,2.927E-17,3.161e-17,3.161e-17,
-     $3.4e-17,3.4e-17,2.588e-17,2.596e-17,2.248e-17,3.183e-17,
-     $1.284e-17/)
-
-      crscabsi2(2,1:ninter2)=(/2.736e-19,1.055e-18,4.789e-18
-     $,1.063e-17,1.559e-17,1.698e-17,2.164e-17,2.241e-17,2.427e-17,
-     $2.444e-17,2.502e-17,2.516e-17,2.907e-17,3.649e-17,3.066e-17,
-     $2.093e-17/)
-
-      crscabsi2(3,1:ninter2)=(/2.603e-19,6.985e-19,3.97e-18
-     $,6.621e-18,8.433e-18,9.011e-18,9.862e-18,1.033e-17,1.012e-17,
-     $1.033e-17,1.033e-17,1.034e-17,9.0e-18,3.564e-18,3.572e-18
-     $,3.47E-18/)
-
-      freccen(:)=(/3.4,7.5,14.5,23.0,30.3,34.1,49.6,50.5,52.5,56.0,
+c     data for the UV heating tabulation
+
+      data (crscabsi2(1,j),j=1,16) /5.61031E-19,1.59677E-18,4.7072E-18,
+     $     1.48254e-17,2.07445e-17,2.573e-17,2.901e-17,3.083e-17,
+     $     3.217e-17,3.539e-17,3.658e-17,3.63e-17,3.41239e-17,
+     $     2.71019e-17,4.93677e-17,1.64e-17/
+
+      data (crscabsi2(2,j),j=1,16) /0.27250E-18,0.11650E-17,0.39250E-17,
+     $     0.10630E-16,0.15590E-16,0.17180E-16,0.19270E-16,0.22860E-16,
+     $     0.24270E-16,0.24440E-16,0.25020E-16,0.26600E-16,0.25400E-16,
+     $     0.35800E-16,0.25590E-16,0.16740E-16/
+
+      data (crscabsi2(3,j),j=1,16) /0.2776E-18,0.9792E-18,0.3313E-17,
+     $     0.6621E-17,0.8481E-17,0.9146E-17,0.9414E-17,0.1039E-16,
+     $     0.1012E-16,0.1033E-16,0.1033E-16,0.1033E-16,0.8268E-17,
+     $     0.6563E-17,0.3506E-17,0.3470E-17/
+
+      data (crscabsi2(5,j),j=1,16) /.5E-20,.1077607E-19,.5670491E-19,
+     $     .3322716E-18,.1054509E-17,.1700005E-17,.3171188E-17,
+     $     .4734241E-17,.5108741E-17,.6022236E-17,.6741537E-17,
+     $     .7277079E-17,.9070787E-17,.9708916E-17,.4026281E-17,0.0/
+
+      data (crscabsi2(8,j),j=1,16) /0.0, 7.44175e-19, 2.23167e-18,
+     $    8.46200e-18,1.18275e-17,1.54900e-17,2.32475e-17,2.41373e-17,
+     $     2.55482e-17,2.38431e-17,2.28600e-17,2.35067e-17,2.56000e-17,
+     $     2.64636e-17,2.86260e-17,3.26561e-17/
+
+      data(crscabsi2(9,j),j=1,16) /3.48182e-20,3.37038e-19,1.03077e-18,
+     $     4.01364e-18,6.45e-18,7.8e-18,1.0e-17,1.13500e-17,1.15500e-17,
+     $     1.18000e-17,1.17500e-17,1.16000e-17,1.28667e-17,1.18500e-17,
+     $     1.11000e-17,9.50000e-18/
+
+      data(crscabsi2(10,j),j=1,16) /0.0,9.39833e-19,2.87714e-18,
+     $     9.66900e-18,1.37063e-17,1.61820e-17,2.30450e-17,2.63373e-17,
+     $     2.63773e-17,2.67677e-17,2.64100e-17,2.53000e-17,2.18100e-17,
+     $     2.04941e-17,2.28160e-17,2.93550e-17/
+
+      data(crscabsi2(11,j),j=1,16) /0.0,9.58555e-19,2.52767e-18,
+     $     8.29700e-18,1.21850e-17,1.40500e-17,1.97025e-17,2.12018e-17,
+     $     2.14673e-17,2.20331e-17,2.21500e-17,2.21600e-17,2.33200e-17,
+     $     2.67800e-17,2.56400e-17,3.58561e-17/
+
+      data(crscabsi2(12,j),j=1,16) /0.0,1.0e-20,2.5e-20,1.30400e-19,
+     $     2.93800e-19,4.36000e-19,8.49400e-19,1.29400e-18,1.40500e-18,
+     $     1.67600e-18,1.93400e-18,2.12200e-18,2.75800e-18,3.48400e-18,
+     $     4.17200e-18,5.26000e-18/
+
+      data(crscabsi2(13,j),j=1,16) /0.0,1.60e-18,4.99111e-18,1.48496e-17
+     $     ,2.17395e-17,2.55857e-17,2.87754e-17,3.65571e-17,3.85691e-17,
+     $     4.16286e-17,4.15117e-17,4.05901e-17,3.64000e-17,2.99670e-17,
+     $     2.46796e-17,2.51789e-17/
+
+      data freccen /3.4,7.5,14.5,23.0,30.3,34.1,49.6,50.5,52.5,56.0,
      $59.0,61.5,68.7,73.1,78.4,83.1,92.4,97.5,99.3,100.1,100.7,102.1,
      $104.5,116.8,121.3,127.0,130.6,153.7,162.8,171.4
-     $,195.6,206.3,273.5/)
-
-      co2crsc195(:)=(/3.691e-19,4.44216e-20,3.86945e-19,5.94208e-19,
-     $2.93217e-19,7.58769e-20,8.60192e-21,4.20007e-24,2.29996e-26/)
-
-      co2crsc295(:)=(/3.691e-19,5.21572e-20,4.23488e-19,6.54728e-19,
-     $3.30227e-19,1.03183e-19,1.55722e-20,1.72317e-23,7.0e-25/)
-      
-      firstcall=.false.
-      endif ! of if (firstcall)
+     $,195.6,206.3,222.0,236.0,289.0,600./
+
+      data co2crsc195/2.05864e-17,5.90557e-20,3.1027e-19,6.70653e-19,
+     $4.55132e-19,8.87122e-20,1.32138e-20,7.22244e-23,2.88002e-26/
+
+      data co2crsc295/2.05897e-17,6.71104e-20,3.45509e-19,7.45711e-19,
+     $4.82752e-19,1.11594e-19,1.98308e-20,1.3853e-22,2.1414e-25/
 
 c     Reads tabulated functions
 
-      open(210,status='old',file=trim(datafile)//'/EUVDAT/coln.dat',
-     & iostat=ierr)
-
-      IF (ierr.NE.0) THEN
+      !Tabulated column amount
+      open(210, status = 'old',
+c    $file=datafile(1:lnblnk(datafile))//'/EUVDAT/coln.dat',iostat=ierr)
+     $file=datafile
+     $   (1:lnblnk(datafile))//'/EUVDAT/param_v5/coln.dat',iostat=ierr)
+
+      IF (ierr.NE.0) THEN 
        write(*,*)'cant find directory EUVDAT and content coln.dat'
-       write(*,*)'(in aeronomars/param_read.F)'
-       write(*,*)'It should be in :',trim(datafile),'/'
+       write(*,*)'(in aeronomars/param_read_iono.F)'
+       write(*,*)'It should be in :', datafile,'/'
        write(*,*)'1) You can change this directory address in '
        write(*,*)'   file phymars/datafile.h'
@@ -73,157 +104,364 @@
        STOP
       ENDIF
-
-      open(220,file=trim(datafile)//'/EUVDAT/j2_an.dat')
-      open(230,file=trim(datafile)//'/EUVDAT/j3_an.dat')
-      open(240,file=trim(datafile)//'/EUVDAT/j1_an.dat')
-      open(250,file=trim(datafile)//'/EUVDAT/j2_bn.dat')
-      open(260,file=trim(datafile)//'/EUVDAT/j2_cn.dat')
-      open(270,file=trim(datafile)//'/EUVDAT/j1_bn.dat')
-      open(280,file=trim(datafile)//'/EUVDAT/j1_cn.dat')
-      open(290,file=trim(datafile)//'/EUVDAT/j1_dn.dat')
-      open(150,file=trim(datafile)//'/EUVDAT/j4n.dat')
-      open(160,file=trim(datafile)//'/EUVDAT/j5n.dat')
-      open(170,file=trim(datafile)//'/EUVDAT/j6n.dat')
-
-      do i=210,290,10
-         read(i,*)
-         read(i,*)
-      end do
-
-      do i=150,170,10
-         read(i,*)
-         read(i,*)
-      end do
-
-      do i=nz2,1,-1
-        read(210,*) c23(i),(c123(j,i),j=2,ninter2),c12(i),c1(i),ch2o2(i)
-      end do
-
-      do i=nz2,1,-1
-         read(220,*) (jabsifotsint(j,2,i),j=1,ninter2)
-      end do
-      
-      do i=nz2,1,-1
-         read(230,*) (jabsifotsint(j,3,i),j=1,ninter2)
-      end do
-
-      do i=nz2,1,-1
-         read(240,*) (jabsifotsint(j,1,i),j=2,ninter2)
-      end do
-
-      do i=nz2,1,-1
-         read(250,*) (jabsifotsint(j,2,i),j=17,24)
-      end do
-
-      do i=nz2,1,-1
-         read(260,*) (jabsifotsint(j,2,i),j=25,31)
-      end do
-
-      do i=nz2,1,-1
-         read(270,*) (jabsifotsint(j,1,i),j=17,24)
-      end do
-
-      do i=nz2,1,-1
-         read(280,*) (jabsifotsint(j,1,i),j=25,31)
-      end do
-
-      do i=nz2,1,-1
-         read(290,*) jabsifotsint(32,1,i)
-      end do
-
-      do i=nz2,1,-1
-         read(160,*) (jabsifotsint(j,5,i),j=1,15)
-      end do
-
-      do i=nz2,1,-1
-         read(150,*) (jabsifotsint(j,4,i),j=25,31)
-      end do
-
-      do i=nz2,1,-1
-         read(170,*) (jabsifotsint(j,6,i),j=25,33)
-      end do
-
-      do i=210,290,10
+ 
+      !Tabulated photoabsorption coefficients
+      open(220,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/j2_an.dat')
+      open(230,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/j3_an.dat')
+      open(240,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/j1_an.dat')
+      open(250,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/j2_bn.dat')
+      open(260,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/j2_cn.dat')
+      open(300,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j2_dn.dat')
+      open(270,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j1_bn.dat')
+      open(280,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j1_cn.dat')
+      open(290,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j1_dn.dat')
+      open(150,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j4n.dat')
+      open(160,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j5n.dat')
+      open(170,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j6n.dat')
+      open(180,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j7n.dat')
+      open(390,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j8_an.dat')
+      open(400,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j8_bn.dat')
+      open(410,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j9n.dat')
+      open(420,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j10_an.dat')
+      open(430,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j10_bn.dat')
+      open(440,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j10_cn.dat')
+      open(450,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j11_an.dat')
+      open(460,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j11_bn.dat')
+      open(470,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j11_cn.dat')
+      open(480,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j12n.dat')
+      open(490,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j13_an.dat')
+      open(500,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j13_bn.dat')
+      open(510,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT//param_v5/j13_cn.dat')
+
+      
+      do i=210,300,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=150,180,10
+         read(i,*)
+         read(i,*)
+      end do
+
+      do i=390,510,10
+         read(i,*)
+         read(i,*)
+      enddo
+
+      do i=nz2,1,-1
+         read(210,*) (c1_16(i,j),j=1,16),c17_24(i),c25_29(i),c30_31(i),
+     $        c32(i),c33(i),c34(i),c35(i),c36(i)
+      end do
+
+      do i=nz2,1,-1
+         read(220,*) (jabsifotsintpar(j,2,i),j=1,16)
+      end do
+      
+      do i=nz2,1,-1
+         read(230,*) (jabsifotsintpar(j,3,i),j=1,16)
+      end do
+
+      do i=nz2,1,-1
+         read(240,*) (jabsifotsintpar(j,1,i),j=1,16)
+      end do
+
+      do i=nz2,1,-1
+         read(250,*) (jabsifotsintpar(j,2,i),j=17,24)
+      end do
+
+
+      do i=nz2,1,-1
+         read(260,*) (jabsifotsintpar(j,2,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(270,*) (jabsifotsintpar(j,1,i),j=17,24)
+      end do
+
+      do i=nz2,1,-1
+         read(280,*) (jabsifotsintpar(j,1,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(290,*) jabsifotsintpar(32,1,i)
+      end do
+
+      do i=nz2,1,-1
+         read(300,*) (jabsifotsintpar(j,2,i),j=32,34)
+      end do
+
+      do i=nz2,1,-1
+         read(160,*) (jabsifotsintpar(j,5,i),j=1,15)
+      end do
+
+      do i=nz2,1,-1
+         read(150,*) (jabsifotsintpar(j,4,i),j=25,31)
+      end do
+
+      do i=nz2,1,-1
+         read(170,*) (jabsifotsintpar(j,6,i),j=25,35)
+      end do
+
+      do i=nz2,1,-1
+         read(180,*) (jabsifotsintpar(j,7,i),j=34,36)
+      end do
+
+      do i=nz2,1,-1
+         read(390,*) (jabsifotsintpar(j,8,i),j=2,16)
+      enddo
+
+      do i=nz2,1,-1
+         read(400,*) (jabsifotsintpar(j,8,i),j=17,24)
+      enddo
+
+      do i=nz2,1,-1
+         read(410,*) (jabsifotsintpar(j,9,i),j=1,16)
+      enddo
+
+      do i=nz2,1,-1
+         read(420,*) (jabsifotsintpar(j,10,i),j=2,16)
+      enddo
+
+      do i=nz2,1,-1
+         read(430,*) (jabsifotsintpar(j,10,i),j=17,24)
+      enddo
+
+      do i=nz2,1,-1
+         read(440,*) (jabsifotsintpar(j,10,i),j=25,32)
+      enddo
+
+      do i=nz2,1,-1
+         read(450,*) (jabsifotsintpar(j,11,i),j=2,16)
+      enddo
+
+      do i=nz2,1,-1
+         read(460,*) (jabsifotsintpar(j,11,i),j=17,24)
+      enddo
+
+      do i=nz2,1,-1
+         read(470,*) (jabsifotsintpar(j,11,i),j=25,29)
+      enddo
+      
+      do i=nz2,1,-1
+         read(480,*) (jabsifotsintpar(j,12,i),j=2,16)
+      enddo
+
+      do i=nz2,1,-1
+         read(490,*) (jabsifotsintpar(j,13,i),j=2,16)
+      enddo
+      
+      do i=nz2,1,-1
+         read(500,*) (jabsifotsintpar(j,13,i),j=17,24)
+      enddo
+      
+      do i=nz2,1,-1
+         read(510,*) (jabsifotsintpar(j,13,i),j=25,36)
+      enddo
+
+      do i=210,300,10
          close(i)
       end do
 
-      do i=150,170,10
+      do i=150,180,10
          close(i)
       end do
 
-
-c     reads t0
-
-      open(120,file=trim(datafile)//'/EUVDAT/t0.dat')
-      do i=1,201
-         read(120,*)t0(i)
-      end do
-      close(120)
-
-      open(100,file=trim(datafile)//'/EUVDAT/flujo.dat')
+      do i=390,510,10
+         close(i)
+      enddo
+
+
+c     set t0
+
+      do i=1,nz2
+         t0(i)=195.
+      end do
+
+
       do i=1,ninter
-         read(100,*) inter,fluxtophr(i)
+         fluxtop(i)=1.
+      end do
+
+      !Parameters for the variation of the solar flux with 11 years cycle
+      open(100,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/varflujo.dat')
+      read(100,*)
+      do i=1,24
+         read(100,*) inter,ct1(i),p1(i),ct2(i),p2(i),nada
       end do
       close(100)
 
-
-      open(99,file=trim(datafile)//'/EUVDAT/varflujo.dat')
-      read(99,*)
-      do i=1,24
-         read(99,*) inter,ct1(i),p1(i),ct2(i),p2(i),nada
-      end do
-      close(99)
-
-c     eficiencias de disociacion (de Torr et al, 1979)
-
-      do inter=1,11
-         efdisco2(inter) = 0.
-         efdiso2(inter) = 0.
-      end do
-
+c     dissociation and ionization efficiencies
+
+      do inter=1,ninter
+         efdisco2(inter)=0.
+         efdiso2(inter)=0.
+         efdish2(inter)=0.
+         efdish2o(inter)=0.
+         efdish2o2(inter)=0.
+         efdiso3(inter)=0.
+         efdisco(inter)=0.
+         efdisn2(inter)=0.
+         efdisno(inter)=0.
+         efdisno2(inter)=0.
+         efionco2(inter,1)=0.
+         efionco2(inter,2)=0.
+         efionco2(inter,3)=0.
+         efionco2(inter,4)=0.
+         efiono3p(inter)=0.
+         efionn2(inter,1)=0.
+         efionn2(inter,2)=0.
+         efionco(inter,1)=0.
+         efionco(inter,2)=0.
+         efionco(inter,3)=0.
+         efionn(inter)=0.
+         efionh(inter)=0.
+         efionno(inter)=0.
+      enddo
+
+
+c     CO2, O2, NO
+
+      open(120,file=datafile
+     $     (1:lnblnk(datafile))//'/EUVDAT/param_v5/efdis_inter.dat')
+      read(120,*)
+!      do i=1,21
+!         read(120,*)inter,efdisco2(inter),efdiso2(inter),efdisno(inter)
+      do inter=8,28
+         read(120,*)i,efdisco2(inter),efdiso2(inter),efdisno(inter)
+      enddo
+      do inter=29,ninter
+         efdisco2(inter)=1.
+         efdiso2(inter)=1.
+         efdisno(inter)=1.
+      enddo
+
+
+c     N2
+
+      efdisn2(15)=0.1
+      do inter=16,ninter
+         efdisn2(inter)=1.
+      enddo
+
+
+c     CO
+
+      efdisco(16)=0.5
+      do inter=17,ninter
+         efdisco(inter)=1.
+      enddo
+
+      
+c     O, N, H
+
+      do inter=1,ninter
+         efdiso(inter)=0.
+         efdisn(inter)=0.
+         efdish(inter)=0.
+      enddo
+
+
+c     H2O, H2O2, O3, NO2
+
+      do inter=25,31
+         efdish2o(inter)=1.
+      enddo
+      do inter=25,35
+         efdish2o2(inter)=1.
+      enddo
+      do inter=34,36
+         efdiso3(inter)=1.
+      enddo
+      do inter=27,36
+         efdisno2(inter)=1.
+      enddo
       do inter=1,15
-         efdish2(inter) = 1.
-      end do
-
-      efdisco2(12) = 0.183
-      efdiso2(12) = 0.003
-
-      efdisco2(13) = 0.163
-      efdiso2(13) = 0.170
-
-      efdisco2(14) = 0.243
-      efdiso2(14) =0.180
-
-      efdisco2(15) = 0.323
-      efdiso2(15) =0.653
-
-      efdisco2(16) = 0.235
-      efdiso2(16) =0.616
-
-      do inter=17,32
-         efdisco2(inter) = 1.0
-      end do
-
-      efdiso2(17) = 0.399
-      do inter=18,20
-         efdiso2(inter) = 0.261
-      end do
-
-      do inter=21,23
-         efdiso2(inter) = 0.755
-      end do
-
-
-      do inter=24,31
-         efdiso2(inter) = 1.
-      end do
-
-      do inter=25,31
-         efdish2o(inter) = 1.
-      end do
-
-      do inter=25,33
-         efdish2o2(inter) = 1.
-      end do
+         efdish2(inter)=1.
+      enddo
+         
+      !4 possible channels for CO2 ionization
+      do inter=14,16
+         efionco2(inter,1)=1.-efdisco2(inter)
+      enddo
+      efionco2(13,1)=0.805*(1.-efdisco2(13))
+      efionco2(13,2)=0.195*(1.-efdisco2(13))
+      do inter=11,12
+         efionco2(inter,3)=1.-efdisco2(inter)
+      enddo
+      efionco2(10,3)=0.9*(1.-efdisco2(10))
+      efionco2(10,4)=0.1*(1.-efdisco2(10))
+      do inter=2,9
+         efionco2(inter,4)=1.-efdisco2(inter)
+      enddo
+
+      !For O(3p) total ionization under 91.1 nm
+      do inter=1,16
+         efiono3p(inter)=1.d0
+      enddo
+
+      !2 channels for N2 ionization
+      do inter=9,15
+         efionn2(inter,1)=1.-efdisn2(inter)
+      enddo
+      do inter=2,8
+         efionn2(inter,2)=1.-efdisn2(inter)
+      enddo
+      
+      !3 channels for CO ionization
+      do inter=11,16
+         efionco(inter,1)=1.-efdisco(inter)
+      enddo
+      efionco(10,1)=0.87*(1.-efdisco(10))
+      efionco(10,2)=0.13*(1.-efdisco(10))
+      do inter=8,9
+         efionco(inter,2)=1.-efdisco(inter)
+      enddo
+      efionco(7,2)=0.1*(1.-efdisco(7))
+      efionco(7,3)=0.9*(1.-efdisco(7))
+      do inter=2,6
+         efionco(inter,3)=1.-efdisco(inter)
+      enddo
+
+      !Total ionization under 85 nm for N
+      do inter=1,16
+         efionn(inter)=1.
+      enddo
+
+      !NO
+      do inter=2,28
+         efionno(inter)=1.-efdisno(inter)
+      enddo
+
+      !Total ionization under 90 nm for H
+      do inter=3,16
+         efionh(inter)=1.
+      enddo
 
 
@@ -232,2 +470,3 @@
 
       end
+
Index: trunk/LMDZ.MARS/libf/aeronomars/param_v3.h
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/param_v3.h	(revision 633)
+++ 	(revision )
@@ -1,95 +1,0 @@
-c**********************************************************************
-
-c	param.cmn
-	
-c	fgg     mar 02          first version
-c**********************************************************************
-
-      common/uv/ anchint,crscabsi2,freccen,c123,c1,c2,c12,c23,ch2o2
-     $ ,jabsifotsint,jfotsout,co2crsc195,co2crsc295,fluxtop,t0
-     
-     
-
-
-      real       anchint(ninter)          !widht of each interval
-      real       crscabsi2(nabs,ninter)    !cross section
-      real       freccen(ninter)          !representative wavelenght
-      real       c123(ninter2,nz2)        !column densities (cm^-2)
-                                          !(CO2+O2+O3P)
-      real       c1(nz2)                  !idem (CO2) (cm^-2)
-      real       c2(nz2)                  !idem (O2) (cm^-2)
-      real       c12(nz2)                 !idem (CO2+O2) (cm^-2)
-      real       c23(nz2)                 !idem (O2+O3P) (cm^-2)
-      real       ch2o2(nz2)               !idem (H2O2) (cm^-2)
-      real       jabsifotsint(ninter,nabs,nzmax) !photoabsorption
-                                                 !coefficients (fot/s)
-      real       jfotsout(ninter,nabs,nzmax)
-      real       co2crsc195(9)
-      real       co2crsc295(9)
-      real       fluxtop(ninter)
-      real       t0(nzmax)
-      
-
-
-      common/fotoquimica/  ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,
-     $                     ch13,ch14,ch15,ch18,ch19,ch20,ch21
-     $			   ,jdistot,jdistot_b
-
-      real*8 ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,ch13,ch14,ch15,ch18
-      real*8 ch19,ch20,ch21
-						  !reaction rates
-      real jdistot(nabs,nzmax)    !photodissociation rates
-      real jdistot_b(2,nzmax)
-
-
-
-      common/prod/ Pco2,Po2,Po3p,Pco,Ph,Poh,Pho2,Ph2,Ph2o,Po1d,Ph2o2,
-     $		   Pco2tot,Po2tot,Po3ptot,Pcotot,Phtot,Pohtot,
-     $             Pho2tot,Ph2tot,Ph2otot,Po1dtot,Ph2o2tot
-	
-      real*8 Pco2(nzmax,nreact),Po2(nzmax,nreact),Po3p(nzmax,nreact)
-      real*8 Pco(nzmax,nreact),Ph(nzmax,nreact),Poh(nzmax,nreact)
-      real*8 Pho2(nzmax,nreact),Ph2(nzmax,nreact),Ph2o(nzmax,nreact)
-      real*8 Po1d(nzmax,nreact),Ph2o2(nzmax,nreact)
-      real*8 Pco2tot(nzmax),Po2tot(nzmax),Po3ptot(nzmax),Pcotot(nzmax)
-      real*8 Phtot(nzmax)
-      real*8 Pohtot(nzmax),Pho2tot(nzmax),Ph2tot(nzmax),Ph2otot(nzmax)
-      real*8 Po1dtot(nzmax),Ph2o2tot(nzmax)
-
-
-      common/loss/ Lco2,Lo2,Lo3p,Lco,Lh,Loh,Lho2,Lh2,Lh2o,Lo1d,Lh2o2,
-     $		   Lco2tot,Lo2tot,Lo3ptot,Lcotot,Lhtot,Lohtot,
-     $             Lho2tot,Lh2tot,Lh2otot,Lo1dtot,Lh2o2tot
-	
-      real*8 Lco2(nzmax,nreact),Lo2(nzmax,nreact),Lo3p(nzmax,nreact)
-      real*8 Lco(nzmax,nreact),Lh(nzmax,nreact),Loh(nzmax,nreact)
-      real*8 Lho2(nzmax,nreact),Lh2(nzmax,nreact),Lh2o(nzmax,nreact)
-      real*8 Lo1d(nzmax,nreact),Lh2o2(nzmax,nreact)
-      real*8 Lco2tot(nzmax),Lo2tot(nzmax),Lo3ptot(nzmax),Lcotot(nzmax)
-      real*8 Lhtot(nzmax),Lohtot(nzmax),Lho2tot(nzmax),Lh2tot(nzmax)
-      real*8 Lh2otot(nzmax),Lo1dtot(nzmax),Lh2o2tot(nzmax)
-
-
-      common/vida/ tminco2,tmino2,tmino3p,tminco,tminh,tminoh,tminho2
-     $               ,tminh2,tminh2o,tmino1d,tminh2o2
-
-    	real*8 tminco2(nzmax),tmino2(nzmax),tmino3p(nzmax),tminco(nzmax)
-    	real*8 tminh(nzmax),tminoh(nzmax),tminho2(nzmax),tminh2(nzmax)
-    	real*8 tminh2o(nzmax),tmino1d(nzmax),tminh2o2(nzmax)
-
-
-      common/flujoctes/ fluxtophr,ct1,p1,ct2,p2   
- 
-      real fluxtophr(ninter)
-      real ct1(ninter),p1(ninter),ct2(ninter),p2(ninter)       
-
-      common/phdisef/ efdisco2, efdiso2, efdish2, efdish2o, efdish2o2
-
-      real efdisco2(ninter), efdiso2(ninter), efdish2o(ninter)
-      real efdish2o2(ninter), efdish2(ninter)
-
-
-
-
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/param_v4.h
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/param_v4.h	(revision 635)
+++ trunk/LMDZ.MARS/libf/aeronomars/param_v4.h	(revision 635)
@@ -0,0 +1,204 @@
+!**********************************************************************
+
+!	param.cmn
+	
+!	fgg     mar 02          first version
+!**********************************************************************
+
+
+      common/uv/ crscabsi2,c1_16,c17_24,c25_29,c30_31,c32,                         &
+     &   c33,c34,c35,c36,jfotsout,co2crsc195,co2crsc295,                           &
+     &   t0,fluxtop,freccen,jabsifotsintpar
+     
+     
+
+      real crscabsi2(nabs,16)    !cross section
+      real c1_16(nz2,16)   !Col. int. 1 (o2+o+h2+n) (cm^-2)
+      real c17_24(nz2)     !Col. int. 17-24 (co2+o2+n2+no+co+no2) (cm^-2)
+      real c25_29(nz2)     !Col. int. 25-29 (co2+o2+h2o+h2o2+no+co+no2) (cm^-2)
+      real c30_31(nz2)     !Col. int. 30-31 (co2+o2+h2o+h2o2+no+no2)
+      real c32(nz2)	   !col. int. 32 (co2+h2o2+o2+no+no2) (cm^-2)
+      real c33(nz2)	   !col. int. 33 (h2o2+o2+no2) (cm^-2)
+      real c34(nz2)	   !col. int. 34 (h2o2+o2+o3+no2) (cm^-2)
+      real c35(nz2)	   !col. int. 35 (h2o2+o3+no2) (cm^-2)
+      real c36(nz2)	   !col. int. 36 (o3+no2) (cm^-2)
+      real jfotsout(ninter,nabs,nlayermx)
+      real co2crsc195(9)
+      real co2crsc295(9)
+      real t0(nz2)
+      real fluxtop(ninter)
+      real freccen(ninter)          !representative wavelenght
+      real jabsifotsintpar(ninter,nabs,nz2)
+
+
+      common/fotoquimica/  ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,                &
+     &                     ch13,ch14,ch15,ch18,ch19,ch20,ch21,ch22,              &
+     &                     ch23,ch24,ch30,ch31,ch32,ch33,ch34,ch35,              &
+     &                     ch36,ch37,ch38,ch39,ch40,ch41,ch42,ch43,              &
+     &                     ch45,ch46,ch47,ch48,ch49,ch50,ch55,ch56,              &
+     &                     ch57,ch58,ch59,ch62,ch63,ch64,ch65,                   &
+     &                     ch66,ch67,ch68,ch69,ch70,ch71,ch72,                   &
+     &                     ch73,ch74,ch75,ch76,ch85,ch86,ch87,                   &
+     &                     jdistot,jdistot_b,jion
+
+      real*8 ch2, ch3, ch4, ch5, ch7,ch9,ch10,ch11,ch13,ch14,ch15,ch18
+      real*8 ch19,ch20,ch21,ch22,ch23,ch24,ch30,ch31,ch32,ch33,ch34
+      real*8 ch35,ch36,ch37,ch38,ch39,ch40,ch41,ch42,ch43,ch45
+      real*8 ch46,ch47,ch48,ch49,ch50,ch55,ch56,ch57,ch58,ch59,ch62 
+      real*8 ch63,ch64,ch65,ch66,ch67,ch68,ch69,ch70,ch71
+      real*8 ch72,ch73,ch74,ch75,ch76,ch85,ch86,ch87
+
+						  !reaction rates
+      real jdistot(nabs,nlayermx)    !photodissociation rates
+      real jdistot_b(nabs,nlayermx)
+     
+      real jion(nabs,nlayermx,4)
+
+
+
+      common/prod/ Pco2,Po2,Po3p,Pco,Ph,Poh,Pho2,Ph2,Ph2o,Po1d,Ph2o2,          &
+     &             Po3,Pn,Pno,Pno2,Pn2,Pn2d,                                   &
+     &             Pco2plus,Poplus,Po2plus,Pelect,Pcoplus,Pcplus,              &
+     &             Pnplus, Pnoplus, Pn2plus, Phplus, Phco2plus,                &
+     &  	   Pco2tot,Po2tot,Po3ptot,Pcotot,Phtot,Pohtot,                 &
+     &             Pho2tot,Ph2tot,Ph2otot,Po1dtot,Ph2o2tot,                    &
+     &             Po3tot,Pntot,Pnotot,Pno2tot,Pn2tot,Pn2dtot,                 &
+     &             Pcoplustot,Pcplustot,                                       &
+     &             Pco2plustot,Poplustot,Po2plustot,Pelecttot,                 &
+     &             Pnplustot,Pnoplustot,Pn2plustot,Phplustot,                  &
+     &             Phco2plustot  
+
+	
+      real*8 Pco2(nlayermx,nreact),Po2(nlayermx,nreact)
+      real*8 Po3p(nlayermx,nreact)
+      real*8 Pco(nlayermx,nreact),Ph(nlayermx,nreact)
+      real*8 Poh(nlayermx,nreact)
+      real*8 Pho2(nlayermx,nreact),Ph2(nlayermx,nreact)
+      real*8 Ph2o(nlayermx,nreact)
+      real*8 Po1d(nlayermx,nreact),Ph2o2(nlayermx,nreact)
+      real*8 Po3(nlayermx,nreact),Pn(nlayermx,nreact)
+      real*8 Pno(nlayermx,nreact)
+      real*8 Pno2(nlayermx,nreact),Pn2(nlayermx,nreact)
+      real*8 Pn2d(nlayermx,nreact)
+      real*8 Pco2plus(nlayermx,nreact),Poplus(nlayermx,nreact)
+      real*8 Po2plus(nlayermx,nreact), Pelect(nlayermx,nreact)
+      real*8 Pcoplus(nlayermx,nreact),Pcplus(nlayermx,nreact)
+      real*8 Pnplus(nlayermx,nreact),Pnoplus(nlayermx,nreact)
+      real*8 Pn2plus(nlayermx,nreact),Phplus(nlayermx,nreact)
+      real*8 Phco2plus(nlayermx,nreact)
+      real*8 Pco2tot(nlayermx),Po2tot(nlayermx)
+      real*8 Po3ptot(nlayermx),Pcotot(nlayermx)
+      real*8 Phtot(nlayermx)
+      real*8 Pohtot(nlayermx),Pho2tot(nlayermx)
+      real*8 Ph2tot(nlayermx),Ph2otot(nlayermx)
+      real*8 Po1dtot(nlayermx),Ph2o2tot(nlayermx)
+      real*8 Po3tot(nlayermx),Pntot(nlayermx),Pnotot(nlayermx)
+      real*8 Pno2tot(nlayermx),Pn2tot(nlayermx),Pn2dtot(nlayermx)
+      real*8 Pco2plustot(nlayermx), Poplustot(nlayermx)
+      real*8 Po2plustot(nlayermx),Pelecttot(nlayermx)
+      real*8 Pcoplustot(nlayermx), Pcplustot(nlayermx)
+      real*8 Pnplustot(nlayermx), Pnoplustot(nlayermx)
+      real*8 Pn2plustot(nlayermx),Phplustot(nlayermx)
+      real*8 Phco2plustot(nlayermx)
+
+
+      common/loss/ Lco2,Lo2,Lo3p,Lco,Lh,Loh,Lho2,Lh2,Lh2o,Lo1d,Lh2o2,         &
+     &             Lo3,Ln,Lno,Lno2,Ln2,Ln2d,Lelect,                           &
+     &             Lco2plus,Lo2plus,Loplus, Lcoplus, Lcplus,                  &
+     &             Lnplus,Lnoplus,Ln2plus, Lhplus, Lhco2plus,                 &
+     &             Lco2tot,Lo2tot,Lo3ptot,Lcotot,Lhtot,Lohtot,                &
+     &             Lho2tot,Lh2tot,Lh2otot,Lo1dtot,Lh2o2tot,                   &
+     &             Lo3tot,Lntot,Lnotot,Lno2tot,Ln2tot,Ln2dtot,                &
+     &             Lcoplustot,Lcplustot,Lco2plustot,Loplustot,                &
+     &             Lo2plustot,Lelecttot,Lnplustot,Lnoplustot,                 &
+     &             Ln2plustot,Lhplustot,Lhco2plustot
+
+	
+      real*8 Lco2(nlayermx,nreact),Lo2(nlayermx,nreact)
+      real*8 Lo3p(nlayermx,nreact)
+      real*8 Lco(nlayermx,nreact),Lh(nlayermx,nreact)
+      real*8 Loh(nlayermx,nreact)
+      real*8 Lho2(nlayermx,nreact),Lh2(nlayermx,nreact)
+      real*8 Lh2o(nlayermx,nreact)
+      real*8 Lo1d(nlayermx,nreact),Lh2o2(nlayermx,nreact)
+      real*8 Lo3(nlayermx,nreact),Ln(nlayermx,nreact)
+      real*8 Lno(nlayermx,nreact)
+      real*8 Lno2(nlayermx,nreact),Ln2(nlayermx,nreact)
+      real*8 Ln2d(nlayermx,nreact)
+      real*8 Lco2plus(nlayermx,nreact), Loplus(nlayermx,nreact)
+      real*8 Lo2plus(nlayermx,nreact), Lelect(nlayermx,nreact)
+      real*8 Lcoplus(nlayermx,nreact), Lcplus(nlayermx,nreact)
+      real*8 Lnplus(nlayermx,nreact), Lnoplus(nlayermx,nreact)
+      real*8 Ln2plus(nlayermx,nreact), Lhplus(nlayermx,nreact)
+      real*8 Lhco2plus(nlayermx,nreact)
+      real*8 Lco2tot(nlayermx),Lo2tot(nlayermx)
+      real*8 Lo3ptot(nlayermx),Lcotot(nlayermx)
+      real*8 Lhtot(nlayermx),Lohtot(nlayermx)
+      real*8 Lho2tot(nlayermx),Lh2tot(nlayermx)
+      real*8 Lh2otot(nlayermx),Lo1dtot(nlayermx)
+      real*8 Lh2o2tot(nlayermx)
+      real*8 Lo3tot(nlayermx),Lntot(nlayermx),Lnotot(nlayermx)
+      real*8 Lno2tot(nlayermx),Ln2tot(nlayermx)
+      real*8 Ln2dtot(nlayermx)
+      real*8 Lco2plustot(nlayermx), Loplustot(nlayermx)
+      real*8 Lo2plustot(nlayermx), Lelecttot(nlayermx)
+      real*8 Lcoplustot(nlayermx), Lcplustot(nlayermx)
+      real*8 Lnplustot(nlayermx), Lnoplustot(nlayermx)
+      real*8 Ln2plustot(nlayermx), Lhplustot(nlayermx)
+      real*8 Lhco2plustot(nlayermx)
+
+
+
+      common/vida/ tminco2,tmino2,tmino3p,tminco,tminh,tminoh,tminho2,        &
+     &               tminh2,tminh2o,tmino1d,tminh2o2,tmino3,tminn,            &
+     &               tminno,tminno2,tminn2,tminn2d,                           &
+     &               tminco2plus,tminoplus,tmino2plus,tmincoplus,             &
+     &               tmincplus,tminnplus,tminnoplus,                          &
+     &               tminn2plus,tminhplus,tminhco2plus
+
+
+
+    	real*8 tminco2(nlayermx),tmino2(nlayermx)
+        real*8 tmino3p(nlayermx),tminco(nlayermx)
+    	real*8 tminh(nlayermx),tminoh(nlayermx)
+        real*8 tminho2(nlayermx),tminh2(nlayermx)
+    	real*8 tminh2o(nlayermx),tmino1d(nlayermx),tminh2o2(nlayermx)
+        real*8 tmino3(nlayermx),tminn(nlayermx),tminno(nlayermx)
+        real*8 tminno2(nlayermx),tminn2(nlayermx),tminn2d(nlayermx)
+        real*8 tminco2plus(nlayermx),tminoplus(nlayermx)
+        real*8 tmino2plus(nlayermx)
+        real*8 tmincoplus(nlayermx)
+        real*8 tmincplus(nlayermx)
+        real*8 tminnplus(nlayermx),tminnoplus(nlayermx)
+        real*8 tminn2plus(nlayermx)
+        real*8 tminhplus(nlayermx),tminhcoplus(nlayermx)
+        real*8 tminhco2plus(nlayermx)
+
+
+      common/flujoctes/ fluxtophr,ct1,p1,ct2,p2   
+ 
+        real fluxtophr(ninter)
+        real ct1(ninter),p1(ninter),ct2(ninter),p2(ninter)       
+
+      common/phdisef/ efdisco2, efdiso2, efdish2, efdish2o, efdish2o2,        &
+     &                efdiso3,efdiso,efdisn,efdish,efdisno,efdisn2,           &
+     &                efdisno2,efdisco,efionco2,efionn2,efionco,              &
+     &                efiono3p,efionn,efionno,efionh
+  
+
+        real efdisco2(ninter), efdiso2(ninter), efdish2o(ninter)
+        real efdish2o2(ninter), efdish2(ninter), efdiso3(ninter)
+        real efdiso(ninter), efdisn(ninter), efdish(ninter)
+        real efdisno(ninter), efdisn2(ninter), efdisno2(ninter)
+        real efdisco(ninter)
+        real efionco2(ninter,4)
+        real efionn2(ninter,2)
+        real efionco(ninter,3)
+        real efiono3p(ninter),efionn(ninter)
+        real efionno(ninter),efionh(ninter)
+
+
+
+
+
+
Index: trunk/LMDZ.MARS/libf/aeronomars/paramfoto.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/paramfoto.F	(revision 633)
+++ 	(revision )
@@ -1,599 +1,0 @@
-c**********************************************************************
-      
-      subroutine paramfoto
-     $(lswitch,zdens,tx,timestep,zenit,nz,co2x,o2x,o3px,cox,hx,ohx,
-     & ho2x,h2x,h2ox,h2o2x,o1dx)
-
-c     oct 2002      fgg
-c**********************************************************************
-
-      implicit none
-
-      include 'param.h'
-      include 'param_v3.h'
-
-c     arguments
-
-      integer nz,lswitch
-      real zdens(nz)
-      real tx(nz)
-      real co2x(nz),o2x(nz),o3px(nz),cox(nz),hx(nz),ohx(nz)
-      real    h2x(nz),h2ox(nz),h2o2x(nz),o1dx(nz),ho2x(nz)
-      real    zenit
-      real    timestep
-
-c     local variables
-
-      real*8    dt,deltat
-      integer nt, ntmax
-      real*8    tauco2(nzmax,nreact)
-      real*8    tauo2(nzmax,nreact)
-      real*8    tauo3p(nzmax,nreact)
-      real*8    tauco(nzmax,nreact)
-      real*8    tauh(nzmax,nreact)
-      real*8    tauoh(nzmax,nreact)
-      real*8    tauho2(nzmax,nreact)
-      real*8    tauh2(nzmax,nreact)
-      real*8    tauh2o(nzmax,nreact)
-      real*8    tauo1d(nzmax,nreact)
-      real*8    tauh2o2(nzmax,nreact)
-      real*8    co2x8,o2x8,o3px8,cox8,hx8,ohx8,ho2x8,h2x8,h2ox8
-      real*8    h2o2x8,o1dx8
-      real*8    o1dx8aux,ohx8aux,ho2x8aux,dif_o1d,dif_oh,dif_ho2
-      real*8    timestep8
-      real*8    jdistot8(nabs,nzmax)
-      real*8    jdistot8_b(2,nzmax)
-      real*8    tx8
-
-      real*8    tmin(nzmax)
-      integer i,j,k,nada,n
-
-      real*8    auxp,auxl
-      
-      character*1 o1d_eq(nzmax)
-      character*1 oh_eq(nzmax)
-      character*1 ho2_eq(nzmax)
-      character*1 dn
-
-      logical firstcall
-      save firstcall
-      data firstcall /.true./
-
-      if (firstcall) then
-        firstcall= .false.
-        print*,'FOTO'
-      endif
-
-c 123  format(1x,f10.7,11(tr3,e12.7))
-
-c**********************************************************************
-
-C     Start: altitude loop
-      timestep8=dble(timestep)
-
-      do i=nz,lswitch,-1
-         
-
-c     Concentrations to real*8
-
-         co2x8=dble(co2x(i))
-         o2x8=dble(o2x(i))
-         o3px8=dble(o3px(i))
-         cox8=dble(cox(i))
-         hx8=dble(hx(i))
-         ohx8=dble(ohx(i))
-         ho2x8=dble(ho2x(i))
-         h2x8=dble(h2x(i))
-         h2ox8=dble(h2ox(i))
-         h2o2x8=dble(h2o2x(i))
-         o1dx8=dble(o1dx(i))
-         tx8=dble(tx(i))
-
-
-c     reaction rates         
-
-         call getch(tx8)
-
-c         print*,i,co2x(i),o2x(i),o3px(i),cox(i),hx(i),ohx(i),ho2x(i),
-c     &            h2x(i),h2ox(i),h2o2x(i),o1dx(i),tx(i),zdens(i)
-
-
-c     photodissotiation rates
-
-         jdistot(1,i) = 0.
-         jdistot(2,i) = 0.
-         jdistot(3,i) = 0.
-         jdistot(4,i) = 0.
-         jdistot(5,i) = 0.
-         jdistot(6,i) = 0.
-         jdistot_b(1,i) = 0.
-         jdistot_b(2,i) = 0.
-
-         call phdisrate(zenit,i)
-
-         do j=1,6
-            jdistot8(j,i) = dble(jdistot(j,i))
-         end do
-         jdistot8_b(1,i) = dble(jdistot_b(1,i))
-         jdistot8_b(2,i) = dble(jdistot_b(2,i))
-         
-         
-c     Lifetimes calculation
-
-         do j=1,nreact
-            tauco2(i,j) = 1.d30
-            tauo2(i,j) = 1.d30
-            tauo3p(i,j) = 1.d30
-            tauco(i,j) = 1.d30
-            tauh(i,j) = 1.d30
-            tauoh(i,j) = 1.d30
-            tauho2(i,j) = 1.d30
-            tauh2(i,j) = 1.d30
-            tauh2o(i,j) = 1.d30
-            tauo1d(i,j) = 1.d30
-            tauh2o2(i,j) = 1.d30
-         end do
-
-         if(jdistot8(1,i).gt.1d-30) tauco2(i,1) = 1.d0 / jdistot8(1,i)
-
-         if(ch2*o2x8*co2x8.gt.1d-30) 
-     $      tauh(i,2) = 1.d0 / (ch2 * o2x8 * co2x8)  
-         if(ch2*hx8*co2x8.gt.1d-30)
-     $      tauo2(i,2) = 1.d0 / (ch2 * hx8 * co2x8)
- 
-         if(ch3*o3px8.gt.1d-30) tauho2(i,3) = 1.d0 / (ch3 * o3px8)
-         if(ch3*ho2x8.gt.1d-30) tauo3p(i,3) = 1.d0 / (ch3 * ho2x8)
- 
-         if(ch4*cox8.gt.1d-30) tauoh(i,4) = 1.d0 / (ch4 * cox8)
-         if(ch4*ohx8.gt.1d-30) tauco(i,4) = 1.d0 / (ch4 * ohx8)
- 
-         if(ch5*ho2x8.gt.1d-30)tauho2(i,5) = 1.d0 / (2.d0 * ch5 * ho2x8)
-
-         if(jdistot8(6,i).gt.1d-30) tauh2o2(i,6) = 1.d0 / jdistot8(6,i)
-
-         if(ch7*ohx8.gt.1d-30) tauho2(i,7) = 1.d0 / (ch7 * ohx8)
-         if(ch7*ho2x8.gt.1d-30) tauoh(i,7) = 1.d0 / (ch7 * ho2x8)
- 
-         if(jdistot8(4,i).gt.1d-30) tauh2o(i,8) = 1.d0 / jdistot8(4,i)
-
-         if(ch9*o1dx8.gt.1d-30) tauh2o(i,9) = 1.d0 / (ch9 * o1dx8)
-         if(ch9*h2ox8.gt.1d-30) tauo1d(i,9) = 1.d0 / (ch9 * h2ox8)
-
-         if(ch10*o3px8*co2x8.gt.1d-30) 
-     $     tauo3p(i,10) = 1.d0 / (2.d0 * ch10 * o3px8 * co2x8)
-
-         if(ch11*o3px8.gt.1d-30) tauoh(i,11) = 1.d0 / (ch11 * o3px8)
-         if(ch11*ohx8.gt.1d-30) tauo3p(i,11) = 1.d0 / (ch11 * ohx8)
-
-         if(jdistot8(2,i).gt.1d-30) tauo2(i,12) = 1.d0 / jdistot8(2,i)
-
-         if(ch13*hx8.gt.1d-30) tauho2(i,13) = 1.d0 / (ch13 * hx8)
-         if(ch13*ho2x8.gt.1d-30) tauh(i,13) = 1.d0 / (ch13 * ho2x8)
-
-         if(ch14*o1dx8.gt.1d-30) tauh2(i,14) = 1.d0 / (ch14 * o1dx8)
-         if(ch14*h2x8.gt.1d-30) tauo1d(i,14) = 1.d0 / (ch14 * h2x8)
-
-         if(ch15*ohx8.gt.1d-30) tauh2(i,15) = 1.d0 / (ch15 * ohx8)
-         if(ch15*h2x8.gt.1d-30) tauoh(i,15) = 1.d0 / (ch15 * h2x8)
-
-         if(jdistot8_b(1,i).gt.1d-30) tauco2(i,16) =1.d0/jdistot8_b(1,i)
-
-         if(jdistot8_b(2,i).gt.1d-30) tauo2(i,17) =1.d0/jdistot8_b(2,i)
-
-         if(ch18*ohx8.gt.1d-30) tauh2o2(i,18) = 1.d0 / (ch18 * ohx8)
-         if(ch18*h2o2x8.gt.1d-30) tauoh(i,18) = 1.d0 / (ch18 * h2o2x8)
-
-         if(ch19*co2x8.gt.1d-30) tauo1d(i,19) = 1.d0 / (ch19 * co2x8)
-
-         if(ch20*o2x8.gt.1d-30) tauo1d(i,20) = 1.d0 / (ch20 * o2x8)
-
-         if(ch21*o2x8*co2x8.gt.1d-30) tauo3p(i,21) = 1.d0 / 
-     $        (ch21 * o2x8 * co2x8)
-         if(ch21*o3px8*co2x8.gt.1d-30) tauo2(i,21) = 1.d0 / 
-     $        (ch21 * o3px8 * co2x8)
-
-         if(jdistot8(5,i).gt.1d-30) tauh2(i,22) = 1.d0 / jdistot8(5,i)
-
-         !minimum lifetime
-         tminco2(i) = 1.d30
-         tmino2(i) = 1.d30
-         tmino3p(i) = 1.d30
-         tminco(i) = 1.d30
-         tminh(i) = 1.d30
-         tminoh(i) = 1.d30
-         tminho2(i) = 1.d30
-         tminh2(i) = 1.d30
-         tminh2o(i) = 1.d30
-         tmino1d(i) = 1.d30
-         tminh2o2(i) = 1.d30
-         
-         do j=1,nreact
-            tminco2(i) = min(tminco2(i),tauco2(i,j))
-            tmino2(i) = min(tmino2(i),tauo2(i,j))
-            tmino3p(i) = min(tmino3p(i),tauo3p(i,j))
-            tminco(i) = min(tminco(i),tauco(i,j))
-            tminh(i) = min(tminh(i),tauh(i,j))
-            tminoh(i) = min(tminoh(i),tauoh(i,j))
-            tminho2(i) = min(tminho2(i),tauho2(i,j))
-            tminh2(i) = min(tminh2(i),tauh2(i,j))
-            tminh2o(i) = min(tminh2o(i),tauh2o(i,j))
-            tmino1d(i) = min(tmino1d(i),tauo1d(i,j))
-            tminh2o2(i) = min(tminh2o2(i),tauh2o2(i,j))
-         end do
-
-         tmin(i) = 1.d30
-         tmin(i) = min(tmin(i),tminco2(i))
-         tmin(i) = min(tmin(i),tmino2(i))
-         tmin(i) = min(tmin(i),tmino3p(i))
-         tmin(i) = min(tmin(i),tminco(i))
-         tmin(i) = min(tmin(i),tminh(i))
-         tmin(i) = min(tmin(i),tminh2(i))
-         tmin(i) = min(tmin(i),tminh2o(i))
-         tmin(i) = min(tmin(i),tminh2o2(i))
-
-
-         !Internal timestep
-         if(tmin(i)/10.d0.gt.timestep8*3600.d0) then
-            deltat = timestep8 * 3600.d0
-         else
-            deltat = tmin(i)/10.d0
-         end if
-         if(deltat.ne.timestep8*3600.d0) then
-            n=int(timestep8*3600.d0/deltat)+1
-            deltat=timestep8*3600.d0/n
-         endif
-
-
-         !Photochemical equilibrium for O1D,OH and HO2?
-         if(tmino1d(i).lt.deltat/5.d0) then
-            o1d_eq(i)='Y'
-         else 
-            o1d_eq(i)='N'
-c            o1d_eq(i)='Y'
-         endif
-         if(tminoh(i).lt.deltat/5.d0) then
-           oh_eq(i)='Y'
-         else
-           oh_eq(i)='N'
-c           oh_eq(i)='Y'
-         end if
-         if(tminho2(i).lt.deltat/5.d0) then
-            ho2_eq(i)='Y'
-         else
-            ho2_eq(i)='N'
-c            ho2_eq(i)='Y'
-         endif
-
-
-C     Start: temporal loop
-c        do dt=deltat,timestep8*3600.d0,deltat
-         do nt=1,int(timestep8*3600.d0/deltat)
-            dt=nt*deltat
-
-            !Productions and losses
-            do j=1,nreact
-               Lco2(i,j) = 0.d0
-               Pco2(i,j) = 0.d0
-               Lo2(i,j) = 0.d0
-               Po2(i,j) = 0.d0
-               Lo3p(i,j) = 0.d0
-               Po3p(i,j) = 0.d0
-               Lco(i,j) = 0.d0
-               Pco(i,j) = 0.d0
-               Ph(i,j) = 0.d0
-               Lh(i,j) = 0.d0
-               Poh(i,j) = 0.d0
-               Loh(i,j) = 0.d0
-               Pho2(i,j) = 0.d0
-               Lho2(i,j) = 0.d0
-               Ph2(i,j) = 0.d0
-               Lh2(i,j) = 0.d0
-               Ph2o(i,j) = 0.d0
-               Lh2o(i,j) = 0.d0
-               Po1d(i,j) = 0.d0
-               Lo1d(i,j) = 0.d0
-               Ph2o2(i,j) = 0.d0
-               Lh2o2(i,j) = 0.d0
-            end do
-            Pco2tot(i) = 0.d0
-            Lco2tot(i) = 0.d0
-            Po2tot(i) = 0.d0
-            Lo2tot(i) = 0.d0
-            Po3ptot(i) = 0.d0
-            Lo3ptot(i) = 0.d0
-            Pcotot(i) = 0.d0
-            Lcotot(i) = 0.d0
-            Phtot(i) = 0.d0
-            Lhtot(i) = 0.d0
-            Pohtot(i) = 0.d0
-            Lohtot(i) = 0.d0
-            Pho2tot(i) = 0.d0
-            Lho2tot(i) = 0.d0
-            Ph2tot(i) = 0.d0
-            Lh2tot(i) = 0.d0
-            Ph2otot(i) = 0.d0
-            Lh2otot(i) = 0.d0
-            Po1dtot(i) = 0.d0
-            Lo1dtot(i) = 0.d0
-            Ph2o2tot(i) = 0.d0
-            Lh2o2tot(i) = 0.d0
-
-
-c           R1: CO2 + hv -> CO + O
-
-            Lco2(i,1) = jdistot8(1,i)
-            Pco(i,1) = co2x8 * jdistot8(1,i)
-            Po3p(i,1) = co2x8 * jdistot8(1,i)
-
-
-c           R16(1b): CO2 + hv -> CO + O1D
-
-            Lco2(i,16) = jdistot8_b(1,i)
-            Pco(i,16) = co2x8 * jdistot8_b(1,i)
-            Po1d(i,16) = co2x8 * jdistot8_b(1,i)
-
-
-c           R2: H + O2 + CO2 -> HO2 + CO2
-
-            Lh(i,2) = ch2 * o2x8 * co2x8
-            Lo2(i,2) = ch2 * hx8 * co2x8
-            Pho2(i,2) = ch2 * hx8 * o2x8 * co2x8
-
-
-c           R3: O + HO2 -> OH + O2
-
-            Lo3p(i,3) = ch3 * ho2x8 
-            Lho2(i,3) = ch3 * o3px8
-            Poh(i,3) = ch3 * o3px8 * ho2x8
-            Po2(i,3) = ch3 * o3px8 * ho2x8
-
-
-c           R4: CO + OH -> CO2 + H
-
-            Lco(i,4) = ch4 * ohx8
-            Loh(i,4) = ch4 * cox8
-            Pco2(i,4) = ch4 * cox8 * ohx8
-            Ph(i,4) = ch4 * cox8 * ohx8
-
-
-c           R5: 2HO2 -> H2O2 + O2
-
-            Lho2(i,5) = 2.d0 * ch5 * ho2x8 
-            Po2(i,5) = ch5 * ho2x8 * ho2x8 
-            Ph2o2(i,5) = ch5 * ho2x8 * ho2x8
-
-
-c           R6: H2O2 + hv -> 2OH
-
-            Lh2o2(i,6) = jdistot8(6,i) 
-            Poh(i,6) = jdistot8(6,i) * h2o2x8
-
-
-c           R7: OH + HO2 -> H2O + O2
-
-            Loh(i,7) = ch7 * ho2x8 
-            Lho2(i,7) = ch7 * ohx8
-            Po2(i,7) = ch7 * ohx8 * ho2x8
-            Ph2o(i,7) = ch7 * ohx8 * ho2x8
-
-
-c           R8: H20 + hv -> H + OH
-
-            Lh2o(i,8) = jdistot8(4,i)
-            Ph(i,8) = jdistot8(4,i) * h2ox8
-            Poh(i,8) = jdistot8(4,i) * h2ox8
-
-
-c           R9: O(1D) + H2O -> 2OH
-
-            Lo1d(i,9) = ch9 * h2ox8
-            Lh2o(i,9) = ch9 * o1dx8
-            Poh(i,9) = 2.d0 * ch9 * o1dx8 * h2ox8 
-         
-
-c           R10: 2O + CO2 -> O2 + CO2
-
-            Lo3p(i,10) = 2.d0 * ch10 * o3px8 * co2x8  
-            Po2(i,10) = ch10 * o3px8 * o3px8 * co2x8
-
-
-c           R11: O + OH -> O2 + H
-
-            Lo3p(i,11) = ch11 * ohx8
-            Loh(i,11) = ch11 * o3px8
-            Po2(i,11) = ch11 * o3px8 * ohx8
-            Ph(i,11) = ch11 * o3px8 * ohx8
-
-
-c           R12: O2 + hv -> 2O
-
-            Lo2(i,12) = jdistot8(2,i)
-            Po3p(i,12) = 2.d0 * jdistot8(2,i) * o2x8
-
-
-c           R17(12b): O2 + hv -> O + O1D
-
-            Lo2(i,17) = jdistot8_b(2,i)
-            Po3p(i,17) = jdistot8_b(2,i) * o2x8
-            Po1d(i,17) = jdistot8_b(2,i) * o2x8
-
-
-c           R13: H + HO2 -> H2 + O2
-
-            Lh(i,13) = ch13 * ho2x8 
-            Lho2(i,13) = ch13 * hx8
-            Ph2(i,13) = ch13 * hx8 * ho2x8
-            Po2(i,13) = ch13 * hx8 * ho2x8
-
-
-c           R14: O(1D) + H2 -> H + OH
-
-            Lo1d(i,14) = ch14 * h2x8
-            Lh2(i,14) = ch14 * o1dx8
-            Ph(i,14) = ch14 * o1dx8 * h2x8
-            Poh(i,14) = ch14 * o1dx8 * h2x8
-
-
-c           R15: OH + H2 -> H + H20
-
-            Loh(i,15) = ch15 * h2x8
-            Lh2(i,15) = ch15 * ohx8
-            Ph(i,15) = ch15 * ohx8 * h2x8
-            Ph2o(i,15) = ch15 * ohx8 * h2x8
-
-
-c           R18: OH + H2O2 -> H2O + HO2
-
-            Loh(i,18) = ch18 * h2o2x8
-            Lh2o2(i,18) = ch18 * ohx8
-            Ph2o(i,18) = ch18 * ohx8 * h2o2x8
-            Pho2(i,18) = ch18 * ohx8 * h2o2x8
-
-
-c           R19: O(1D) + CO2 -> O + CO2
-
-            Lo1d(i,19) = ch19 * co2x8
-            Po3p(i,19) = ch19 * o1dx8 * co2x8
-
-
-c           R20: O(1D) + O2 -> O + O2
-
-            Lo1d(i,20) = ch20 * o2x8
-            Po3p(i,20) = ch20 * o1dx8 * o2x8
-
-
-c           R21: O + O2 + CO2 -> O3 + CO2
-
-            Lo3p(i,21) = ch21 * o2x8 * co2x8
-            Lo2(i,21) = ch21 * o3px8 * co2x8
-
-
-c           R22: H2 + hv -> 2H
-
-            Lh2(i,22) = jdistot8(5,i)
-            Ph(i,22) = 2.d0 * jdistot8(5,i) * h2x8 
-
-
-            do j=1,nreact
-               Pco2tot(i) = Pco2tot(i) + Pco2(i,j)
-               Lco2tot(i) = Lco2tot(i) + Lco2(i,j)
-               Po2tot(i) = Po2tot(i) + Po2(i,j)
-               Lo2tot(i) = Lo2tot(i) + Lo2(i,j)
-               Po3ptot(i) = Po3ptot(i) + Po3p(i,j)
-               Lo3ptot(i) = Lo3ptot(i) + Lo3p(i,j)
-               Pcotot(i) = Pcotot(i) + Pco(i,j)
-               Lcotot(i) = Lcotot(i) + Lco(i,j)
-               Phtot(i) = Phtot(i) + Ph(i,j)
-               Lhtot(i) = Lhtot(i) + Lh(i,j)
-               Pohtot(i) = Pohtot(i) + Poh(i,j)
-               Lohtot(i) = Lohtot(i) + Loh(i,j)
-               Pho2tot(i) = Pho2tot(i) + Pho2(i,j)
-               Lho2tot(i) = Lho2tot(i) + Lho2(i,j)
-               Ph2tot(i) = Ph2tot(i) + Ph2(i,j)
-               Lh2tot(i) = Lh2tot(i) + Lh2(i,j)
-               Ph2otot(i) = Ph2otot(i) + Ph2o(i,j)
-               Lh2otot(i) = Lh2otot(i) + Lh2o(i,j)
-               Po1dtot(i) = Po1dtot(i) + Po1d(i,j)
-               Lo1dtot(i) = Lo1dtot(i) + Lo1d(i,j)
-               Ph2o2tot(i) = Ph2o2tot(i) + Ph2o2(i,j)
-               Lh2o2tot(i) = Lh2o2tot(i) + Lh2o2(i,j)
-            end do
-
-
-            !New concentrations, implicit scheme
-            co2x8 = (co2x8 + Pco2tot(i) * deltat) /
-     $                (1.d0 + Lco2tot(i) * deltat)
-            o2x8 = (o2x8 + Po2tot(i) * deltat) /
-     $               (1.d0 + Lo2tot(i) * deltat)
-            o3px8 = (o3px8 + Po3ptot(i) * deltat) /
-     $                (1.d0 + Lo3ptot(i) * deltat)
-            cox8 = (cox8 + Pcotot(i) * deltat) /
-     $               (1.d0 + Lcotot(i) * deltat)
-            hx8 = (hx8 + Phtot(i) * deltat) /
-     $              (1.d0 + Lhtot(i) * deltat)
-             h2x8 = (h2x8 + Ph2tot(i) * deltat) /
-     $               (1.d0 + Lh2tot(i) * deltat)
-            h2ox8 = (h2ox8 + Ph2otot(i) * deltat) / 
-     $                (1.d0 + Lh2otot(i) * deltat)
-            h2o2x8 = (h2o2x8 + Ph2o2tot(i) * deltat) /
-     $                (1.d0 + Lh2o2tot(i) * deltat)
-
-            if(o1d_eq(i).eq.'Y') then
-               auxp=jdistot8_b(1,i)*co2x8+jdistot8_b(2,i)*o2x8
-               auxl=ch9*h2ox8+ch14*h2x8+ch19*co2x8+ch20*o2x8
-               if(auxl.ne.0.) then
-                  o1dx8=auxp/auxl
-               else
-                  o1dx8=o1dx8+Po1dtot(i)*deltat
-               endif
-            else
-               o1dx8 = (o1dx8 + Po1dtot(i) * deltat) /
-     $                   (1.d0 + Lo1dtot(i) * deltat)
-            end if
-
-            if(oh_eq(i).eq.'Y') then
-               auxp=ch3*o3px8*ho2x8+jdistot(4,i)*h2ox8+
-     $              2.d0*ch9*o1dx8*h2ox8+ch14*o1dx8*h2x8+
-     $              2.d0*jdistot(6,i)*h2o2x8
-               auxl=ch4*cox8+ch7*ho2x8+ch11*o3px8+ch15*h2x8+
-     $              ch18*h2o2x8
-               if(auxl.ne.0.) then
-                  ohx8=auxp/auxl
-               else
-                  ohx8=ohx8+Pohtot(i)*deltat
-               end if
-            else
-               ohx8 = (ohx8 + Pohtot(i) * deltat) /
-     $                  (1.d0 + Lohtot(i) * deltat)
-            end if
-
-            if(ho2_eq(i).eq.'Y') then
-               auxp=ch2*hx8*o2x8*co2x8+ch18*ohx8*h2o2x8
-               auxl=ch3*o3px8+2.d0*ch5*ho2x8+ch7*ohx8+ch13*hx8
-               if(auxl.ne.0.) then
-                  ho2x8=auxp/auxl
-               else
-                  ho2x8=ho2x8+Pho2tot(i)*deltat
-               end if
-            else
-               ho2x8 = (ho2x8 + Pho2tot(i) * deltat) /
-     $                  (1.d0 + Lho2tot(i) * deltat)
-            end if
-
-
-C        End: temporal loop
-         end do
-         
-         
-         co2x(i)  = real(co2x8)
-         o2x(i)   = real(o2x8)
-         o3px(i)  = real(o3px8)
-         cox(i)   = real(cox8)
-         hx(i)    = real(hx8)
-         ohx(i)   = real(ohx8)
-         ho2x(i)  = real(ho2x8)
-         h2x(i)   = real(h2x8)
-         h2ox(i)  = real(h2ox8)
-         h2o2x(i) = real(h2o2x8)
-         o1dx(i)  = real(o1dx8)
-
-c         co2x(i)=(co2x8)
-c         o2x(i)=(o2x8)
-c         o3px(i)=(o3px8)
-c         cox(i)=(cox8)
-c         hx(i)=(hx8)
-c         ohx(i)=(ohx8)
-c         ho2x(i)=(ho2x8)
-c         h2x(i)=(h2x8)
-c         h2ox(i)=(h2ox8)
-c         h2o2x(i)=(h2o2x8)
-c         o1dx(i)=(o1dx8)
-
-C     End: altitude loop
-      end do
-
-      return
-
-      end
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/paramfoto_compact.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/paramfoto_compact.F	(revision 635)
+++ trunk/LMDZ.MARS/libf/aeronomars/paramfoto_compact.F	(revision 635)
@@ -0,0 +1,4920 @@
+
+c**********************************************************************
+
+      subroutine paramfoto_compact
+     $(ig,chemthermod,lswitch,tx,timestep,zenit,zx,rm,nesptherm)
+  
+c     may 2008      FGG+MALV,GG             
+c**********************************************************************
+
+      implicit none
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'iono.h'
+
+c     arguments
+
+      integer lswitch,ig,nesptherm,chemthermod
+      real zdens(nlayermx)
+      real tx(nlayermx)
+      real zenit
+      real zx(nlayermx)
+      real rm(nlayermx,nesptherm)
+      real timestep
+
+
+c     local variables
+
+      integer ij0,l0
+      real*8  deltat,timefrac_sec
+      real*8  co2xnew,o2xnew,o3pxnew,coxnew,hxnew,ohxnew
+      real*8  ho2xnew,h2xnew
+      real*8  h2o2xnew,o1dxnew,o3xnew,h2oxnew
+      real*8  noxnew, nxnew, n2xnew, n2dxnew,no2xnew
+      real*8  oplusxnew, o2plusxnew,co2plusxnew
+      real*8  nplusxnew, n2plusxnew,noplusxnew, hplusxnew
+      real*8  electxnew,coplusxnew, cplusxnew, hco2plusxnew
+
+      real*8  co2xoutput,o2xoutput,o3pxoutput,coxoutput
+      real*8  ho2xoutput,h2xoutput,hxoutput,ohxoutput
+      real*8  h2o2xoutput,o1dxoutput,o3xoutput,h2oxoutput
+      real*8  nxoutput,noxoutput,n2xoutput,n2dxoutput,no2xoutput
+      real*8  co2plusxoutput,coplusxoutput,oplusxoutput,o2plusxoutput
+      real*8  cplusxoutput,noplusxoutput,n2plusxoutput,hplusxoutput
+      real*8  electxoutput,nplusxoutput,hco2plusxoutput
+      real*8  electxoutput_timemarching, electxoutput_neutrality 
+
+      real*8  co2xinput,o2xinput,o3pxinput,coxinput
+      real*8  ho2xinput,h2xinput,hxinput,ohxinput
+      real*8  h2o2xinput,o1dxinput,o3xinput,h2oxinput
+      real*8  nxinput,noxinput,n2xinput,n2dxinput,no2xinput
+      real*8  co2plusxinput,coplusxinput,oplusxinput,o2plusxinput
+      real*8  cplusxinput,noplusxinput,n2plusxinput,hplusxinput
+      real*8  electxinput,nplusxinput,hco2plusxinput
+
+      real*8  co2xini,o2xini,o3pxini,coxini
+      real*8  ho2xini,h2xini,hxini,ohxini
+      real*8  h2o2xini,o1dxini,o3xini,h2oxini
+      real*8  nxini,noxini,n2xini,n2dxini,no2xini
+      real*8  co2plusxini,coplusxini,oplusxini,o2plusxini
+      real*8  cplusxini,noplusxini,n2plusxini,hplusxini
+      real*8  electxini,nplusxini,hco2plusxini
+
+      real*8  dco2x,do2x,do3px,dcox,dhx,dohx,dho2x,dh2x
+      real*8  dh2ox,dh2o2x,do1dx,do3x,dnx,dnox,dn2x,dn2dx,dno2x
+      real*8  dco2plusx,dcoplusx,doplusx,do2plusx 
+      real*8  dcplusx,dnoplusx,dn2plusx,dhplusx,dhco2plusx
+      real*8  delectx,dnplusx
+
+      real*8  jdistot8(nabs,nlayermx)
+      real*8  jdistot8_b(nabs,nlayermx)
+      real*8  jion8(nabs,nlayermx,4)
+      real*8  tx8
+	  
+      
+
+      real*8  alfa_laststep, IonMostAbundant
+
+      real*8  tmin(nlayermx)
+      real*8  fmargin1,critere
+
+      integer compmin(nlayermx)
+      integer i,j,k
+      integer numpasos
+      integer n_comp_en_EQ(nlayermx), paso
+
+! Tracer indexes in the thermospheric chemistry:
+!!! ATTENTION. These values have to be identical to those in chemthermos.F90
+!!! If the values are changed there, the same has to be done here  !!!
+      integer,parameter :: i_co2=1
+      integer,parameter :: i_o2=2
+      integer,parameter :: i_o=3
+      integer,parameter :: i_co=4
+      integer,parameter :: i_h=5
+      integer,parameter :: i_oh=6
+      integer,parameter :: i_ho2=7
+      integer,parameter :: i_h2=8
+      integer,parameter :: i_h2o=9
+      integer,parameter :: i_h2o2=10
+      integer,parameter :: i_o1d=11
+      integer,parameter :: i_o3=12
+      integer,parameter :: i_n2=13
+      integer,parameter :: i_n=14
+      integer,parameter :: i_no=15
+      integer,parameter :: i_n2d=16
+      integer,parameter :: i_no2=17
+      integer,parameter :: i_co2plus=18
+      integer,parameter :: i_oplus=19
+      integer,parameter :: i_o2plus=20
+      integer,parameter :: i_coplus=21
+      integer,parameter :: i_cplus=22
+      integer,parameter :: i_nplus=23
+      integer,parameter :: i_noplus=24
+      integer,parameter :: i_n2plus=25
+      integer,parameter :: i_hplus=26
+      integer,parameter :: i_hco2plus=27
+      integer,parameter :: i_elec=28
+
+c     formats
+
+c**********************************************************************
+
+
+	ij0=302
+	l0=25
+
+C     Start: altitude loop
+      timefrac_sec=dble(timestep)
+
+      do i=nlayermx,lswitch,-1
+c     Concentrations to real*8
+
+c     Hay dos maneras de adaptar estos a los flags fotoquimicos:
+c     1. Se definen todas las concentraciones, dejando como 0 las que no
+c     se utilicen en la quimica requerida. Esto es posiblemente lo mas
+c     sencillo, ya que no habria que modificar las llamadas a las subrutinas
+c     pero puede ser menos seguro y mas caro computacionalmente
+c     2. Se definen nuevas variables rmini, rminput, rmoutput como arrays
+c     con dimension ajustable al numero de compuestos. Esto es posiblemente
+c     mas seguro, compacto y rapido, pero implica cambiar las llamadas a 
+c     todas las subrutinas.
+c     Empiezo probando la primera manera.
+
+         tx8=dble(tx(i))
+
+         co2xini=dble(rm(i,i_co2))
+         o2xini=dble(rm(i,i_o2))
+         o3pxini=dble(rm(i,i_o))
+         coxini=dble(rm(i,i_co))
+         hxini=dble(rm(i,i_h))
+         ohxini=dble(rm(i,i_oh))
+         ho2xini=dble(rm(i,i_ho2))
+         h2xini=dble(rm(i,i_h2))
+         h2oxini=dble(rm(i,i_h2o))
+         h2o2xini=dble(rm(i,i_h2o2))
+         o1dxini=dble(rm(i,i_o1d))
+         !Only if O3, N or ion chemistry requested
+         if(chemthermod.ge.1) o3xini=dble(rm(i,i_o3))
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+            n2xini=dble(rm(i,i_n2))
+            nxini=dble(rm(i,i_n))
+            noxini=dble(rm(i,i_no))
+            n2dxini=dble(rm(i,i_n2d))
+            no2xini=dble(rm(i,i_no2))
+         endif
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+            co2plusxini=dble(rm(i,i_co2plus))
+            oplusxini=dble(rm(i,i_oplus))
+            o2plusxini=dble(rm(i,i_o2plus))
+            coplusxini=dble(rm(i,i_coplus))
+            cplusxini=dble(rm(i,i_cplus))
+            nplusxini=dble(rm(i,i_nplus))
+            n2plusxini=dble(rm(i,i_n2plus))
+            noplusxini=dble(rm(i,i_noplus))
+            hplusxini=dble(rm(i,i_hplus))
+            hco2plusxini=dble(rm(i,i_hco2plus))
+            electxini=dble(rm(i,i_elec))
+         endif
+
+
+         !Calculation of photodissociation and photoionization rates
+         !from photoabsorption rates and ionization-to-dissociation 
+         !branching ratios
+         call phdisrate(ig,chemthermod,zenit,i)   
+         ! Conversion to double precision
+         do j=1,nabs
+	    jdistot8(j,i) = dble(jdistot(j,i))
+            jdistot8_b(j,i) = dble(jdistot_b(j,i))
+            do k=1,4
+               jion8(j,i,k)=dble(jion(j,i,k))
+            enddo
+         end do
+
+         !Reaction rates
+         call getch( ig, chemthermod,tx8, co2xini, zx(i))
+		 
+         !Lifetimes and temporal integration 
+         call lifetimes(ig,i,chemthermod,zenit,zx,
+     $        jdistot8,jdistot8_b,jion8,
+     $        tmin(i),compmin(i), 
+     $        n_comp_en_EQ(i),co2xini,o2xini,o3pxini,coxini,hxini,
+     $        ohxini,ho2xini,h2xini,h2oxini,h2o2xini,o1dxini,o3xini,
+     $        n2xini,nxini,noxini,no2xini,n2dxini,co2plusxini,oplusxini,
+     $        o2plusxini,coplusxini,cplusxini,nplusxini,noplusxini,
+     $        n2plusxini,hplusxini,hco2plusxini,electxini )
+
+         !Calculation of the internal timestep and revision of the 
+         !validity of the photochemical equilibrium approximation 
+         !for each species
+
+! JYC criteria added to avoid instabilities in (H) + (O+) <-> (H+) + (O) reactions when H+ is important
+
+	fmargin1=1
+        !Only if ion chemistry requested
+        if(chemthermod.eq.3) then
+           critere=hplusxini/(o3pxini+hxini+h2xini)
+           if (critere .gt. 5d-4) then
+              fmargin1=2000.*critere
+              if (fmargin1 .gt. 50.) fmargin1=50
+!	print*,'long time step chimie',ig,i,critere,fmargin1
+           endif
+        endif   !Of chemthermod.eq.3
+
+         call timemarching ( ig,i,chemthermod,n_comp_en_EQ,compmin,
+     $       tmin,timefrac_sec, deltat,fmargin1)
+
+
+         !Number of timesteps
+         numpasos = int( timefrac_sec / deltat ) 
+         alfa_laststep = 1.d0 + timefrac_sec/deltat - dble(numpasos)
+
+         do paso=1,numpasos  
+
+            !Concentrations at the first step
+            if(paso.eq.1) then
+               co2xinput=co2xini
+               o2xinput=o2xini
+               o3pxinput=o3pxini
+               coxinput=coxini
+               hxinput=hxini
+               ohxinput=ohxini
+               ho2xinput=ho2xini
+               h2xinput=h2xini
+               h2oxinput=h2oxini
+               h2o2xinput=h2o2xini
+               o1dxinput=o1dxini
+               o3xinput=o3xini
+               nxinput=nxini
+               noxinput=noxini
+               n2xinput=n2xini
+               n2dxinput=n2dxini
+               no2xinput=no2xini
+               !
+	       co2plusxinput = co2plusxini
+	       oplusxinput   = oplusxini
+               o2plusxinput  = o2plusxini
+               coplusxinput  = coplusxini
+               cplusxinput   = cplusxini
+               nplusxinput   = nplusxini
+               n2plusxinput  = n2plusxini
+               noplusxinput  = noplusxini
+               hplusxinput   = hplusxini
+               hco2plusxinput= hco2plusxini
+               electxinput   = electxini
+            else
+               !Concentrations for the new step
+               co2xinput=co2xinput+dco2x
+               o2xinput=o2xinput+do2x
+               o3pxinput=o3pxinput+do3px
+               coxinput=coxinput+dcox
+               hxinput=hxinput+dhx
+               ohxinput=ohxinput+dohx
+               ho2xinput=ho2xinput+dho2x
+               h2xinput=h2xinput+dh2x
+               h2oxinput=h2oxinput+dh2ox
+               h2o2xinput=h2o2xinput+dh2o2x
+               o1dxinput=o1dxinput+do1dx
+               !Only if O3, N or ion chemistry requested
+               if(chemthermod.ge.1) o3xinput=o3xinput+do3x
+               !Only if N or ion chemistry requested
+               if(chemthermod.ge.2) then
+                  nxinput=nxinput+dnx
+                  noxinput=noxinput+dnox
+                  n2xinput=n2xinput+dn2x
+                  n2dxinput=n2dxinput+dn2dx
+                  no2xinput=no2xinput+dno2x
+               endif
+	       !Only if ion chemistry requested
+               if(chemthermod.eq.3) then
+                  co2plusxinput = co2plusxinput + dco2plusx
+                  oplusxinput   = oplusxinput   + doplusx
+                  o2plusxinput  = o2plusxinput  + do2plusx
+                  coplusxinput  = coplusxinput  + dcoplusx
+                  cplusxinput   = cplusxinput   + dcplusx
+                  nplusxinput   = nplusxinput   + dnplusx
+                  n2plusxinput  = n2plusxinput  + dn2plusx
+                  noplusxinput  = noplusxinput  + dnoplusx
+                  hplusxinput   = hplusxinput   + dhplusx
+                  hco2plusxinput= hco2plusxinput+ dhco2plusx
+                  electxinput   = electxinput   + delectx
+               endif
+
+            end if
+            !Calculation of productions and losses
+            call prodsandlosses ( ig, i , chemthermod,zenit, zx,
+     &                 jdistot8, jdistot8_b, jion8,
+     &                              co2xinput, o2xinput, o3pxinput,
+     &                              coxinput,  h2xinput, o3xinput,
+     &                              h2oxinput, nxinput,  noxinput, 
+     &                              h2o2xinput, n2xinput, 
+     &                           o1dxinput, ohxinput,  ho2xinput,
+     &                           hxinput,   n2dxinput, no2xinput,
+     &                 co2plusxinput,  o2plusxinput, coplusxinput,
+     &                 oplusxinput,    cplusxinput,  noplusxinput,
+     &                 n2plusxinput,   hplusxinput,  nplusxinput,
+     &                 hco2plusxinput,electxinput )
+
+
+            !New abundances, implicit scheme for the timemarching
+
+            !First, for the 11 species that can not be in PE
+            !( CO2, O2, O3P, CO, H2, H2O, H2O2, O3, N, NO, N2 )
+
+            call implicito ( ig, co2xoutput,  ' CO2', 
+     &             co2xinput, Pco2tot(i), Lco2tot(i), deltat )
+            call implicito ( ig, o2xoutput,   '  O2', 
+     &             o2xinput, Po2tot(i), Lo2tot(i), deltat )
+            call implicito ( ig, o3pxoutput,  ' O3P', 
+     &             o3pxinput, Po3ptot(i), Lo3ptot(i), deltat )
+            call implicito ( ig, coxoutput,   '  CO', 
+     &             coxinput, Pcotot(i), Lcotot(i), deltat )
+            call implicito ( ig, h2xoutput,   '  H2', 
+     &             h2xinput, Ph2tot(i), Lh2tot(i), deltat )
+            call implicito ( ig, h2oxoutput,  ' H2O', 
+     &             h2oxinput, Ph2otot(i), Lh2otot(i), deltat )
+            call implicito ( ig, h2o2xoutput, 'H2O2', 
+     &             h2o2xinput, Ph2o2tot(i), Lh2o2tot(i), deltat )
+            !only if O3, N or ion chemistry requested
+            if(chemthermod.ge.1) 
+     $           call implicito ( ig, o3xoutput,   '  O3', 
+     &             o3xinput, Po3tot(i), Lo3tot(i), deltat )
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               call implicito ( ig, nxoutput,    '   N', 
+     &              nxinput, Pntot(i), Lntot(i), deltat )
+               call implicito ( ig, noxoutput,   '  NO', 
+     &              noxinput, Pnotot(i), Lnotot(i), deltat )
+               call implicito ( ig, n2xoutput,   '  N2', 
+     &              n2xinput, Pn2tot(i), Ln2tot(i), deltat )
+            endif
+
+
+            !Second, 6+10 species that can be in PE, but are not
+            ! 6 neutral , O1D, OH, HO2, H, N2D, NO2
+            if(o1d_eq(i).eq.'N') then
+               call implicito ( ig, o1dxoutput,   ' O1D', 
+     &             o1dxinput, Po1dtot(i), Lo1dtot(i), deltat )
+            end if
+            if(oh_eq(i).eq.'N') then
+               call implicito ( ig, ohxoutput,   '  OH', 
+     &             ohxinput, Pohtot(i), Lohtot(i), deltat )
+            end if
+            if(ho2_eq(i).eq.'N') then
+               call implicito ( ig, ho2xoutput,   ' HO2', 
+     &             ho2xinput, Pho2tot(i), Lho2tot(i), deltat )
+            end if
+            if(h_eq(i).eq.'N') then
+               call implicito ( ig, hxoutput,   '   H', 
+     &             hxinput, Phtot(i), Lhtot(i), deltat )
+            end if
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if(n2d_eq(i).eq.'N') then
+                  call implicito ( ig, n2dxoutput,   ' N2D', 
+     &                 n2dxinput, Pn2dtot(i), Ln2dtot(i), deltat )
+               end if
+               if(no2_eq(i).eq.'N') then
+                  call implicito ( ig, no2xoutput,   ' NO2', 
+     &                 no2xinput, Pno2tot(i), Lno2tot(i), deltat )
+               end if
+            endif
+
+            ! 9 ions (all of them) and electrons
+            !Only if ion chemistry requested
+            if(chemthermod.ge.3) then
+               if(n2plus_eq(i).eq.'N') then
+                  call implicito ( ig, n2plusxoutput,   ' N2+', 
+     &                 n2plusxinput,Pn2plustot(i),Ln2plustot(i),deltat)
+               end if
+               if(cplus_eq(i).eq.'N') then
+                  call implicito ( ig, cplusxoutput,   '  C+', 
+     &                 cplusxinput,Pcplustot(i),Lcplustot(i),deltat)
+               end if
+               if(coplus_eq(i).eq.'N') then
+                  call implicito ( ig, coplusxoutput,   ' CO+', 
+     &                 coplusxinput,Pcoplustot(i),Lcoplustot(i),deltat)
+               end if
+               if(co2plus_eq(i).eq.'N') then
+                  call implicito ( ig, co2plusxoutput,   'CO2+', 
+     &               co2plusxinput,Pco2plustot(i),Lco2plustot(i),deltat)
+               end if
+               if(oplus_eq(i).eq.'N') then
+                  call implicito ( ig, oplusxoutput,   '  O+', 
+     &                 oplusxinput,Poplustot(i),Loplustot(i),deltat)
+               end if
+               if(hplus_eq(i).eq.'N') then 
+                  call implicito ( ig, hplusxoutput,   '  H+', 
+     &                 hplusxinput,Phplustot(i),Lhplustot(i),deltat)
+               end if            
+               if(o2plus_eq(i).eq.'N') then
+                  call implicito ( ig, o2plusxoutput,   ' O2+', 
+     &                 o2plusxinput,Po2plustot(i),Lo2plustot(i),deltat)
+               end if
+               if(noplus_eq(i).eq.'N') then
+                  call implicito ( ig, noplusxoutput,   ' NO+', 
+     &                 noplusxinput,Pnoplustot(i),Lnoplustot(i),deltat)
+               end if
+               if(nplus_eq(i).eq.'N') then
+                  call implicito ( ig, nplusxoutput,   '  N+', 
+     &                 nplusxinput,Pnplustot(i),Lnplustot(i),deltat)
+               end if
+               if(hco2plus_eq(i).eq.'N') then
+                  call implicito ( ig, hco2plusxoutput,   'CO2+', 
+     &               hco2plusxinput,Phco2plustot(i),Lhco2plustot(i),
+     $                 deltat)
+               end if
+           ! elect
+               call implicito ( ig, electxoutput_timemarching,   'elec', 
+     &              electxinput,Pelecttot(i),Lelecttot(i),deltat)
+            endif !Of chemthermod.eq.3
+
+
+            !Third, those species (among the 16 that can be in PE) that are in PE
+            call EF_oscilacion
+     &           ( ig,i, paso,chemthermod,zenit, zx,
+     &           jdistot8, jdistot8_b,jion8,
+     &           deltat,
+     $           co2xoutput,     co2xinput,
+     $           o2xoutput,      o2xinput,
+     $           o3pxoutput,     o3pxinput,
+     $           coxoutput,      coxinput,
+     $           h2xoutput,      h2xinput,
+     $           h2oxoutput,     h2oxinput,
+     $           h2o2xoutput,    h2o2xinput,
+     $           o3xoutput,      o3xinput,
+     $           nxoutput,       nxinput,
+     $           noxoutput,      noxinput,
+     $           n2xoutput,      n2xinput,
+     &           o1dxoutput, o1dxinput, 
+     &           ohxoutput,  ohxinput, 
+     &           ho2xoutput, ho2xinput, 
+     &           hxoutput,   hxinput, 
+     &           n2dxoutput,  n2dxinput, 
+     &           no2xoutput, no2xinput, 
+     &           co2plusxoutput, co2plusxinput, 
+     &           o2plusxoutput,  o2plusxinput, 
+     &           coplusxoutput,  coplusxinput, 
+     &           oplusxoutput,   oplusxinput, 
+     &           cplusxoutput,   cplusxinput, 
+     &           noplusxoutput,  noplusxinput, 
+     &           n2plusxoutput,  n2plusxinput, 
+     &           hplusxoutput,   hplusxinput, 
+     &           nplusxoutput,   nplusxinput,
+     $           hco2plusxoutput,hco2plusxinput,
+     &           electxoutput,   electxinput, 
+     &           electxoutput_timemarching )
+
+            !Electrons given by the condition of global neutrality
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               electxoutput = o2plusxoutput +
+     @              co2plusxoutput +
+     @              coplusxoutput +
+     @              oplusxoutput +
+     @              cplusxoutput +
+     @              n2plusxoutput +
+     @              nplusxoutput +
+     @              noplusxoutput +
+     @              hplusxoutput +
+     $              hco2plusxoutput
+               electxoutput_neutrality = electxoutput
+                                !
+               IonMostAbundant = o2plusxoutput
+               IonMostAbundant = max( co2plusxoutput, IonMostAbundant)
+               IonMostAbundant = max( coplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( oplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( cplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( n2plusxoutput, IonMostAbundant)
+               IonMostAbundant = max( noplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( nplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( hplusxoutput, IonMostAbundant)
+               IonMostAbundant = max( hco2plusxoutput, IonMostAbundant)
+               IonMostAbundant = IonMostAbundant / electxoutput
+            endif !Of chemthermod.eq.3
+
+            !Concentration changes for this time step
+            dco2x=co2xoutput-co2xinput
+            do2x=o2xoutput-o2xinput
+            do3px=o3pxoutput-o3pxinput
+            dcox=coxoutput-coxinput
+            dhx=hxoutput-hxinput
+            dohx=ohxoutput-ohxinput
+            dho2x=ho2xoutput-ho2xinput
+            dh2x=h2xoutput-h2xinput
+            dh2ox=h2oxoutput-h2oxinput
+            dh2o2x=h2o2xoutput-h2o2xinput
+            do1dx=o1dxoutput-o1dxinput
+            !Only if O3, N or ion chemistry requested
+            if(chemthermod.ge.1) do3x=o3xoutput-o3xinput
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               dnx=nxoutput-nxinput
+               dnox=noxoutput-noxinput
+               dn2x=n2xoutput-n2xinput
+               dn2dx=n2dxoutput-n2dxinput
+               dno2x=no2xoutput-no2xinput
+            endif
+	    !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               dco2plusx=co2plusxoutput-co2plusxinput
+               do2plusx=o2plusxoutput-o2plusxinput
+               doplusx=oplusxoutput-oplusxinput
+               dcoplusx=coplusxoutput-coplusxinput
+               dcplusx=cplusxoutput-cplusxinput
+               dnplusx=nplusxoutput-nplusxinput
+               dn2plusx=n2plusxoutput-n2plusxinput
+               dnoplusx=noplusxoutput-noplusxinput
+               dhplusx=hplusxoutput-hplusxinput
+               dhco2plusx=hco2plusxoutput-hco2plusxinput
+               delectx=electxoutput- electxinput
+            endif
+            if(paso.eq.numpasos) then		
+               !Final concentrations after last time step
+               co2xnew = co2xinput +  dco2x * alfa_laststep
+               if(co2xnew.lt.0)co2xnew=1.e-30
+               o2xnew = o2xinput +  do2x * alfa_laststep
+               if(o2xnew.lt.0)o2xnew=1.e-30
+               o3pxnew = o3pxinput +  do3px * alfa_laststep
+               if(o3pxnew.lt.0)o3pxnew=1.e-30
+               coxnew = coxinput +  dcox * alfa_laststep
+               if(coxnew.lt.0)coxnew=1.e-30
+               hxnew = hxinput +  dhx * alfa_laststep
+               if(hxnew.lt.0)hxnew=1.e-30
+               ohxnew = ohxinput +  dohx * alfa_laststep
+               if(ohxnew.lt.0)ohxnew=1.e-30
+               ho2xnew = ho2xinput +  dho2x * alfa_laststep
+               if(ho2xnew.lt.0)ho2xnew=1.e-30
+               h2xnew = h2xinput +  dh2x * alfa_laststep
+               if(h2xnew.lt.0)h2xnew=1.e-30
+               h2oxnew = h2oxinput +  dh2ox * alfa_laststep
+               if(h2oxnew.lt.0)h2oxnew=1.e-30
+               h2o2xnew = h2o2xinput +  dh2o2x * alfa_laststep
+               if(h2o2xnew.lt.0)h2o2xnew=1.e-30
+               o1dxnew = o1dxinput +  do1dx * alfa_laststep
+               if(o1dxnew.lt.0)o1dxnew=1.e-30
+               !Only if O3, N or ion chemistry requested
+               if(chemthermod.ge.1) then
+                  o3xnew = o3xinput +  do3x * alfa_laststep
+                  if(o3xnew.lt.0)o3xnew=1.e-30
+               endif
+               !Only if N or ion chemistry requested
+               if(chemthermod.ge.2) then
+                  nxnew = nxinput +  dnx * alfa_laststep
+                  if(nxnew.lt.0)nxnew=1.e-30
+                  noxnew = noxinput +  dnox * alfa_laststep
+                  if(noxnew.lt.0)noxnew=1.e-30
+                  n2xnew = n2xinput +  dn2x * alfa_laststep
+                  if(n2xnew.lt.0)n2xnew=1.e-30
+                  n2dxnew = n2dxinput +  dn2dx * alfa_laststep
+                  if(n2dxnew.lt.0)n2dxnew=1.e-30
+                  no2xnew = no2xinput +  dno2x * alfa_laststep
+                  if(no2xnew.lt.0)no2xnew=1.e-30
+               endif
+               !Only if ion chemistry requested
+               if(chemthermod.ge.3) then
+                  co2plusxnew = co2plusxinput+dco2plusx*alfa_laststep
+                  if(co2plusxnew.lt.0)co2plusxnew=1.e-30
+                  o2plusxnew = o2plusxinput+do2plusx*alfa_laststep
+                  if(o2plusxnew.lt.0)o2plusxnew=1.e-30
+                  oplusxnew = oplusxinput+doplusx*alfa_laststep
+                  if(oplusxnew.lt.0)oplusxnew=1.e-30
+                  coplusxnew = coplusxinput+dcoplusx*alfa_laststep
+                  if(coplusxnew.lt.0)coplusxnew=1.e-30
+                  nplusxnew = nplusxinput +dnplusx*alfa_laststep
+                  if(nplusxnew.lt.0)nplusxnew=1.e-30
+                  n2plusxnew = n2plusxinput+dn2plusx*alfa_laststep
+                  if(n2plusxnew.lt.0)n2plusxnew=1.e-30
+                  noplusxnew = noplusxinput+dnoplusx*alfa_laststep
+                  if(noplusxnew.lt.0)noplusxnew=1.e-30
+                  hplusxnew = hplusxinput+dhplusx*alfa_laststep
+                  if(hplusxnew.lt.0)hplusxnew=1.e-30
+                  cplusxnew = cplusxinput+dcplusx*alfa_laststep
+                  if(cplusxnew.lt.0)cplusxnew=1.e-30
+                  hco2plusxnew = hco2plusxinput+dco2plusx*alfa_laststep
+                  if(hco2plusxnew.lt.0)hco2plusxnew=1.e-30
+                  electxnew = electxinput+delectx*alfa_laststep
+                  if(electxnew.lt.0)electxnew=1.e-30
+               endif    !Of chemthermod.ge.3
+            endif       !Of paso.eq.numpasos
+
+
+         end do   
+         !New concentrations to be returned
+         rm(i,i_co2)     = real(co2xnew)
+         rm(i,i_o2)      = real(o2xnew)
+         rm(i,i_o)       = real(o3pxnew)
+         rm(i,i_co)      = real(coxnew)
+         rm(i,i_h)       = real(hxnew)
+         rm(i,i_oh)      = real(ohxnew)
+         rm(i,i_ho2)     = real(ho2xnew)
+         rm(i,i_h2)      = real(h2xnew)
+         rm(i,i_h2o)     = real(h2oxnew)
+         rm(i,i_h2o2)    = real(h2o2xnew)
+         rm(i,i_o1d)     = real(o1dxnew)
+         !Only if O3, N or ion chemistry requested
+         if(chemthermod.ge.1) 
+     $        rm(i,i_o3) = real(o3xnew)
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+            rm(i,i_n)    = real(nxnew)
+            rm(i,i_n2)   = real(n2xnew)
+            rm(i,i_no)   = real(noxnew)
+            rm(i,i_n2d)  = real(n2dxnew)
+            rm(i,i_no2)  = real(no2xnew)
+         endif
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+            rm(i,i_co2plus) = real(co2plusxnew)
+            rm(i,i_oplus)   = real(oplusxnew)
+            rm(i,i_o2plus)  = real(o2plusxnew)
+            rm(i,i_coplus)  = real(coplusxnew)
+            rm(i,i_cplus)   = real(cplusxnew)
+            rm(i,i_nplus)   = real(nplusxnew)
+            rm(i,i_n2plus)  = real(n2plusxnew)
+            rm(i,i_noplus)  = real(noplusxnew)
+            rm(i,i_hplus)   = real(hplusxnew)
+            rm(i,i_hco2plus)= real(hco2plusxnew)
+            rm(i,i_elec)    = real(electxnew)
+         endif
+      end do     
+cccccc End altitude loop 
+     
+
+      return
+
+
+      end
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine implicito ( ig,c_output, text, 
+     &                      c_input, Prod, Loss, tstep )
+
+  
+c Given the productions and losses, calculates new concentrations using
+c an implicit integration scheme. Checks if there are negative values and
+c avoids underflows.
+
+c     jul 2008      MA        Version en subrutina
+c**********************************************************************
+
+      implicit none
+
+c     arguments
+c
+      integer   ig
+      real*8    c_output                      ! O.
+      real*8    c_input                            ! I.
+      real*8    tstep                              ! I. 
+      real*8    Prod                               ! I.
+      real*8    Loss                               ! I.
+      character*4 text                             ! I.
+
+ccccccccccccccc CODE STARTS 
+
+         c_output = (c_input + Prod * tstep) / (1.d0 + Loss * tstep)
+
+         ! Stop is negative prods, losses, concentrations or times
+         !
+         if ( c_output.lt.0.d0 ) then 
+              write(*,*)  text//' < 0 !!!'
+              write (*,*) '  Terms of the implicit equation: '
+              write (*,*) '   c_input =', c_input
+              write (*,*) '   Prod = ', Prod
+              write (*,*) '   Loss = ', Loss
+              write (*,*) '   tstep = ', tstep
+              write (*,*) '   c_output =', c_output
+              write (*,*) '   ig = ', ig
+              stop ' Stop at IMPLICIT , PHCHEM ' 
+         endif
+
+         ! Avoid underflow
+         !
+         if ( c_output.lt.1.d-30) c_output=1.d-30
+
+
+         return
+c END
+         end
+
+
+
+c***********************************************************************
+      function ionsec_nplus (zenit, alt)                      
+
+c       Calcula la eficiencia de produccion de N+ por electrones secundarios
+c       siguiendo Nicholson et al. 2009
+
+c       FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+
+! Arguments 
+      real*8  ionsec_nplus
+      real    zenit
+      real    alt
+
+! Local variables 
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14
+      real*8 b0,b1,b2,b3,b4
+      real*8 altaux
+      real*8 zenit_rad
+
+!!!!!!! Program starts
+
+      zenit_rad=dble(zenit*3.141592/180.)
+
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+      endif
+
+      if(altaux.gt.108.4) then
+         a0  = 1.139925703d3
+         a1  = -4.742398258d1
+         a2  = 8.404232989d-1
+         a3  = -8.108229906d-3
+         a4  = 4.420892285d-5
+         a5  = -1.154901432d-7
+         a6  = -3.514073816d-11
+         a7  = 8.790819159d-13
+         a8  = -1.320788149d-16
+         a9  = -8.202233732d-18
+         a10 = -1.256480521d-22
+         a11 = 1.329336168e-22
+         a12 = -4.403185142d-25
+         a13 = 6.098474897d-28
+         a14 = -3.256951018d-31
+         ionsec_nplus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 + a7*altaux**7
+     $        + a8*altaux**8 + a9*altaux**9 + a10*altaux**10 +
+     $        a11*altaux**11 + a12*altaux**12 + a13*altaux**13 +
+     $        a14*altaux**14
+         ionsec_nplus = 10**(ionsec_nplus-2.)
+      elseif(altaux.gt.80..and.altaux.le.108.4) then 
+!      else
+         b0 = 6.346190854d4
+         b1 = -2.623253212d3
+         b2 = 4.050319629d1
+         b3 = -2.767987276d-1
+         b4 = 7.064439029d-4
+         ionsec_nplus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4
+!         ionsec_nplus = ionsec_nplus * 100.
+      else
+         ionsec_nplus=0.d0
+      endif
+      if(ionsec_nplus.gt.100.d0.or.ionsec_nplus.lt.0.d0)
+!      if(ionsec_nplus.lt.0.d0)
+     $     ionsec_nplus=0.d0
+      
+      
+!Ionizacion secundaria a 0
+!      ionsec_nplus=0.d0
+      return                                         
+c END
+      end
+
+
+c***********************************************************************
+      function ionsec_n2plus (zenit, alt)                      
+
+c       Calcula la eficiencia de produccion de N+ por electrones secundarios
+c       siguiendo Nicholson et al. 2009
+
+c       FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+
+! Arguments 
+      real*8  ionsec_n2plus
+      real    zenit
+      real    alt
+
+! Local variables 
+
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7,a8,a9
+      real*8 b0,b1,b2,b3,b4,b5
+      real*8 altaux
+      real*8 zenit_rad
+
+!!!!!!! Program starts
+
+      zenit_rad=dble(zenit*3.141592/180.)
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+      endif
+
+
+      if(altaux.gt.108.4) then
+         a0 = 9.843804026d2
+         a1 = -3.978696855d1
+         a2 = 7.028448262d-1
+         a3 = -7.11195117d-3
+         a4 = 4.545683986d-5
+         a5 = -1.905046447d-7
+         a6 = 5.240068127d-10
+         a7 = -9.130399894d-13
+         a8 = 9.151792207d-16
+         a9 = -4.023230948d-19
+         ionsec_n2plus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 +
+     $        a7*altaux**7 + a8*altaux**8 + a9*altaux**9
+         ionsec_n2plus = 10**(ionsec_n2plus-2.)
+      elseif(altaux.gt.80..and.altaux.le.108.4) then
+!      else
+         b0 = 5.146111566d4
+         b1 = -1.771736158d3
+         b2 = 1.811156914d1
+         b3 = 3.583722498d-3
+         b4 = -9.891151731d-4
+         b5 = 3.994474097d-6
+         ionsec_n2plus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4 + b5*altaux**5
+!         ionsec_n2plus = ionsec_n2plus * 100.
+      else
+         ionsec_n2plus = 0.d0
+      endif
+      if(ionsec_n2plus.gt.100.d0.or.ionsec_n2plus.lt.0.d0)
+!      if(ionsec_n2plus.lt.0.d0)
+     $     ionsec_n2plus=0.d0
+      
+!Ionizacion secundaria a 0
+!      ionsec_n2plus=0.d0
+      return                                         
+c     END
+      end  
+
+
+
+c***********************************************************************
+      function ionsec_oplus (zenit, alt)                      
+
+c       Calcula la eficiencia de produccion de N+ por electrones secundarios
+c       siguiendo Nicholson et al. 2009
+
+c       FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+
+! Arguments 
+      real*8  ionsec_oplus
+      real    zenit
+      real    alt
+
+! Local variables 
+      
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12
+      real*8 b0,b1,b2,b3,b4,b5,b6
+      real*8 altaux
+      real*8 zenit_rad
+
+!!!!!!! Program starts
+
+      zenit_rad=dble(zenit*3.141592/180.)
+
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+      endif
+
+      if(altaux.gt.112.9) then
+         a0  = 6.453740731d2 
+         a1  = -2.547798991d1
+         a2  = 4.384613636d-1
+         a3  = -4.288387072d-3
+         a4  = 2.596437447d-5
+         a5  = -9.750300694d-8
+         a6  = 1.986722344d-10
+         a7  = -2.293667699d-14
+         a8  = -1.080547019d-15
+         a9  = 3.171787989d-18
+         a10 = -4.566493384d-21
+         a11 = 3.472393897d-24
+         a12 = -1.115699979d-27
+         ionsec_oplus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 + a7*altaux**7
+     $        + a8*altaux**8 + a9*altaux**9 + a10*altaux**10 +
+     $        a11*altaux**11 +a12*altaux**12
+         ionsec_oplus = 10**(ionsec_oplus-2.)
+      elseif(altaux.gt.80..and.altaux.le.112.9) then 
+!      else
+         b0 = -5.934881676d5
+         b1 = 3.546095705d4
+         b2 = -8.806801303d2
+         b3 = 1.163735173d1
+         b4 = -8.62992438d-2
+         b5 = 3.40547333d-4
+         b6 = -5.587037506d-7
+         ionsec_oplus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4 + b5*altaux**5 + b6*altaux**6
+!         ionsec_oplus = ionsec_oplus * 100.
+      else
+         ionsec_oplus=0.d0   
+      endif
+
+      if(ionsec_oplus.gt.100.d0.or.ionsec_oplus.lt.0.d0)
+!      if(ionsec_oplus.lt.0.d0)
+     $     ionsec_oplus=0.d0
+	
+!Ionizacion secundaria a 0
+!      ionsec_oplus=0.d0
+      return                                         
+c     END
+      end
+
+
+
+c***********************************************************************
+      function ionsec_coplus (zenit, alt)                      
+
+c       Calcula la eficiencia de produccion de N+ por electrones secundarios
+c       siguiendo Nicholson et al. 2009
+
+c       FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+      
+! Arguments 
+      real*8  ionsec_coplus
+      real    zenit
+      real    alt
+
+! Local variables 
+
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7,a8,a9
+      real*8 b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12
+      real*8 altaux
+      real*8 zenit_rad
+
+!!!!!!! Program starts
+
+      zenit_rad=dble(zenit*3.141592/180.)
+
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+      endif
+
+      if(altaux.gt.110.6) then
+         a0  = 7.33258229d2
+         a1  = -2.919984139d1
+         a2  = 5.079651482d-1
+         a3  = -5.057170037d-3
+         a4  = 3.178156709d-5
+         a5  = -1.309076957d-7
+         a6  = 3.53858799d-10
+         a7  = -6.060315762d-13
+         a8  = 5.973573923d-16
+         a9  = -2.584454326d-19
+         ionsec_coplus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 + a7*altaux**7
+     $        + a8*altaux**8 + a9*altaux**9 
+         ionsec_coplus = 10**(ionsec_coplus-2.)
+      elseif(altaux.gt.80..and.altaux.le.110.6) then
+!      else
+         b0  = -1.165107657d6
+         b1  = 4.315606169d4
+         b2  = -3.480483017d2
+         b3  = -3.831253024d0
+         b4  = 4.33316742d-2
+         b5  = 2.43075291d-4
+         b6  = -7.835732322d-8
+         b7  = -3.80859833d-8
+         b8  = -1.947628467d-10
+         b9  = 3.440753726d-12
+         b10 = 2.336227916d-14
+         b11 = -3.575877198d-16
+         b12 = 1.030801684d-18
+         ionsec_coplus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4 + b5*altaux**5 + b6*altaux**6 +
+     $        b7*altaux**7 + b8*altaux**8 + b9*altaux**9 +
+     $        b10*altaux**10 + b11*altaux**11 + b12*altaux**12
+!         ionsec_coplus = ionsec_coplus * 100.
+      else
+         ionsec_coplus=0.d0
+      endif
+      if(ionsec_coplus.gt.100..or.ionsec_coplus.lt.0.d0)
+!      if(ionsec_coplus.lt.0.d0)
+     $     ionsec_coplus=0.d0
+      
+!Ionizacion secundaria a 0
+!      ionsec_coplus=0.d0
+      return                                         
+c     END
+      end  
+      
+
+
+c***********************************************************************
+      function ionsec_co2plus (zenit, alt)                      
+      
+c     Calcula la eficiencia de produccion de N+ por electrones secundarios
+c     siguiendo Nicholson et al. 2009
+      
+c     FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+      
+!     Arguments 
+      real*8  ionsec_co2plus
+      real    zenit
+      real    alt
+      
+!     Local variables 
+      
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7,a8,a9
+      real*8 b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10
+      real*8 altaux
+      real*8 zenit_rad
+
+!!!!!!!Program starts
+      
+      zenit_rad=dble(zenit*3.141592/180.)
+      
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+       endif
+
+      if(altaux.gt.112.9) then
+         a0  = 8.64096192d2
+         a1  = -3.471713960d1
+         a2  = 6.072614479d-1
+         a3  = -6.050002721d-3
+         a4  = 3.779639483d-5
+         a5  = -1.533626303d-7
+         a6  = 4.032987841d-10
+         a7  = -6.602964344d-13
+         a8  = 6.067681784d-16
+         a9  = -2.356829271d-19
+         ionsec_co2plus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 +
+     $        a7*altaux**7 + a8*altaux**8 + a9*altaux**9 
+         ionsec_co2plus = 10**(ionsec_co2plus-2.)
+      elseif(altaux.ge.80..and.altaux.le.112.9) then
+!      else
+         b0  = 1.159404818d6
+         b1  = -5.617523193d4
+         b2  = 8.535640078d2
+         b3  = -5.956128524d-1
+         b4  = -8.532255532d-2
+         b5  = 1.217829692d-4
+         b6  = 9.641535217d-6
+         b7  = -4.502450788d-8
+         b8  = -4.9684920146d-10
+         b9  = 4.830572346d-12
+         b10 = -1.168635127d-14
+         ionsec_co2plus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4 + b5*altaux**5 + b6*altaux**6 +
+     $        b7*altaux**7 + b8*altaux**8 + b9*altaux**9 +
+     $        b10*altaux**10
+!         ionsec_co2plus = ionsec_co2plus * 100.
+      else
+         ionsec_co2plus = 0.d0
+      endif
+      if(ionsec_co2plus.gt.100.d0.or.ionsec_co2plus.lt.0.d0)
+!      if(ionsec_co2plus.lt.0.d0)
+     $     ionsec_co2plus=0.d0
+      
+!Ionizacion secundaria a 0
+!      ionsec_co2plus=0.d0
+      return                                         
+c     END
+      end  
+      
+      
+c***********************************************************************
+      function ionsec_o2plus (zenit, alt)                      
+
+c       Calcula la eficiencia de produccion de N+ por electrones secundarios
+c       siguiendo Nicholson et al. 2009
+
+c       FGG    sep 2010   first version
+c***********************************************************************
+                                                
+      implicit none             
+
+! Arguments 
+      real*8  ionsec_o2plus
+      real    zenit
+      real    alt
+      
+!     Local variables 
+
+      real*8 a0,a1,a2,a3,a4,a5,a6,a7
+      real*8 b0,b1,b2,b3,b4,b5,b6,b7,b8
+      real*8 altaux
+      real*8 zenit_rad
+      
+!!!!!!! Program starts
+
+      zenit_rad=dble(zenit*3.141592/180.)
+      
+      if(zenit.le.90.) then
+         altaux=dble(alt)+
+     $        15.*cos(zenit_rad)-40.*sqrt(cos(zenit_rad))+25.
+      else
+         altaux=dble(alt)
+      endif
+
+      if(altaux.gt.112.9) then
+         a0  = 7.265142765d2
+         a1  = -2.714716832d1
+         a2  = 4.315022800d-1
+         a3  = -3.774025573d-3
+         a4  = 1.962771814d-5
+         a5  = -6.076128732d-8
+         a6  = 1.037835637d-10
+         a7  = -7.552930040d-14
+         ionsec_o2plus = a0 + a1*altaux + a2*altaux**2 + a3*altaux**3 +
+     $        a4*altaux**4 + a5*altaux**5 + a6*altaux**6 + a7*altaux**7
+         ionsec_o2plus = 10**(ionsec_o2plus-2.)
+      elseif(altaux.gt.80..and.altaux.le.112.9) then
+!      else
+         b0  = 3.622091694d6
+         b1  = -1.45914419d5
+         b2  = 1.764604914d3
+         b3  = 1.186141031d0
+         b4  = -1.331821089d-1
+         b5  = -3.661686584d-4
+         b6  = 1.934372959d-5
+         b7  = -1.307294421d-7
+         b8  = 2.846288872d-10
+         ionsec_o2plus = b0 + b1*altaux + b2*altaux**2 + b3*altaux**3 +
+     $        b4*altaux**4 + b5*altaux**5 + b6*altaux**6 + b7*altaux**7
+     $        + b8*altaux**8 
+!         ionsec_o2plus = ionsec_o2plus * 100.
+      else
+         ionsec_o2plus = 0.d0
+      endif
+      if(ionsec_o2plus.gt.100.d0.or.ionsec_o2plus.lt.0.d0)
+!      if(ionsec_o2plus.lt.0.d0)
+     $     ionsec_o2plus=0.d0
+      
+!Ionizacion secundaria a 0
+!      ionsec_o2plus=0.d0
+      return                                         
+c END
+      end  
+
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine phdisrate(ig,chemthermod,zenit,i)
+
+c     apr 2002       fgg           first version
+c**********************************************************************
+
+
+      implicit none
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+
+c     arguments
+
+      integer         i                !altitude
+      integer         ig,chemthermod
+      real            zenit
+
+c     local variables
+
+      integer         inter,iz,j
+      real            lambda
+      real            jdis(nabs,ninter,nlayermx)
+      character*1     dn
+
+
+c**********************************************************************
+
+c     photodissociation and photoionization rates initialization
+
+      jion(:,i,:)    = 0.d0
+      jdistot(:,i)   = 0.d0
+      jdistot_b(:,i) = 0.d0
+
+!      jion(1,i,1) = 0.d0          ! CO2 channel 1  ( --> CO2+ + e- )
+!      jion(1,i,2) = 0.d0          ! CO2 channel 2  (  --> O+ + CO + e- )
+!      jion(1,i,3) = 0.d0          ! CO2 channel 3  (  --> CO+ + O + e- )
+!      jion(1,i,4) = 0.d0          ! CO2 channel 4  (  --> C+ + O2 + e- )
+!      jion(2,i,1) = 0.d0          ! O2 (only one ionization channel)
+!      jion(3,i,1) = 0.d0          ! O3P (only one ionization channel)
+!      jion(4,i,1) = 0.d0          ! H2O (no ionization)
+!      jion(5,i,1) = 0.d0          ! H2 (no ionization)
+!      jion(6,i,1) = 0.d0          ! H2O2 (no ionization)
+!      jion(7,i,1) = 0.d0          ! O3 (no ionization)
+!      jion(8,i,1) = 0.d0          ! N2 channel 1 ( --> n2+ + e- )
+!      jion(8,i,2) = 0.d0          ! N2 channel 2 ( --> n+ + n + e- )
+!      jion(9,i,1) = 0.d0          ! N ( --> N+ + e- )
+!      jion(10,i,1)= 0.d0          ! We do not mind its ionization
+!      jion(11,i,1) = 0.d0          ! CO channel 1 ( --> co+ + e- )
+!      jion(11,i,2) = 0.d0          ! CO channel 2 ( --> c+ + o + e- )
+!      jion(11,i,3) = 0.d0          ! CO channel 3 ( --> o+ + c + e- )
+!      jion(12,i,1) = 0.d0         ! H ( --> H+ + e- )
+!      jion(13,i,1) = 0.d0
+!      do j=1,nabs
+!         jdistot(j,i) = 0.
+!         jdistot_b(j,i) = 0.
+!      end do
+
+      if(zenit.gt.140.) then
+         dn='n'
+         else
+         dn='d'
+      end if
+
+      if(dn.eq.'n') return
+
+c     photodissociation and photoionization rates for each species
+
+      do inter=1,ninter
+c     CO2
+         jdis(1,inter,i) = jfotsout(inter,1,i) * fluxtop(inter) 
+     $        * efdisco2(inter)
+         if(inter.gt.29.and.inter.le.32) then
+            jdistot(1,i) = jdistot(1,i) + jdis(1,inter,i)
+         else if(inter.le.29) then
+            jdistot_b(1,i) = jdistot_b(1,i) + jdis(1,inter,i)
+         end if
+         jion(1,i,1)=jion(1,i,1) + 
+     $        jfotsout(inter,1,i)*fluxtop(inter)*efionco2(inter,1)
+         jion(1,i,2)=jion(1,i,2) + 
+     $        jfotsout(inter,1,i)*fluxtop(inter)*efionco2(inter,2)
+         jion(1,i,3)=jion(1,i,3) + 
+     $        jfotsout(inter,1,i)*fluxtop(inter)*efionco2(inter,3)
+         jion(1,i,4)=jion(1,i,4) + 
+     $        jfotsout(inter,1,i)*fluxtop(inter)*efionco2(inter,4)
+
+c     O2
+         jdis(2,inter,i) = jfotsout(inter,2,i) * fluxtop(inter)
+     $        * efdiso2(inter)
+         if(inter.ge.31) then
+            jdistot(2,i) = jdistot(2,i) + jdis(2,inter,i)
+         else if(inter.eq.30) then
+            jdistot(2,i)=jdistot(2,i)+0.02*jdis(2,inter,i)
+            jdistot_b(2,i)=jdistot_b(2,i)+0.98*jdis(2,inter,i)
+         else if(inter.lt.31) then
+            jdistot_b(2,i) = jdistot_b(2,i) + jdis(2,inter,i)
+         end if
+         jion(2,i,1)=jion(2,i,1) +
+     $        jfotsout(inter,2,i) * fluxtop(inter) * (1.-efdiso2(inter))
+         
+c     O3P
+         jion(3,i,1)=jion(3,i,1) +
+     $        jfotsout(inter,3,i) * fluxtop(inter) * efiono3p(inter)
+         
+c     H2O
+         jdis(4,inter,i) = jfotsout(inter,4,i) * fluxtop(inter)
+     $        * efdish2o(inter)
+         jdistot(4,i) = jdistot(4,i) + jdis(4,inter,i)
+         
+c     H2
+         jdis(5,inter,i) = jfotsout(inter,5,i) * fluxtop(inter)
+     $        * efdish2(inter)
+         jdistot(5,i) = jdistot(5,i) + jdis(5,inter,i)
+         
+c     H2O2
+         jdis(6,inter,i) = jfotsout(inter,6,i) * fluxtop(inter)
+     $        * efdish2o2(inter) 
+         jdistot(6,i) = jdistot(6,i) + jdis(6,inter,i)
+         
+         !Only if O3, N or ion chemistry requested
+         if(chemthermod.ge.1) then
+c     O3
+            jdis(7,inter,i) = jfotsout(inter,7,i) * fluxtop(inter)
+     $           * efdiso3(inter)
+            if(inter.eq.34) then
+               jdistot(7,i) = jdistot(7,i) + jdis(7,inter,i)
+            else if (inter.eq.35) then
+               jdistot(7,i) = jdistot(7,i) + 0.997 * jdis(7,inter,i)
+               jdistot_b(7,i) = jdistot_b(7,i) + 0.003 * jdis(7,inter,i)
+            else if (inter.eq.36) then
+               jdistot_b(7,i) = jdistot_b(7,i) + jdis(7,inter,i)
+            endif
+         endif   !Of chemthermod.ge.1
+
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+c     N2
+            jdis(8,inter,i) = jfotsout(inter,8,i) * fluxtop(inter)
+     $           * efdisn2(inter)
+            jdistot(8,i) = jdistot(8,i) + jdis(8,inter,i)
+            jion(8,i,1) = jion(8,i,1) + jfotsout(inter,8,i) * 
+     $           fluxtop(inter) * efionn2(inter,1)
+            jion(8,i,2) = jion(8,i,2) + jfotsout(inter,8,i) *
+     $           fluxtop(inter) * efionn2(inter,2)
+            
+c     N
+            jion(9,i,1) = jion(9,i,1) + jfotsout(inter,9,i) *
+     $           fluxtop(inter) * efionn(inter)
+            
+c     NO
+            jdis(10,inter,i) = jfotsout(inter,10,i) * fluxtop(inter)
+     $           * efdisno(inter)
+            jdistot(10,i) = jdistot(10,i) + jdis(10,inter,i)
+            jion(10,i,1) = jion(10,i,1) + jfotsout(inter,10,i) *
+     $           fluxtop(inter) * efionno(inter)
+            
+c     NO2
+            jdis(13,inter,i) = jfotsout(inter,13,i) * fluxtop(inter)
+     $           * efdisno2(inter)
+            jdistot(13,i) = jdistot(13,i) + jdis(13,inter,i)
+
+         endif   !Of chemthermod.ge.2
+            
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+c     CO
+            jdis(11,inter,i) = jfotsout(inter,11,i) * fluxtop(inter)
+     $           * efdisco(inter)
+            jdistot(11,i) = jdistot(11,i) + jdis(11,inter,i)
+            jion(11,i,1) = jion(11,i,1) + jfotsout(inter,11,i) *
+     $           fluxtop(inter) * efionco(inter,1)
+            jion(11,i,2) = jion(11,i,2) + jfotsout(inter,11,i) *
+     $           fluxtop(inter) * efionco(inter,2)
+            jion(11,i,3) = jion(11,i,3) + jfotsout(inter,11,i) *
+     $           fluxtop(inter) * efionco(inter,3) 
+
+c     H
+            jion(12,i,1) = jion(12,i,1) + jfotsout(inter,12,i) * 
+     $           fluxtop(inter) * efionh(inter)
+         endif    !Of chemthermod.eq.3
+
+
+      end do 
+
+
+      return
+      
+
+      end
+
+
+
+
+c**********************************************************************
+c***************************************************************************
+	subroutine getch (ig,chemthermod,tt,concco2,zkm)
+
+ 
+c	NOV 98	MALV 		First Version. From the work:
+c                               Rodrigo et al, Atmosfera, 3, pp.31-43, 1990
+c       apr 02  FGG             New reactions
+c       Sep 07 fgg              
+c***************************************************************************
+
+	
+	implicit none
+	include "dimensions.h"
+	include "dimphys.h"
+	include 'param.h'
+	include 'param_v4.h'
+
+c Arguments 	
+	integer           ig,chemthermod
+	real*8 		tt	! Temperature 
+	real*8            concco2
+	real              zkm	!  Altitude in km
+
+c local variables: 
+	double precision        tcte   
+	double precision        t_elect ! electronic temperatures
+	double precision        val ! valores de alturas corresp a t_elect
+	double precision        zhanson(9),tehanson(9)
+	double precision        incremento
+	integer                 ii, i1, i2
+	real                    phelec_fact_ch86
+	
+c**************************************************************************
+
+	tcte = tt
+	
+	!Electronic temperatures
+        ! (Hanson et al. 1977) approx. from Mars p. 107 	   
+	zhanson(1) = 120. 
+	zhanson(2) = 130. 
+	zhanson(3) = 150. 
+	zhanson(4) = 175. 
+	zhanson(5) = 200. 
+	zhanson(6) = 225. 
+	zhanson(7) = 250. 
+	zhanson(8) = 275. 
+	zhanson(9) = 300.
+	tehanson(1) = tt
+	tehanson(2) = 200.
+	tehanson(3) = 300.
+	tehanson(4) = 500.
+	tehanson(5) = 1250.
+	tehanson(6) = 2000.
+	tehanson(7) = 2200.
+	tehanson(8) = 2400.
+	tehanson(9) = 2500.
+	if ( zkm .le. 120. ) then
+	   t_elect = tt 
+	else if(zkm .ge.300.) then
+	   t_elect=tehanson(9)
+	else
+	   do ii=9,2,-1 
+	      if ( zkm .lt. zhanson(ii) ) then 
+		 i1 = ii - 1
+		 i2 = ii 
+	      endif
+	   enddo
+	   incremento = ( tehanson(i2)-tehanson(i1) ) / 
+	1	( zhanson(i2)-zhanson(i1) )
+	   t_elect = tehanson(i1) + (zkm-zhanson(i1)) * incremento
+	endif
+
+	!Initializations
+	ch2  = 0.d0
+	ch3  = 0.0
+	ch4  = 0.d0
+	ch5  = 0.d0
+	ch7  = 0.d0
+	ch9  = 0.d0
+	ch10 = 0.d0
+	ch11 = 0.d0
+	ch13 = 0.d0
+	ch14 = 0.d0
+	ch15 = 0.d0
+	ch18 = 0.d0
+	ch19 = 0.d0
+	ch20 = 0.d0
+	ch21 = 0.d0
+	ch22 = 0.d0
+	ch23 = 0.d0
+	ch24 = 0.d0
+	ch30 = 0.d0
+	ch31 = 0.d0
+	ch32 = 0.d0
+	ch33 = 0.d0
+	ch34 = 0.d0
+	ch35 = 0.d0
+	ch36 = 0.d0
+	ch37 = 0.d0
+	ch38 = 0.d0
+	ch39 = 0.d0
+	ch40 = 0.d0
+	ch41 = 0.d0
+	ch42 = 0.d0
+	ch43 = 0.d0
+	ch45 = 0.d0
+	ch46 = 0.d0
+	ch47 = 0.d0
+	ch48 = 0.d0
+	ch49 = 0.d0
+	ch50 = 0.d0
+	ch55 = 0.d0
+	ch56 = 0.d0
+	ch57 = 0.d0
+	ch58 = 0.d0
+	ch59 = 0.d0
+	ch62 = 0.d0
+	ch63 = 0.d0
+	ch64 = 0.d0
+	ch65 = 0.d0
+	ch66 = 0.d0
+	ch67 = 0.d0
+	ch68 = 0.d0
+	ch69 = 0.d0
+	ch70 = 0.d0
+	ch71 = 0.d0
+	ch72 = 0.d0
+	ch73 = 0.d0
+	ch74 = 0.d0
+	ch75 = 0.d0
+	ch76 = 0.d0
+	ch85 = 0.d0
+	ch86 = 0.d0
+	
+
+	!Reaction rates
+ch2: h + o2 + co2 --> ho2 + co2
+	ch2 = 1.425d-31 * (tcte / 300.)**(-1.6d0)
+
+ch3: o + ho2 --> oh + o2
+	ch3 = 3.0d-11 * exp(200.d0 / tcte)
+
+ch4: co + oh --> co2 + h
+!	ch4 = 3.2d-13 * exp(-300.d0 / tcte)
+        ch4 = 1.57d-13 + 3.54d-33*concco2 
+
+ch5: ho2 + ho2 --> h2o2 + o2
+	ch5 = 2.3d-13 * exp(600.d0 / tcte)
+
+ch7: oh + ho2 --> h2o + o2
+	ch7 = 4.8d-11 * exp(250.d0 / tcte)
+
+ch9: o(1d) + h2o --> 2oh
+	ch9 = 2.2d-10
+
+ch10: o + o + co2 --> o2 + co2
+!	ch10 = 1.1d-27 * (tcte **(-2.0d0)) !Estandard en el 1-D
+	ch10 = 1.3d-34 * exp(900.d0/tcte)
+
+ch11: o + oh --> o2 + h
+	ch11 = 2.2d-11 * exp(120.d0 / tcte)
+
+ch13: h + ho2 --> h2 + o2
+	ch13 = 6.5d-12
+
+ch14: o(1d) + h2 --> h + oh
+	ch14 = 1.1d-10
+
+ch15: oh + h2 --> h + h2o
+	ch15 = 5.5d-12 * exp (-2000.d0 / tcte)
+
+ch18: oh + h2o2 --> h2o + ho2
+	ch18 = 2.9d-12 * exp (-160.d0 / tcte)
+
+ch19: o(1d) + co2 --> o + co2
+	ch19 = 7.4d-11 * exp(120.d0 / tcte)
+
+ch20: o(1d) + o2 --> o + o2
+	ch20 = 3.2d-11 * exp (70.d0 / tcte)
+
+ch21: o + o2 + co2 --> o3 + co2
+	ch21 = 1.5d-33 * ((tcte / 300.d0) ** (-2.4d0))
+	
+
+	!Only if O3, N or ion chemistry requested
+	if(chemthermod.ge.1) then
+
+ch22: o3 + h --> o2 + oh
+	   ch22 = 1.4d-10 * exp (-470.d0 / tcte)
+
+ch23: o3 + oh --> ho2 + o2
+	   ch23 = 1.7d-12 * exp (-940.d0 / tcte)
+
+ch24: o3 + ho2 --> oh + 2o2
+	   ch24 = 1.0d-14 * exp (-490.d0 / tcte)
+
+	endif
+
+	!Only if N or ion chemistry requested
+	if(chemthermod.ge.2) then
+c<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+c N chemistry
+ch30: n + no --> n2 + o
+	   ch30 = 2.1d-11 * exp (100.d0 / tcte)
+
+ch31: n2 + o(1d) --> n2 + o
+	   ch31 = 2.5d-11 * exp (110.d0 / tcte)
+
+ch32: n + o2 --> no + o
+	   ch32 = 1.5d-11 * exp (-3600.d0 / tcte)
+
+ch33: n + oh --> no + h
+	   ch33 = 3.8d-11 * exp (85.d0 / tcte)
+
+ch34: n + o3 --> no + o2
+	   ch34 = 1.0d-16
+
+ch35: n + ho2 --> no + oh
+	   ch35 = 2.2d-11
+
+ch36: n(2d) + n2 --> n + n2
+	   ch36 = 6.9d-13
+
+ch37: n(2d) + n2 --> n + n2
+	   ch37 = 1.7d-14
+
+ch38: n(2d) + co2 --> no + co
+	   ch38 = 3.5d-13
+
+ch39: no + ho2 --> no2+oh
+	   ch39 = 3.5d-12 * exp (250.d0 / tcte)
+
+ch40: o + no + co2 --> no2 + co2
+	   ch40 = 2.5d0 * 9.0d-32 * ((tcte / 300.d0) ** (-1.5d0))
+
+ch41: o + no2 --> no + o2
+	   ch41 = 5.1d-12 * exp (210.d0 / tcte)
+
+ch42: no + o3 --> no2 + o2
+	   ch42 = 3.0d-12 * exp (-1500.d0 / tcte)
+
+ch43: h + no2 --> no + oh
+	   ch43 = 4.0d-10 * exp (-340.d0 / tcte)
+
+ch45: n + o --> no
+	   ch45 = 2.8d-17 * ((300.d0 / tcte) ** 0.5)
+	   
+	endif    !of if(chemthermod.ge.2)
+
+
+	!Only if ion chemistry requested
+	if(chemthermod.eq.3) then
+c
+c Ionosphere
+c
+ch46:  co2+ +  O --> O2+ + CO
+	   ch46 = 5.0d-11
+
+ch47: CO2+ + O -->  O+  +  CO2
+	   ch47 = 1.64d-10
+
+ch48: CO2+ + O --> O2+  + CO
+	   ch48 = 9.6d-11
+
+ch49: O2+ + elect --> O + O
+	   ch49 = 2.0d-7*(300.d0/t_elect)**(0.7d0)
+
+ch50: O+  + CO2 --> O2+  + CO
+	   ch50 = 9.4d-10
+
+ch55: CO2+ +  e ---->   CO  +	O
+	   ch55 = 3.8d-7*(300.d0/t_elect)**(0.5d0)
+        
+ch56: O+ + CO2  --->  O2   +   CO+
+	   ch56 = 9.4d-10
+
+ch57: CO+ + CO2  ---> CO2+ + CO
+	   ch57 = 1.0d-9
+
+ch58: CO+ + O   --->   O+  + CO
+	   ch58 = 1.4d-10
+  
+ch59: C+ +  CO2 --->  CO+  + CO    !!!!  NEW  !!!
+	   ch59 = 1.1d-9
+
+ch62:  CO2+  +  NO   -->  NO+  +  CO2
+	   ch62 = 1.2d-10
+
+ch63:  CO2+  +  N    -->  NO  + CO+
+	   ch63 = 1.0d-11
+
+ch64:   O2+  +  NO    -->  NO+  + O2
+	   ch64 = 4.5d-10
+
+ch65:  O2+  +  N2    -->  NO+  + NO
+	   ch65 = 1.0d-16
+
+ch66:  O2+  +  N    -->  NO+  + O
+	   ch66 = 1.2d-10
+
+
+ch67:   O+  +  N2    -->  NO+  + N
+	   ch67 = 1.2d-12 * (300.d0/t_elect)**(0.41d0)
+
+ch68:  N2+  +  CO2    -->  CO2+  + N2
+	   ch68 = 7.7d-10
+
+ch69:   N2+  +  O3p    -->  NO+  + N
+	   ch69 = 1.3d-10
+
+ch70:  N2+  +  CO    -->  N2  + CO+
+	   ch70 = 7.4d-11
+
+ch71:  N2+  +  e-    -->  N  + N
+	   ch71 = 3.5d-7 * (300.d0/t_elect)**(0.5d0)
+
+
+ch72:  N2+  +  O3p    -->  O+  + N2
+	   ch72 = 4.1d-10
+
+ch73  CO+  +  H    -->  H+  + CO
+	   ch73 = 4.0d-10
+
+
+ch74:   O+  +  H    -->  H+  + O
+	   ch74 = 5.7d-10 * (tt/300.d0)**(0.36d0)
+
+ch75:  NO+  +  e-  -->  N  +  O
+	   ch75 = 4.3d-7 * (300.d0/t_elect)**(0.37d0)
+
+
+ch76:   H+  +  O3p  -->  O+  +  H
+	   ch76 = 7.3d-10 * (tt/300.d0)**(0.23d0) * exp(-226./tt)
+
+ch85:  N+  +  CO2    -->  CO2+  + N
+	   ch85 = 1.d-9
+
+ch86:  H2 + CO2+  --> H + HCO2+
+	   ch86 = 8.7d-10
+
+ch87:  HCO2+ + e -> CO2 + H
+           ch87 = 3.4d-7 * (300.d0/t_elect)**(0.5d0)
+
+	   
+	endif    !Of if(chemthermod.eq.3)
+
+	return 
+	end
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine lifetimes
+     &   ( ig,i,chemthermod,zenit,zx,jdistot8, jdistot8_b, jion8,
+     $     xtmin, xcompmin, xn_comp_en_EQ,
+     $     co2xini,o2xini,o3pxini,coxini,hxini,ohxini,ho2xini,h2xini,
+     $     h2oxini,h2o2xini,o1dxini,o3xini,n2xini,nxini,noxini,no2xini,
+     $     n2dxini,co2plusxini,oplusxini,o2plusxini,coplusxini,
+     $     cplusxini,nplusxini,noplusxini,n2plusxini,hplusxini,
+     $     hco2plusxini,electxini)
+
+  
+c Calculates the lifetime of each species at each time step (itime) 
+c and each altitude (i), and the minimum of them (tmin)
+c It also computes the number of species in PE
+c 
+c
+c     jul 2008      MA        Version en subrutina
+c         2009      FGG       Adaptation to GCM
+c**********************************************************************
+
+      implicit none
+
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'iono.h'
+      include 'callkeys.h'
+
+c     arguments
+c
+      integer   i,ig                                  ! I. Layer  
+      integer   chemthermod
+      real      zenit
+      real      zx(nlayermx)
+      real*8    jdistot8(nabs,nlayermx)                  ! I.
+      real*8    jdistot8_b(nabs,nlayermx)                ! I.
+      real*8    jion8(nabs,nlayermx,4)                ! I.
+
+      real*8    xtmin                         ! O. 
+      integer   xcompmin                      ! O.
+      integer   xn_comp_en_EQ                 ! O.
+
+      real*8    co2xini,o2xini,o3pxini,coxini
+      real*8    ho2xini,h2xini,hxini,ohxini
+      real*8    h2o2xini,o1dxini,o3xini,h2oxini
+      real*8    nxini,noxini,n2xini,n2dxini,no2xini
+      real*8    co2plusxini,coplusxini,oplusxini,o2plusxini
+      real*8    cplusxini,noplusxini,n2plusxini,hplusxini
+      real*8    electxini,nplusxini,hco2plusxini
+
+c     local variables
+c
+      integer   j 
+
+
+      external  ionsec_nplus
+      real*8    ionsec_nplus
+
+      external  ionsec_n2plus
+      real*8    ionsec_n2plus
+
+      external  ionsec_oplus
+      real*8    ionsec_oplus
+     
+      external  ionsec_coplus
+      real*8    ionsec_coplus
+
+      external  ionsec_co2plus
+      real*8    ionsec_co2plus
+
+      external  ionsec_o2plus
+      real*8    ionsec_o2plus
+
+
+
+ccccccccccccccc CODE STARTS 
+
+         !Initialization of lifetimes
+         do j = 1, nreact
+            tauco2(i,j)  = 1.d30
+            tauo2(i,j)   = 1.d30
+            tauo3p(i,j)  = 1.d30
+            tauco(i,j)   = 1.d30
+            tauh(i,j)    = 1.d30
+            tauoh(i,j)   = 1.d30
+            tauho2(i,j)  = 1.d30
+            tauh2(i,j)   = 1.d30
+            tauh2o(i,j)  = 1.d30
+            tauo1d(i,j)  = 1.d30
+            tauh2o2(i,j) = 1.d30
+            tauo3(i,j)   = 1.d30
+            taun2(i,j)   = 1.d30
+            taun(i,j)    = 1.d30
+            tauno(i,j)   = 1.d30
+            taun2d(i,j)  = 1.d30
+            tauno2(i,j)  = 1.d30
+            tauco2plus(i,j) = 1.d30
+            tauoplus(i,j)   = 1.d30
+	    tauo2plus(i,j)  = 1.d30
+            taucoplus(i,j)  = 1.d30
+	    taucplus(i,j)   = 1.d30
+	    taunplus(i,j)   = 1.d30
+	    taun2plus(i,j)  = 1.d30
+            taunoplus(i,j)  = 1.d30
+	    tauhplus(i,j)   = 1.d30
+            tauhco2plus(i,j)= 1.d30
+         end do
+
+         !Lifetime of each species in each reaction
+         if(jdistot8(1,i).gt.1.d-30) tauco2(i,1) = 1.d0 / jdistot8(1,i)
+		 
+         if(ch2*o2xini*co2xini.gt.1.d-30) 
+     $      tauh(i,2) = 1.d0 / (ch2 * o2xini * co2xini)  
+         if(ch2*hxini*co2xini.gt.1.d-30)
+     $      tauo2(i,2) = 1.d0 / (ch2 * hxini * co2xini)
+ 
+         if(ch3*o3pxini.gt.1.d-30) tauho2(i,3) = 1.d0 / 
+     $        (ch3 * o3pxini)
+         if(ch3*ho2xini.gt.1.d-30) tauo3p(i,3) = 1.d0 / 
+     $        (ch3 * ho2xini)
+ 
+         if(ch4*coxini.gt.1.d-30) tauoh(i,4) = 1.d0 / 
+     $        (ch4 * coxini)
+         if(ch4*ohxini.gt.1.d-30) tauco(i,4) = 1.d0 / 
+     $        (ch4 * ohxini)
+ 
+         if(ch5*ho2xini.gt.1.d-30)tauho2(i,5)=1.d0 / 
+     $        (2.d0*ch5*ho2xini)
+
+		 
+	 if(jdistot8(6,i).gt.1.d-30) tauh2o2(i,6) = 1.d0 / jdistot8(6,i)
+
+         if(ch7*ohxini.gt.1.d-30) tauho2(i,7) = 1.d0 / 
+     $        (ch7 * ohxini)
+         if(ch7*ho2xini.gt.1.d-30) tauoh(i,7) = 1.d0 / 
+     $        (ch7 * ho2xini)
+ 
+         if(jdistot8(4,i).gt.1.d-30) tauh2o(i,8) = 1.d0 / jdistot8(4,i)
+
+	 if(ch9*o1dxini.gt.1.d-30) tauh2o(i,9) = 1.d0 / 
+     $        (ch9 * o1dxini)
+         if(ch9*h2oxini.gt.1.d-30) tauo1d(i,9) = 1.d0 / 
+     $        (ch9 * h2oxini)
+
+         if(ch10*o3pxini*co2xini.gt.1.d-30) 
+     $     tauo3p(i,10) = 1.d0 / 
+     $        (2.d0 * ch10 * o3pxini * co2xini)
+
+         if(ch11*o3pxini.gt.1.d-30) tauoh(i,11)=1.d0 / 
+     $        (ch11 * o3pxini)
+         if(ch11*ohxini.gt.1.d-30) tauo3p(i,11) = 1.d0 / 
+     $        (ch11 * ohxini)
+
+         if(jdistot8(2,i).gt.1.d-30) tauo2(i,12) = 1.d0 / jdistot8(2,i)
+
+         if(ch13*hxini.gt.1.d-30) tauho2(i,13) = 1.d0 / 
+     $        (ch13 * hxini)
+         if(ch13*ho2xini.gt.1.d-30) tauh(i,13) = 1.d0 / 
+     $        (ch13 * ho2xini)
+
+         if(ch14*o1dxini.gt.1.d-30) tauh2(i,14) = 1.d0 / 
+     $        (ch14 * o1dxini)
+         if(ch14*h2xini.gt.1.d-30) tauo1d(i,14) = 1.d0 / 
+     $        (ch14 * h2xini)
+
+         if(ch15*ohxini.gt.1.d-30) tauh2(i,15) = 1.d0 / 
+     $        (ch15 * ohxini)
+         if(ch15*h2xini.gt.1.d-30) tauoh(i,15) = 1.d0 / 
+     $        (ch15 * h2xini)
+
+         if(jdistot8_b(1,i).gt.1.d-30) tauco2(i,16)=1.d0/jdistot8_b(1,i)
+
+         if(jdistot8_b(2,i).gt.1.d-30) tauo2(i,17)=1.d0/jdistot8_b(2,i)
+
+         if(ch18*ohxini.gt.1.d-30) tauh2o2(i,18)=1.d0 / 
+     $        (ch18 * ohxini)
+         if(ch18*h2o2xini.gt.1.d-30) tauoh(i,18)=1.d0 / 
+     $        (ch18 * h2o2xini)
+
+         if(ch19*co2xini.gt.1.d-30)tauo1d(i,19)=1.d0 / 
+     $        (ch19 * co2xini)
+
+         if(ch20*o2xini.gt.1.d-30)tauo1d(i,20)= 1.d0 / 
+     $        (ch20 * o2xini)
+
+         if(ch21*o2xini*co2xini.gt.1.d-30)tauo3p(i,21)= 1.d0 / 
+     $        (ch21 * o2xini * co2xini)
+         if(ch21*o3pxini*co2xini.gt.1.d-30) tauo2(i,21) = 1.d0 / 
+     $        (ch21 * o3pxini * co2xini)
+
+         !Only if O3, N or ion chemistry requested
+         if(chemthermod.ge.1) then
+            if(ch22*hxini.gt.1.d-30) tauo3(i,22) = 1.d0 / 
+     $           (ch22 * hxini)
+            if(ch22*o3xini.gt.1.d-30) tauh(i,22) = 1.d0 / 
+     $           (ch22 * o3xini)
+            
+            if(ch23*ohxini.gt.1.d-30) tauo3(i,23) = 1.d0 / 
+     $           (ch23 * ohxini)
+            if(ch23*o3xini.gt.1.d-30) tauoh(i,23) = 1.d0 / 
+     $           (ch23 * o3xini)
+            
+            if(ch24 * ho2xini.gt.1.d-30)tauo3(i,24)= 1.d0 / 
+     $           (ch24 * ho2xini)
+            if(ch24 * o3xini.gt.1.d-30)tauho2(i,24)= 1.d0 / 
+     $           (ch24 * o3xini)
+            
+            if(jdistot8(7,i).gt.1.d-30) tauo3(i,25)=1.d0 /
+     $           jdistot8(7,i)
+
+            if(jdistot8_b(7,i).gt.1.d-30) tauo3(i,26)= 1.d0 /
+     $           jdistot8_b(7,i)
+
+         endif    !Of chemthermod.ge.1
+
+         if(jdistot8(5,i).gt.1.d-30) tauh2(i,27)= 1.d0/jdistot8(5,i)
+
+!         if(ch28 * h2oxini.gt.1.d-30) tauo3(i,28) = 1.d0/(ch28*h2oxini)
+!         if(ch28 * o3xini.gt.1.d-30) tauh2o(i,28) = 1.d0/(ch28*o3xini)
+         
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+            if(jdistot8(8,i).gt.1.d-30) taun2(i,28) = 1.d0 / 
+     $           jdistot8(8,i)
+
+            if(jdistot8(10,i).gt.1.d-30) tauno(i,29) = 1.d0 /
+     $           jdistot8(10,i)
+
+            if(ch30 * noxini.gt.1.d-30) taun(i,30) = 1.d0 / 
+     $           (ch30 * noxini)
+            if(ch30 * nxini.gt.1.d-30) tauno(i,30) = 1.d0 / 
+     $           (ch30 * nxini)
+
+            if(ch31 * o1dxini.gt.1.d-30) taun2(i,31) = 1.d0 / 
+     $           (ch31 * o1dxini)
+            if(ch31 * n2xini.gt.1.d-30) tauo1d(i,31) = 1.d0 /
+     $           (ch31 * n2xini)
+
+            if(ch32 * o2xini.gt.1.d-30) taun(i,32) = 1.d0 /
+     $           (ch32 * o2xini)
+            if(ch32 * nxini.gt.1.d-30) tauo2(i,32) = 1.d0 /
+     $           (ch32 * nxini)
+            
+            if(ch33 * ohxini.gt.1.d-30) taun(i,33) = 1.d0 /
+     $           (ch33 * ohxini)
+            if(ch33 * nxini.gt.1.d-30) tauoh(i,33) = 1.d0 /
+     $           (ch33 * nxini)
+
+            if(ch34 * o3xini.gt.1.d-30) taun(i,34) = 1.d0 /
+     $           (ch34 * o3xini)
+            if(ch34 * nxini.gt.1.d-30) tauo3(i,34) = 1.d0 /
+     $           (ch34 * nxini)
+            
+            if(ch35 * ho2xini.gt.1.d-30) taun(i,35) = 1.d0 /
+     $           (ch35 * ho2xini)
+            if(ch35 * nxini.gt.1.d-30) tauho2(i,35) = 1.d0 /
+     $           (ch35 * nxini)
+            
+            if(ch36 * o3pxini.gt.1.d-30) taun2d(i,36) = 1.d0 /
+     $           (ch36 * o3pxini)
+            if(ch36 * n2dxini.gt.1.d-30) tauo3p(i,36) = 1.d0 /
+     $           (ch36 * n2dxini)
+            
+            if(ch37 * n2xini.gt.1.d-30) taun2d(i,37) = 1.d0 /
+     $           (ch37 * n2xini)
+            if(ch37 * n2dxini.gt.1.d-30) taun2(i,37) = 1.d0 /
+     $           (ch37 * n2dxini)
+            
+            if(ch38 * co2xini.gt.1.d-30) taun2d(i,38) = 1.d0 /
+     $           (ch38 * co2xini)
+            if(ch38 * n2dxini.gt.1.d-30) tauco2(i,38) = 1.d0 /
+     $           (ch38 * n2dxini)
+            
+            if(ch39 * ho2xini.gt.1.d-30) tauno(i,39) = 1.d0 /
+     $           (ch39 * ho2xini)
+            if(ch39 * noxini.gt.1.d-30) tauho2(i,39) = 1.d0 /
+     $           (ch39 * noxini)
+            
+            if(ch40 * noxini * co2xini.gt.1.d-30) tauo3p(i,40) = 1.d0 /
+     $           (ch40 * noxini * co2xini)
+            if(ch40 * o3pxini * co2xini.gt.1.d-30) tauno(i,40) = 1.d0 /
+     $           (ch40 * o3pxini * co2xini)
+            
+            if(ch41 * no2xini.gt.1.d-30) tauo3p(i,41) = 1.d0 /
+     $           (ch41 * no2xini)
+            if(ch41 * o3pxini.gt.1.d-30) tauno2(i,41) = 1.d0 /
+     $           (ch41 * o3pxini)
+            
+            if(ch42 * noxini.gt.1.d-30) tauo3(i,42) = 1.d0 /
+     $           (ch42 * noxini)
+            if(ch42 * o3xini.gt.1.d-30) tauno(i,42) = 1.d0 /
+     $           (ch42 * o3xini)
+            
+            if(ch43 * no2xini.gt.1.d-30) tauh(i,43) = 1.d0 /
+     $           (ch43 * no2xini)
+            if(ch43 * hxini.gt.1.d-30) tauno2(i,43) = 1.d0 /
+     $           (ch43 * hxini)
+
+            if(jdistot8(13,i).gt.1.d-30) tauno2(i,44) = 1.d0 / 
+     $           jdistot8(13,i)
+
+            if(ch45 * nxini.gt.1.d-30) tauo3p(i,45) = 1.d0 / 
+     $           (ch45 * nxini)
+            if(ch45 * o3pxini.gt.1.d-30) taun(i,45) = 1.d0 /
+     $           (ch45 * o3pxini)
+
+         endif    !Of chemthermod.ge.2
+
+c>>>>>>>>>>>>>>>>>>>>>>>>  IONOSPHERE >>>>>>>>>>>>>>>>
+
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+            if(ch46 * co2plusxini .gt.1.d-30) tauo2(i,46) = 
+     @           1.d0/(ch46*co2plusxini)
+            if(ch46 * o2xini .gt.1.d-30) tauco2plus(i,46) = 
+     @           1.d0/(ch46*o2xini)
+
+            if ( ch47*o3pxini .gt. 1.d-30 ) tauco2plus(i,47) = 
+     @           1.d0/( ch47*o3pxini )
+            if ( ch47*co2plusxini .gt. 1.d-30 ) tauo3p(i,47) = 
+     @           1.d0/( ch47*co2plusxini )
+            
+            if ( ch48*o3pxini .gt. 1.d-30 ) tauco2plus(i,48) =
+     @           1.d0/(ch48*o3pxini)	   
+            if ( ch48*co2plusxini .gt. 1.d-30 ) tauo3p(i,48) =
+     @           1.d0/(ch48*co2plusxini)	 
+
+            if ( ch49*electxini .gt. 1.d-30 ) tauo2plus(i,49) =
+     @           1.d0/(ch49*electxini)	 
+
+            if ( ch50*co2xini  .gt. 1.d-30 ) tauoplus(i,50) =
+     @           1.d0/(ch50*co2xini)
+            if ( ch50*oplusxini .gt. 1.d-30 ) tauco2(i,50) =
+     @           1.d0/(ch50*oplusxini)
+
+            if ( jion8(1,i,1).gt.1.d-30 ) tauco2(i,51) = 
+     $           1.d0 / jion8(1,i,1)
+
+            if ( jion8(1,i,2).gt.1.d-30 ) tauco2(i,52) = 
+     $           1.d0 / jion8(1,i,2)
+
+            if ( jion8(1,i,3).gt.1.d-30 ) tauco2(i,53) = 
+     $           1.d0 / jion8(1,i,3)
+
+            if ( jion8(1,i,4).gt.1.d-30 ) tauco2(i,54) = 
+     $           1.d0 / jion8(1,i,4) 
+		
+            if ( ch55*electxini .gt. 1.d-30 ) tauco2plus(i,55) =
+     @           1.d0/(ch55*electxini)	 
+
+            if ( ch56*oplusxini .gt. 1.d-30 ) tauco2(i,56) =
+     @           1.d0/(ch56*oplusxini)
+            if ( ch56*co2xini .gt. 1.d-30 ) tauoplus(i,56) =
+     @           1.d0/(ch56*co2xini)	
+    
+            if ( ch57*coplusxini .gt. 1.d-30 ) tauco2(i,57) =
+     @           1.d0/(ch57*coplusxini)	 
+            if ( ch57*co2xini .gt. 1.d-30 ) taucoplus(i,57) =
+     @           1.d0/(ch57*co2xini)
+
+            if ( ch58*coplusxini .gt. 1.d-30 ) tauo3p(i,58) =
+     @           1.d0/(ch58*coplusxini)	
+            if ( ch58*o3pxini .gt. 1.d-30 ) taucoplus(i,58) =
+     @           1.d0/(ch58*o3pxini)
+
+            if ( ch59*cplusxini .gt. 1.d-30 ) tauco2(i,59) =
+     @           1.d0/(ch59*cplusxini)	
+            if ( ch59*co2xini .gt. 1.d-30 ) taucplus(i,59) =
+     @           1.d0/(ch59*co2xini)	   	 	 
+         
+            if ( jion8(2,i,1).gt.1.d-30 ) tauo2(i,60) = 
+     $           1.d0 / jion8(2,i,1)
+
+            if ( jion8(3,i,1).gt.1.d-30 ) tauo3p(i,61) = 
+     $           1.d0 / jion8(3,i,1)  
+
+            if ( ch62*co2plusxini .gt. 1.d-30 ) tauno(i,62) =
+     @           1.d0/(ch62*co2plusxini)	
+            if ( ch62*noxini .gt. 1.d-30 ) tauco2plus(i,62) =
+     @           1.d0/(ch62*noxini)	   	 	 
+ 
+            if ( ch63*co2plusxini .gt. 1.d-30 ) taun(i,63) =
+     @           1.d0/(ch63*cplusxini)	
+            if ( ch63*nxini .gt. 1.d-30 ) tauco2plus(i,63) =
+     @           1.d0/(ch63*nxini)	   	 	 
+     
+            if ( ch64*o2plusxini .gt. 1.d-30 ) tauno(i,64) =
+     @           1.d0/(ch64*o2plusxini)	
+            if ( ch64*noxini .gt. 1.d-30 ) tauo2plus(i,64) =
+     @           1.d0/(ch64*noxini)	   	 	 
+   
+            if ( ch65*o2plusxini .gt. 1.d-30 ) taun2(i,65) =
+     @           1.d0/(ch65*o2plusxini)	
+            if ( ch65*n2xini .gt. 1.d-30 ) tauo2plus(i,65) =
+     @           1.d0/(ch65*n2xini)	   	 	 
+   
+            if ( ch66*o2plusxini .gt. 1.d-30 ) taun(i,66) =
+     @           1.d0/(ch66*o2plusxini)	
+            if ( ch66*nxini .gt. 1.d-30 ) tauo2plus(i,66) =
+     @           1.d0/(ch66*nxini)	   	 	 
+   
+            if ( ch67*oplusxini .gt. 1.d-30 ) taun2(i,67) =
+     @           1.d0/(ch67*oplusxini)	
+            if ( ch67*n2xini .gt. 1.d-30 ) tauoplus(i,67) =
+     @           1.d0/(ch67*n2xini)	   	 	 
+
+            if ( ch68*n2plusxini .gt. 1.d-30 ) tauco2(i,68) =
+     @           1.d0/(ch68*n2plusxini)
+            if ( ch68*co2xini .gt. 1.d-30 ) taun2plus(i,68) =
+     @           1.d0/(ch68*co2xini)	   	 	 
+    
+            if ( ch69*cplusxini .gt. 1.d-30 ) tauco2(i,69) =
+     @           1.d0/(ch69*cplusxini)	
+            if ( ch69*co2xini .gt. 1.d-30 ) taucplus(i,69) =
+     @           1.d0/(ch69*co2xini)	   	 	 
+            
+            if ( ch70*n2plusxini .gt. 1.d-30 ) tauco(i,70) =
+     @           1.d0/(ch70*n2plusxini)	
+            if ( ch70*coxini .gt. 1.d-30 ) taun2plus(i,70) =
+     @           1.d0/(ch70*coxini)	   	 	 
+            
+            if ( ch71*electxini .gt. 1.d-30 ) taun2plus(i,71) =
+     @           1.d0/(ch71*electxini)	
+            
+            if ( ch72*n2plusxini .gt. 1.d-30 ) tauo3p(i,72) =
+     @           1.d0/(ch72*n2plusxini)	
+            if ( ch72*o3pxini .gt. 1.d-30 ) taun2plus(i,72) =
+     @           1.d0/(ch72*o3pxini)	   	 	 
+     	 	 
+            if ( ch73*coplusxini .gt. 1.d-30 ) tauh(i,73) =
+     @           1.d0/(ch73*coplusxini)	
+            if ( ch73*hxini .gt. 1.d-30 ) taucoplus(i,73) =
+     @           1.d0/(ch73*hxini)	   	 	 
+         
+            if ( ch74*oplusxini .gt. 1.d-30 ) tauh(i,74) =
+     @           1.d0/(ch74*oplusxini)	
+            if ( ch74*hxini .gt. 1.d-30 ) tauoplus(i,74) =
+     @           1.d0/(ch74*hxini)	
+ 
+            if ( ch75*electxini .gt. 1.d-30 ) taunoplus(i,75) =
+     @           1.d0/(ch75*electxini)	   	 	 
+            
+            if ( ch76*hplusxini .gt. 1.d-30 ) tauo3p(i,76) =
+     @           1.d0/(ch76*hplusxini)	
+            if ( ch76*o3pxini .gt. 1.d-30 ) tauhplus(i,76) =
+     @           1.d0/(ch76*o3pxini)	
+	 
+            if( jion8(11,i,1).gt.1.d-30 )  tauco(i,77) = 
+     $           1.d0 / jion8(11,i,1)
+
+            if( jion8(11,i,2).gt.1.d-30 )  tauco(i,78) = 
+     $           1.d0 / jion8(11,i,2)  
+
+         !if( jion8(11,i,3).gt.1.d-30 ) tauco(i,79) = 
+!     $        1.d0 / jion8(11,i,3) 
+
+            if( jion8(10,i,1).gt.1.d-30 )  tauno(i,80) = 
+     $           1.d0 / jion8(10,i,1) 
+         
+            if( jion8(8,i,1).gt.1.d-30 )   taun2(i,81)  = 
+     $           1.d0 / jion8(8,i,1) 
+
+            if( jion8(8,i,2).gt.1.d-30 )   taun2(i,82)  = 
+     $           1.d0 / jion8(8,i,2)
+		 
+            if( jion8(12,i,1).gt.1.d-30 )  tauh(i,83)  = 
+     $           1.d0 / jion8(12,i,1)
+
+            if( jion8(9,i,1).gt.1.d-30 )   taun(i,84)  = 
+     $           1.d0 / jion8(9,i,1)
+
+            if ( ch85*nplusxini .gt. 1.d-30 ) tauco2(i,85) =
+     @           1.d0/(ch85*nplusxini)	
+            if ( ch85*co2xini .gt. 1.d-30 ) taunplus(i,85) =
+     @           1.d0/(ch85*co2xini)
+
+            if ( ch86*co2plusxini .gt. 1.d-30) tauh2(i,86) =
+     $           1.d0/(ch86*co2plusxini)
+            if ( ch86*h2xini .gt. 1.d-30) tauco2plus(i,86) =
+     $           1.d0/(ch86*h2xini)
+         
+            if ( ch87*electxini .gt. 1.d-30) tauhco2plus(i,87) =
+     $                  1.d0/(ch87*electxini)
+
+            if ( jion8(9,i,1)*ionsec_nplus(zenit,zx(i)).gt.1.d-30) 
+     $           taun(i,88) = 1.d0 / 
+     $           (jion8(9,i,1)*ionsec_nplus(zenit,zx(i)))
+
+            if ( jion8(8,i,1)*ionsec_n2plus(zenit,zx(i)).gt.1.d-30) 
+     $           taun2(i,89) = 1.d0 / 
+     $           (jion8(8,i,1)*ionsec_n2plus(zenit,zx(i))) 
+            
+            if ( jion8(3,i,1)*ionsec_oplus(zenit,zx(i)).gt.1.d-30) 
+     $           tauo3p(i,90) = 1.d0 /
+     $           (jion8(3,i,1)*ionsec_oplus(zenit,zx(i)))
+            
+            if (jion8(11,i,1)*ionsec_coplus(zenit,zx(i)).gt.1.d-30) 
+     $           tauco(i,91) = 1.d0 /
+     $           (jion8(11,i,1)*ionsec_coplus(zenit,zx(i)))
+
+            if (jion8(1,i,1)*ionsec_co2plus(zenit,zx(i)).gt.1.d-30) 
+     $           tauco2(i,92) = 1.d0 /
+     $           (jion8(1,i,1)*ionsec_co2plus(zenit,zx(i)))
+
+            if ( jion8(2,i,1)*ionsec_o2plus(zenit,zx(i)).gt.1.d-30) 
+     $           tauo2(i,93) = 1.d0 /
+     $           (jion8(2,i,1)*ionsec_o2plus(zenit,zx(i)))
+
+         endif                  !Of chemthermod.eq.3
+c>>>>>>>>>>>>>>>>>>>>>>>>
+	 
+         !Minimum lifetime for each species
+         tminco2(i)  = 1.d30
+         tmino2(i)   = 1.d30
+         tmino3p(i)  = 1.d30
+         tminco(i)   = 1.d30
+         tminh(i)    = 1.d30
+         tminoh(i)   = 1.d30
+         tminho2(i)  = 1.d30
+         tminh2(i)   = 1.d30
+         tminh2o(i)  = 1.d30
+         tmino1d(i)  = 1.d30
+         tminh2o2(i) = 1.d30
+         tmino3(i)   = 1.d30
+	 tminn(i)    = 1.d30
+         tminno(i)   = 1.d30
+	 tminn2(i) = 1.d30
+         tminn2d(i) = 1.d30
+         tminno2(i) = 1.d30
+         tminco2plus(i) = 1.d30
+	 tminoplus(i)   = 1.d30
+	 tmino2plus(i)  = 1.d30
+         tmincoplus(i)  = 1.d30
+	 tmincplus(i)   = 1.d30
+	 tminnplus(i)   = 1.d30
+	 tminn2plus(i)  = 1.d30
+         tminnoplus(i)  = 1.d30
+	 tminhplus(i)   = 1.d30
+         tminhco2plus(i)=1.d30
+
+         do j=1,nreact
+            tminco2(i)  = min(tminco2(i),tauco2(i,j))
+            tmino2(i)   = min(tmino2(i),tauo2(i,j))
+            tmino3p(i)  = min(tmino3p(i),tauo3p(i,j))
+            tminco(i)   = min(tminco(i),tauco(i,j))
+            tminh(i)    = min(tminh(i),tauh(i,j))
+            tminoh(i)   = min(tminoh(i),tauoh(i,j))
+            tminho2(i)  = min(tminho2(i),tauho2(i,j))
+            tminh2(i)   = min(tminh2(i),tauh2(i,j))
+            tminh2o(i)  = min(tminh2o(i),tauh2o(i,j))
+            tmino1d(i)  = min(tmino1d(i),tauo1d(i,j))
+            tminh2o2(i) = min(tminh2o2(i),tauh2o2(i,j))
+            tmino3(i)   = min(tmino3(i),tauo3(i,j))
+            tminn(i)    = min(tminn(i),taun(i,j))
+            tminno(i)   = min(tminno(i),tauno(i,j))
+	    tminn2(i)   = min(tminn2(i),taun2(i,j))
+	    tminn2d(i)  = min(tminn2d(i),taun2d(i,j))
+            tminno2(i)  = min(tminno2(i),tauno2(i,j))
+            !
+            tminco2plus(i) = min(tminco2plus(i),tauco2plus(i,j))
+	    tminoplus(i)   = min(tminoplus(i),tauoplus(i,j))
+            tmino2plus(i)  = min(tmino2plus(i),tauo2plus(i,j))
+            tmincoplus(i)  = min(tmincoplus(i),taucoplus(i,j))
+            tmincplus(i)   = min(tmincplus(i),taucplus(i,j))
+	    tminnplus(i)   = min(tminnplus(i),taunplus(i,j))
+            tminn2plus(i)  = min(tminn2plus(i),taun2plus(i,j))
+            tminnoplus(i)  = min(tminnoplus(i),taunoplus(i,j))
+            tminhplus(i)   = min(tminhplus(i),tauhplus(i,j))
+            tminhco2plus(i)= min(tminhco2plus(i),tauhco2plus(i,j))
+         end do
+
+       !!! Minimum lifetime for all species
+
+         xtmin = 1.d30
+
+         ! Neutrals that can not be in PE
+
+         xtmin = min(xtmin,tminco2(i))
+         if(xtmin.eq.tminco2(i)) xcompmin=1
+         xtmin = min(xtmin,tmino2(i))
+         if(xtmin.eq.tmino2(i)) xcompmin=2
+         xtmin = min(xtmin,tmino3p(i))
+         if(xtmin.eq.tmino3p(i)) xcompmin=3
+         xtmin = min(xtmin,tminco(i))
+         if(xtmin.eq.tminco(i)) xcompmin=4
+
+         xtmin = min(xtmin,tminh2(i))
+         if(xtmin.eq.tminh2(i)) xcompmin=8
+         xtmin = min(xtmin,tminh2o(i))
+         if(xtmin.eq.tminh2o(i)) xcompmin=9
+  
+         xtmin = min(xtmin,tminh2o2(i))
+         if(xtmin.eq.tminh2o2(i)) xcompmin=11
+         xtmin = min(xtmin,tmino3(i))	
+         if(xtmin.eq.tmino3(i)) xcompmin=12
+         xtmin = min(xtmin,tminn(i))
+         if(xtmin.eq.tminn(i)) xcompmin=13
+         xtmin = min(xtmin,tminno(i))
+         if(xtmin.eq.tminno(i)) xcompmin=14
+         xtmin = min(xtmin,tminn2(i))
+         if(xtmin.eq.tminn2(i)) xcompmin=15
+
+         ! Neutrals that can be in PE
+         !       [ O1D , OH , HO2 , H , N2D , NO2 ]
+
+         xn_comp_en_EQ = 0
+         
+         ! H
+         h_eq(i)='Y'
+         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! OH
+         oh_eq(i)='Y'
+         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! HO2
+         ho2_eq(i)='Y'
+         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! O1D
+         o1d_eq(i)='Y'
+         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! O3
+         o3_eq(i)='N'
+!         o3_eq(i)='Y'
+!         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+         ! N2D
+            n2d_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! NO2
+            no2_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+
+         ! NO
+            no_eq(i)='N'
+
+!            no_eq(i)='Y'
+!            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         endif   !Of chemthermod.ge.2
+
+         ! Ions
+         !Only if ion chemistry requested
+
+         if(chemthermod.eq.3) then
+         ! C+
+            cplus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! CO+
+            coplus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! O+
+            oplus_eq(i)='N'
+!         oplus_eq(i)='Y'
+!         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! N2+
+            n2plus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! H+
+            hplus_eq(i)='N'
+
+!         hplus_eq(i)='Y'
+!         xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! CO2+
+            co2plus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! O2+
+            o2plus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! NO+
+            noplus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! N+
+            nplus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+
+         ! HCO2+
+            hco2plus_eq(i)='Y'
+            xn_comp_en_EQ = xn_comp_en_EQ + 1
+         endif  !Of chemthermod.eq.3
+
+         return
+c END
+         end
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine timemarching( ig,i,chemthermod,n_comp_en_EQ,
+     $     compmin,tmin,timefrac_sec, deltat ) 
+
+  
+c Calculates the timestep of the model, deltat, and verifies if the species
+c that can be in PE actually verify or not the PE condition
+c
+c     jul 2008      MA        Version en subrutina
+c         2009      FGG       Adaptation to GCM
+c**********************************************************************
+
+      implicit none
+
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'iono.h'
+
+c     arguments
+c
+      integer   i,ig                              ! I. Layer  
+      integer   chemthermod
+      integer   n_comp_en_EQ(nlayermx)         ! Number of species in PE
+      integer   compmin(nlayermx)              ! Species with minimum lifetime
+      real*8    tmin(nlayermx)                 ! Minimum lifetime
+      real*8    timefrac_sec                   ! I. 
+      real*8    deltat                         ! O. TimeMarching step
+
+c     local variables
+c
+      integer   j
+      real*8    tminaux
+
+      real*8   fmargin1, fmargin2
+
+ccccccccccccccc CODE STARTS 
+
+      fmargin1=1.
+      fmargin2=5.
+
+      !Internal timestep as the minimum of the external (GCM) timestep
+      !and the minimum lifetime of the species not in PE divided by a 
+      !given factor
+      tminaux = min( timefrac_sec, tmin(i)/fmargin1 )
+      
+      !Given the internal timestep, we verify if the species that can be
+      !in PE verify or not the PE condition (lifetime < deltat/fmargin2)
+
+      ! 6 neutral species that can be in PE
+      !      [ O1D , OH , HO2 , H , N2D , NO2 ]
+
+      ! O1D
+      if ( (o1d_eq(i).eq.'Y') .and. 
+     &     (tmino1d(i).gt.tminaux/fmargin2) ) then 
+         o1d_eq(i)='N'
+         n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+      endif
+      ! OH
+      if ( (oh_eq(i).eq.'Y') .and. 
+     &     (tminoh(i).gt.tminaux/fmargin2) ) then
+         oh_eq(i)='N'
+         n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+      endif
+      ! HO2
+      if ( (ho2_eq(i).eq.'Y') .and. 
+     &     (tminho2(i).gt.tminaux/fmargin2) ) then
+         ho2_eq(i)='N'
+         n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+      endif
+      ! H
+      if ( (h_eq(i).eq.'Y') .and. 
+     &     (tminh(i).gt.tminaux/fmargin2) ) then
+         h_eq(i)='N'
+         n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+      endif
+      
+      !Only if N or ion chemistry requested
+      if(chemthermod.ge.2) then
+      ! N2D
+         if ( (n2d_eq(i).eq.'Y') .and. 
+     &        (tminn2d(i).gt.tminaux/fmargin2) ) then
+            n2d_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! NO2
+         if ( (no2_eq(i).eq.'Y') .and. 
+     &        (tminno2(i).gt.tminaux/fmargin2) ) then
+            no2_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+         
+      endif   !Of chemthermod.ge.2
+
+
+      !
+      ! 9 ions 
+      ! 
+      
+      !Only if ion chemistry requested
+      if(chemthermod.eq.3) then
+      ! C+
+         if ( (cplus_eq(i).eq.'Y') .and. 
+     &        (tmincplus(i).gt.tminaux/fmargin2) ) then
+            cplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! CO+
+         if ( (coplus_eq(i).eq.'Y') .and. 
+     &        (tmincoplus(i).gt.tminaux/fmargin2) ) then
+            coplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! O+
+         if ( (oplus_eq(i).eq.'Y') .and. 
+     &        (tminoplus(i).gt.tminaux/fmargin2) ) then
+            oplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! N2+
+         if ( (n2plus_eq(i).eq.'Y') .and. 
+     &        (tminn2plus(i).gt.tminaux/fmargin2) ) then
+            n2plus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! H+
+         if ( (hplus_eq(i).eq.'Y') .and. 
+     &        (tminhplus(i).gt.tminaux/fmargin2) ) then
+            hplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! CO2+
+         if ( (co2plus_eq(i).eq.'Y') .and. 
+     &        (tminco2plus(i).gt.tminaux/fmargin2) ) then
+            co2plus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! O2+
+         if ( (o2plus_eq(i).eq.'Y') .and. 
+     &        (tmino2plus(i).gt.tminaux/fmargin2) ) then
+            o2plus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! NO+
+         if ( (noplus_eq(i).eq.'Y') .and. 
+     &        (tminnoplus(i).gt.tminaux/fmargin2) ) then
+            noplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+      ! N+
+         if ( (nplus_eq(i).eq.'Y') .and. 
+     &        (tminnplus(i).gt.tminaux/fmargin2) ) then
+            nplus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+       ! HCO2+
+         if ( (hco2plus_eq(i).eq.'Y') .and. 
+     &        (tminhco2plus(i).gt.tminaux/fmargin2) ) then
+            hco2plus_eq(i)='N'
+            n_comp_en_EQ(i) = n_comp_en_EQ(i) - 1
+         endif
+
+      endif   !Of chemthermod.eq.3
+
+
+
+         ! And we set the internal timestep
+         !
+      deltat = tminaux
+
+      return
+c END
+      end
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine prodsandlosses ( ig,i,chemthermod,zenit,zx,
+     &                 jdistot8, jdistot8_b, jion8,
+     &                              co2xinput, o2xinput, o3pxinput,
+     &                              coxinput,  h2xinput, o3xinput,
+     &                              h2oxinput, nxinput,  noxinput, 
+     &                              h2o2xinput, n2xinput, 
+     &                           o1dxinput, ohxinput,  ho2xinput,
+     &                           hxinput,   n2dxinput, no2xinput,
+     &                 co2plusxinput,  o2plusxinput, coplusxinput,
+     &                 oplusxinput,    cplusxinput,  noplusxinput,
+     &                 n2plusxinput,   hplusxinput,  nplusxinput,
+     &                 hco2plusxinput,electxinput )
+
+
+  
+c Calculates the productions and losses of each species in each reaction
+c and each altitude
+c
+c     jul 2008      MA        Version en subrutina
+c     apr 2009      FGG       Compact version to save CPU time, adaptation
+c                             to GCM
+c**********************************************************************
+
+      implicit none
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+
+c     arguments
+c
+      integer   ig
+      integer   i                                 ! I. Layer  
+      integer   chemthermod
+      real      zx(nlayermx)
+      real      zenit
+      real*8    jdistot8(nabs,nlayermx)
+      real*8    jdistot8_b(nabs,nlayermx)
+      real*8    jion8(nabs,nlayermx,4)
+      real*8    co2xinput,o2xinput,o3pxinput,coxinput
+      real*8    ho2xinput,h2xinput,hxinput,ohxinput
+      real*8    h2o2xinput,o1dxinput,o3xinput,h2oxinput
+      real*8    nxinput,noxinput,n2xinput,n2dxinput,no2xinput
+      real*8    co2plusxinput,coplusxinput,oplusxinput,o2plusxinput
+      real*8    cplusxinput,noplusxinput,n2plusxinput,hplusxinput
+      real*8    electxinput,nplusxinput,hco2plusxinput
+
+
+c     local variables
+c
+      integer   j 
+
+      external  ionsec_nplus
+      real*8    ionsec_nplus
+
+      external  ionsec_n2plus
+      real*8    ionsec_n2plus
+
+      external  ionsec_oplus
+      real*8    ionsec_oplus
+     
+      external  ionsec_coplus
+      real*8    ionsec_coplus
+
+      external  ionsec_co2plus
+      real*8    ionsec_co2plus
+
+      external  ionsec_o2plus
+      real*8    ionsec_o2plus
+
+      logical firstcall
+      save firstcall
+      data firstcall /.true./
+
+ccccccccccccccc CODE STARTS 
+
+      !Initialization
+      if (firstcall) then
+        firstcall= .false.
+        do j=1,nreact
+           Lco2(i,j) = 0.d0
+           Pco2(i,j) = 0.d0
+           Lo2(i,j) = 0.d0
+           Po2(i,j) = 0.d0
+           Lo3p(i,j) = 0.d0
+           Po3p(i,j) = 0.d0
+           Lco(i,j) = 0.d0
+           Pco(i,j) = 0.d0
+           Ph(i,j) = 0.d0
+           Lh(i,j) = 0.d0
+           Poh(i,j) = 0.d0
+           Loh(i,j) = 0.d0
+           Pho2(i,j) = 0.d0
+           Lho2(i,j) = 0.d0
+           Ph2(i,j) = 0.d0
+           Lh2(i,j) = 0.d0
+           Ph2o(i,j) = 0.d0
+           Lh2o(i,j) = 0.d0
+           Po1d(i,j) = 0.d0
+           Lo1d(i,j) = 0.d0
+           Ph2o2(i,j) = 0.d0
+           Lh2o2(i,j) = 0.d0
+           Po3(i,j) = 0.d0
+           Lo3(i,j) = 0.d0
+           Pn(i,j) = 0.d0
+           Ln(i,j) = 0.d0
+           Pno(i,j) = 0.d0
+           Lno(i,j) = 0.d0
+           Pn2(i,j) = 0.d0
+           Ln2(i,j) = 0.d0
+           Pn2d(i,j) = 0.d0
+           Ln2d(i,j) = 0.d0
+           Pno2(i,j) = 0.d0
+           Lno2(i,j) = 0.d0			   
+           Lco2plus(i,j) = 0.d0
+           Pco2plus(i,j) = 0.d0
+           Loplus(i,j) = 0.d0
+           Poplus(i,j) = 0.d0
+           Lo2plus(i,j) = 0.d0
+           Po2plus(i,j) = 0.d0
+           Pcoplus(i,j) = 0.d0
+           Lcoplus(i,j) = 0.d0
+           Pcplus(i,j) = 0.d0
+           Lcplus(i,j) = 0.d0
+           Pnplus(i,j) = 0.d0
+           Lnplus(i,j) = 0.d0
+           Pnoplus(i,j) = 0.d0
+           Lnoplus(i,j) = 0.d0
+           Pn2plus(i,j) = 0.d0
+           Ln2plus(i,j) = 0.d0
+           Phplus(i,j) = 0.d0
+           Lhplus(i,j) = 0.d0
+           Phco2plus(i,j) = 0.d0
+           Lhco2plus(i,j) = 0.d0
+           Pelect(i,j) = 0.d0
+           Lelect(i,j) = 0.d0
+        end do
+        Pco2tot(i) = 0.d0
+        Lco2tot(i) = 0.d0
+        Po2tot(i) = 0.d0
+        Lo2tot(i) = 0.d0
+        Po3ptot(i) = 0.d0
+        Lo3ptot(i) = 0.d0
+        Pcotot(i) = 0.d0
+        Lcotot(i) = 0.d0
+        Phtot(i) = 0.d0
+        Lhtot(i) = 0.d0
+        Pohtot(i) = 0.d0
+        Lohtot(i) = 0.d0
+        Pho2tot(i) = 0.d0
+        Lho2tot(i) = 0.d0
+        Ph2tot(i) = 0.d0
+        Lh2tot(i) = 0.d0
+        Ph2otot(i) = 0.d0
+        Lh2otot(i) = 0.d0
+        Po1dtot(i) = 0.d0
+        Lo1dtot(i) = 0.d0
+        Ph2o2tot(i) = 0.d0
+        Lh2o2tot(i) = 0.d0
+        Po3tot(i) = 0.d0
+        Lo3tot(i) = 0.d0
+        Pntot(i) = 0.d0
+        Lntot(i) = 0.d0
+        Pnotot(i) = 0.d0
+        Lnotot(i) = 0.d0
+        Pn2tot(i) = 0.d0
+        Ln2tot(i) = 0.d0
+        Pn2dtot(i) = 0.d0
+        Ln2dtot(i) = 0.d0
+        Pno2tot(i) = 0.d0
+        Lno2tot(i) = 0.d0
+                                !
+        Pco2plustot(i) = 0.d0
+        Lco2plustot(i) = 0.d0
+        Loplustot(i) = 0.d0
+        Poplustot(i) = 0.d0
+        Lo2plustot(i) = 0.d0
+        Po2plustot(i) = 0.d0
+        Lcoplustot(i) = 0.d0
+        Pcoplustot(i) = 0.d0
+        Lcplustot(i) = 0.d0
+        Pcplustot(i) = 0.d0
+        Lnplustot(i) = 0.d0
+        Pnplustot(i) = 0.d0
+        Lnoplustot(i) = 0.d0
+        Pnoplustot(i) = 0.d0
+        Ln2plustot(i) = 0.d0
+        Pn2plustot(i) = 0.d0
+        Lhplustot(i) = 0.d0
+        Phplustot(i) = 0.d0
+        Lhco2plustot(i) = 0.d0
+        Phco2plustot(i) = 0.d0
+        Pelecttot(i) = 0.0d0
+        Lelecttot(i) = 0.0d0
+      endif
+
+
+
+      !!! Productions and losses reaction by reaction
+
+c     R1: CO2 + hv -> CO + O
+
+      Lco2(i,1) = jdistot8(1,i)
+      Pco(i,1) = co2xinput * jdistot8(1,i)
+      Po3p(i,1) = Pco(i,1)!co2xinput * jdistot8(1,i)
+
+
+c     R16(1b): CO2 + hv -> CO + O1D
+      
+      Lco2(i,16) = jdistot8_b(1,i)
+      Pco(i,16) = co2xinput * jdistot8_b(1,i)
+      Po1d(i,16) = Pco(i,16)!co2xinput * jdistot8_b(1,i)
+
+
+c     R2: H + O2 + CO2 -> HO2 + CO2
+
+      Lh(i,2) = ch2 * o2xinput * co2xinput
+      Lo2(i,2) = ch2 * hxinput * co2xinput
+      Pho2(i,2) = ch2 * hxinput * o2xinput * co2xinput
+
+
+c     R3: O + HO2 -> OH + O2
+
+      Lo3p(i,3) = ch3 * ho2xinput 
+      Lho2(i,3) = ch3 * o3pxinput
+      Poh(i,3) = ch3 * o3pxinput * ho2xinput
+      Po2(i,3) = Poh(i,3)!ch3 * o3pxinput * ho2xinput
+      
+
+c     R4: CO + OH -> CO2 + H
+      
+      Lco(i,4) = ch4 * ohxinput
+      Loh(i,4) = ch4 * coxinput
+      Pco2(i,4) = ch4 * coxinput * ohxinput
+      Ph(i,4) = Pco2(i,4)!ch4 * coxinput * ohxinput
+
+
+c     R5: 2HO2 -> H2O2 + O2
+
+      Lho2(i,5) = 2.d0 * ch5 * ho2xinput 
+      Po2(i,5) = ch5 * ho2xinput * ho2xinput 
+      Ph2o2(i,5) = Po2(i,5)!ch5 * ho2xinput * ho2xinput
+
+
+c     R6: H2O2 + hv -> 2OH
+
+      Lh2o2(i,6) = jdistot8(6,i) 
+      Poh(i,6) = 2.d0 * jdistot8(6,i) * h2o2xinput
+
+
+c     R7: OH + HO2 -> H2O + O2
+
+      Loh(i,7) = ch7 * ho2xinput
+      Lho2(i,7) = ch7 * ohxinput
+      Po2(i,7) = ch7 * ohxinput * ho2xinput
+      Ph2o(i,7) = Po2(i,7)!ch7 * ohxinput * ho2xinput
+      
+
+c     R8: H20 + hv -> H + OH
+
+      Lh2o(i,8) = jdistot8(4,i)
+      Ph(i,8) = jdistot8(4,i) * h2oxinput
+      Poh(i,8) = Ph(i,8)!jdistot8(4,i) * h2oxinput
+
+
+c     R9: O(1D) + H2O -> 2OH
+
+      Lo1d(i,9) = ch9 * h2oxinput
+      Lh2o(i,9) = ch9 * o1dxinput
+      Poh(i,9) = 2.d0 * ch9 * o1dxinput * h2oxinput 
+
+
+c     R10: 2O + CO2 -> O2 + CO2
+
+      Lo3p(i,10) = 2.d0 * ch10 * o3pxinput * co2xinput  
+      Po2(i,10) = ch10 * o3pxinput * o3pxinput * co2xinput
+      
+
+c     R11: O + OH -> O2 + H
+
+      Lo3p(i,11) = ch11 * ohxinput
+      Loh(i,11) = ch11 * o3pxinput
+      Po2(i,11) = ch11 * o3pxinput * ohxinput
+      Ph(i,11) = Po2(i,11)!ch11 * o3pxinput * ohxinput
+
+
+c     R12: O2 + hv -> 2O
+
+      Lo2(i,12) = jdistot8(2,i)
+      Po3p(i,12) = 2.d0 * jdistot8(2,i) * o2xinput
+
+
+c     R17(12b): O2 + hv -> O + O1D
+
+      Lo2(i,17) = jdistot8_b(2,i)
+      Po3p(i,17) = jdistot8_b(2,i) * o2xinput
+      Po1d(i,17) = Po3p(i,17)!jdistot8_b(2,i) * o2xinput
+
+
+c     R13: H + HO2 -> H2 + O2
+
+      Lh(i,13) = ch13 * ho2xinput
+      Lho2(i,13) = ch13 * hxinput
+      Ph2(i,13) = ch13 * hxinput * ho2xinput
+      Po2(i,13) = Ph2(i,13)!ch13 * hxinput * ho2xinput
+
+
+c     R14: O(1D) + H2 -> H + OH
+
+      Lo1d(i,14) = ch14 * h2xinput
+      Lh2(i,14) = ch14 * o1dxinput
+      Ph(i,14) = ch14 * o1dxinput * h2xinput
+      Poh(i,14) = Ph(i,14)!ch14 * o1dxinput * h2xinput
+
+
+c     R15: OH + H2 -> H + H20
+
+      Loh(i,15) = ch15 * h2xinput
+      Lh2(i,15) = ch15 * ohxinput
+      Ph(i,15) = ch15 * ohxinput * h2xinput
+      Ph2o(i,15) = Ph(i,15)!ch15 * ohxinput * h2xinput
+
+
+c     R18: OH + H2O2 -> H2O + HO2
+
+      Loh(i,18) = ch18 * h2o2xinput
+      Lh2o2(i,18) = ch18 * ohxinput
+      Ph2o(i,18) = ch18 * ohxinput * h2o2xinput
+      Pho2(i,18) = Ph2o(i,18)!ch18 * ohxinput * h2o2xinput
+
+
+c     R19: O(1D) + CO2 -> O + CO2
+
+      Lo1d(i,19) = ch19 * co2xinput
+      Po3p(i,19) = ch19 * o1dxinput * co2xinput
+
+
+c     R20: O(1D) + O2 -> O + O2
+
+      Lo1d(i,20) = ch20 * o2xinput
+      Po3p(i,20) = ch20 * o1dxinput * o2xinput
+
+
+c     R21: O + O2 + CO2 -> O3 + CO2
+
+      Lo3p(i,21) = ch21 * o2xinput * co2xinput
+      Lo2(i,21) = ch21 * o3pxinput * co2xinput
+      Po3(i,21) = ch21 * o3pxinput * o2xinput * co2xinput
+
+
+      !Only if O3, N or ion chemistry requested
+      if(chemthermod.ge.1) then
+
+c     R22: O3 + H -> OH + O2
+
+         Lo3(i,22) = ch22 * hxinput
+         Lh(i,22) = ch22 * o3xinput
+         Poh(i,22) = ch22 * o3xinput * hxinput
+         Po2(i,22) = Poh(i,22)  !ch22 * o3xinput * hxinput
+
+
+c     R23: O3 + OH -> HO2 + O2
+
+         Lo3(i,23) = ch23 * ohxinput
+         Loh(i,23) = ch23 * o3xinput
+         Pho2(i,23) = ch23 * ohxinput * o3xinput
+         Po2(i,23) = Pho2(i,23) !ch23 * ohxinput * o3xinput
+
+
+c     R24: O3 + HO2 -> OH + 2O2
+
+         Lo3(i,24) = ch24 * ho2xinput
+         Lho2(i,24) = ch24 * o3xinput
+         Poh(i,24) = ch24 * o3xinput * ho2xinput
+         Po2(i,24) = Poh(i,24)  !2.d0 * ch24 * o3xinput * ho2xinput
+
+
+c     R25: O3 + hv -> O2 + O3P
+
+         Lo3(i,25) = jdistot8(7,i)
+         Po2(i,25) = jdistot8(7,i) * o3xinput
+         Po3p(i,25) = Po2(i,25) !jdistot8(7,i) * o3xinput
+
+
+c     R26 (R25_b): O3 + hv -> O2 + O1D
+
+         Lo3(i,26) = jdistot8_b(7,i)
+         Po2(i,26) = jdistot8_b(7,i) * o3xinput
+         Po1d(i,26) = Po2(i,26) !jdistot8_b(7,i) * o3xinput
+
+      endif    !Of chemthermod.ge.1
+
+
+c     R27: H2 + hv -> 2H
+
+      Lh2(i,27) = jdistot8(5,i)
+      Ph(i,27) = 2.d0 * jdistot8(5,i) * h2xinput
+			
+
+      !Only if N or ion chemistry requested
+      if(chemthermod.ge.2) then
+
+c     R28: N2 + hv -> N + N2D
+
+         Ln2(i,28) = jdistot8(8,i)
+         Pn(i,28) = jdistot8(8,i) * n2xinput
+         Pn2d(i,28) = Pn(i,28)  !jdistot8(8,i) * n2xinput
+
+
+c     R29: NO + hv -> N + O
+            
+         Lno(i,29) = jdistot8(10,i)
+         Pn(i,29) = jdistot8(10,i) * noxinput
+         Po3p(i,29) = Pn(i,29)  !jdistot8(10,i) * noxinput
+
+
+c     R30: N + NO -> N2 + O
+
+         Ln(i,30) = ch30 * noxinput
+         Lno(i,30) = ch30 * nxinput
+         Pn2(i,30) = ch30 * nxinput * noxinput
+         Po3p(i,30) = Pn2(i,30) !ch30 * nxinput * noxinput
+
+
+c     R31: N2 + O1D -> N2 + O
+
+         Lo1d(i,31) = ch31 * n2xinput
+         Po3p(i,31) = ch31 * n2xinput * o1dxinput
+
+
+c     R32: N + O2 -> NO + O
+            
+         Ln(i,32) = ch32 * o2xinput
+         Lo2(i,32) = ch32 * nxinput
+         Pno(i,32) = ch32 * o2xinput * nxinput
+         Po3p(i,32) = Pno(i,32) !ch32 * o2xinput * nxinput
+
+      
+c     R33: N + OH -> NO + H
+
+         Ln(i,33) = ch33 * ohxinput
+         Loh(i,33) = ch33 * nxinput
+         Pno(i,33) = ch33 * nxinput * ohxinput
+         Ph(i,33) = Pno(i,33)   !Pch33 * nxinput * ohxinput
+
+
+c     R34: N + O3 -> NO + O2
+
+         Ln(i,34) = ch34 * o3xinput
+         Lo3(i,34) = ch34 * nxinput
+         Pno(i,34) = ch34 * nxinput * o3xinput
+         Po2(i,34) = Pno(i,34)  !ch34 * nxinput * o3xinput
+
+
+c     R35: N + HO2 -> NO + OH
+
+         Ln(i,35) = ch35 * ho2xinput
+         Lho2(i,35) = ch35 * nxinput
+         Pno(i,35) = ch35 * nxinput * ho2xinput
+         Poh(i,35) = Pno(i,35)  !ch35 * nxinput * ho2xinput
+
+
+c     R36: N2D + O -> N + O
+
+         Ln2d(i,36) = ch36 * o3pxinput
+         Pn(i,36) = ch36 * n2dxinput * o3pxinput
+         
+
+c     R37: N2D + N2 -> N + N2
+
+         Ln2d(i,37) = ch37 * n2xinput
+         Pn(i,37) = ch37 * n2dxinput * n2xinput
+
+
+c     R38: N2D + CO2 -> NO + CO
+
+         Ln2d(i,38) = ch38 * co2xinput
+         Lco2(i,38) = ch38 * n2dxinput
+         Pno(i,38) = ch38 * n2dxinput * co2xinput
+         Pco(i,38) = Pno(i,38)  !ch38 * n2dxinput * co2xinput
+
+
+c     R39: NO + HO2 -> NO2 + OH
+            
+         Lno(i,39) = ch39 * ho2xinput
+         Lho2(i,39) = ch39 * noxinput
+         Pno2(i,39) = ch39 * noxinput * ho2xinput
+         Poh(i,39) = Pno2(i,39) !ch39 * noxinput * ho2xinput
+
+
+c     R40: O + NO + CO2 -> NO2 + CO2
+
+         Lo3p(i,40) = ch40 * noxinput * co2xinput
+         Lno(i,40) = ch40 * o3pxinput * co2xinput
+         Pno2(i,40) = ch40 * o3pxinput * noxinput * co2xinput
+      
+
+c     R41: O + NO2 -> NO + O2
+
+         Lo3p(i,41) = ch41 * no2xinput
+         Lno2(i,41) = ch41 * o3pxinput
+         Pno(i,41) = ch41 * o3pxinput * no2xinput
+         Po2(i,41) = Pno(i,41)  !ch41 * o3pxinput * no2xinput
+
+
+c     R42: NO + O3 -> NO2 + O2
+
+         Lno(i,42) = ch42 * o3xinput
+         Lo3(i,42) = ch42 * noxinput
+         Pno2(i,42) = ch42 * noxinput * o3xinput
+         Po2(i,42) = Pno2(i,42) !ch42 * noxinput * o3xinput
+
+
+c     R43: H + NO2 -> NO + OH
+
+         Lh(i,43) = ch43 * no2xinput
+         Lno2(i,43) = ch43 * hxinput
+         Pno(i,43) = ch43 * no2xinput * hxinput
+         Poh(i,43) = Pno(i,43)  !ch43 * no2xinput * hxinput
+
+
+c     R44: NO2 + hv -> NO + O
+
+         Lno2(i,44) = jdistot8(13,i)
+         Pno(i,44) = jdistot8(13,i) * no2xinput
+         Po3p(i,44) = Pno(i,44) !jdistot8(13,i) * no2xinput
+      
+
+c     R45: N + O -> NO
+
+         Ln(i,45) = ch45 * o3pxinput
+         Lo3p(i,45) = ch45 * nxinput
+         Pno(i,45) = ch45 * o3pxinput * nxinput
+
+      endif    !Of chemthermod.ge.2
+
+
+      ! >>>> IONOSFERA 
+
+      !Only if ion chemistry requested
+      if(chemthermod.eq.3) then
+
+c     R46: CO2+  + O2  ->  CO2 + O2+
+
+         Lco2plus(i,46) = ch46 * o2xinput
+         Lo2(i,46)      = ch46 * co2plusxinput
+         Pco2(i,46)     = ch46 * co2plusxinput * o2xinput
+         Po2plus(i,46)  = Pco2(i,46) !ch46 * co2plusxinput * o2xinput
+
+
+c     R47: CO2+ + O ->  O+ + CO2
+
+         Lco2plus(i,47) = ch47 * o3pxinput
+         Lo3p(i,47)     = ch47 * co2plusxinput
+         Pco2(i,47)     = ch47 * co2plusxinput * o3pxinput
+         Poplus(i,47)   = Pco2(i,47) !ch47 * co2plusxinput * o3pxinput
+
+
+c     R48:  CO2+  O  ->    O2+  +  CO
+
+         Lco2plus(i,48) = ch48 * o3pxinput  
+         Lo3p(i,48)     = ch48 * co2plusxinput
+         Po2plus(i,48)  = ch48 * co2plusxinput * o3pxinput	
+         Pco(i,48)      = Po2plus(i,48) !ch48 * co2plusxinput * o3pxinput
+
+
+c     R49:  O2+  +  e -> O  + O
+
+         Lo2plus(i,49) = ch49 * electxinput
+         Lelect(i,49) = ch49 * o2plusxinput
+         Po3p(i,49)    = ch49 * o2plusxinput * electxinput *2.d0
+
+	    	
+c     R50:   O+  + CO2   -> O2+  + CO
+      
+         Loplus(i,50) = ch50 * co2xinput
+         Lco2(i,50)   = ch50 * oplusxinput
+         Po2plus(i,50)= ch50 * oplusxinput * co2xinput
+         Pco(i,50)    = Po2plus(i,50) !ch50 * oplusxinput * co2xinput
+
+
+c     R51: CO2 + hv -> CO2+ + e
+
+         Lco2(i,51)     = jion8(1,i,1)
+         Pco2plus(i,51) = co2xinput * jion8(1,i,1)
+         Pelect(i,51)   = Pco2plus(i,51) !co2xinput * jion8(1,i,1)
+
+
+c     R52: CO2 + hv --> O+  + CO + e
+      
+         Lco2(i,52)   = jion8(1,i,2)
+         Pco(i,52)    = co2xinput * jion8(1,i,2)
+         Poplus(i,52) = Pco(i,52) !co2xinput * jion8(1,i,2)
+         Pelect(i,52) = Pco(i,52) !co2xinput * jion8(1,i,2)
+
+
+c     R53:  CO2 + hv -->  CO+  + O  + e
+
+         Lco2(i,53)    = jion8(1,i,3)
+         Pcoplus(i,53) = co2xinput * jion8(1,i,3)
+         Po3p(i,53)    = Pcoplus(i,53) !co2xinput * jion8(1,i,3)
+         Pelect(i,53)  = Pcoplus(i,53) !co2xinput * jion8(1,i,3)
+      
+
+c     R54:  CO2 + hv  -->   C+   +  O2 + e
+
+         Lco2(i,54)   = jion8(1,i,4)
+         Pcplus(i,54) = co2xinput * jion8(1,i,4)
+         Po2(i,54)   = Pcplus(i,54) !co2xinput * jion8(1,i,4)
+         Pelect(i,54)  = Pcplus(i,54) !co2xinput * jion8(1,i,4)
+
+      
+c     R55:   CO2+ +  e -->   CO  +   O
+
+         Lco2plus(i,55) = ch55 * electxinput
+         Lelect(i,55) = ch55 * co2plusxinput
+         Pco(i,55)      = ch55 * co2plusxinput * electxinput
+         Po3p(i,55)     = Pco(i,55) !ch55 * co2plusxinput * electxinput
+
+
+c     R56:    O+ + CO2  -->  O2   +   CO+   Probablemente no se dá
+
+         Lco2(i,56)   = ch56 * oplusxinput
+         Loplus(i,56) = ch56 * co2xinput
+         Po2(i,56)    = ch56 * co2xinput * oplusxinput
+         Pcoplus(i,56)= Po2(i,56) !ch56 * co2xinput * oplusxinput
+
+
+c     R57:    CO+ + CO2  --> CO2+ + CO
+
+         Lco2(i,57)    = ch57 * coplusxinput
+         Lcoplus(i,57) = ch57 * co2xinput
+         Pco2plus(i,57)= ch57 *  coplusxinput * co2xinput
+         Pco(i,57)     = Pco2plus(i,57) !ch57 *  coplusxinput * co2xinput
+
+
+c     R58:   CO+ + O  -->   O+  + CO
+
+         Lo3p(i,58)    = ch58 * coplusxinput
+         Lcoplus(i,58) = ch58 * o3pxinput
+         Poplus(i,58)  = ch58 * coplusxinput * o3pxinput
+         Pco(i,58)     = Poplus(i,58) !ch58 * coplusxinput * o3pxinput
+
+      
+c     R59:  C+  +  CO2 -->  CO+  + CO 
+
+         Lco2(i,59)   = ch59 * cplusxinput
+         Lcplus(i,59) = ch59 * co2xinput
+         Pcoplus(i,59)= ch59 *  cplusxinput * co2xinput
+         Pco(i,59)    = Pcoplus(i,59) !ch59 *  cplusxinput * co2xinput
+
+
+c     R60:   O2 + hv   -->   O2+   +  e
+
+         Lo2(i,60)     = jion8(2,i,1)
+         Po2plus(i,60) = o2xinput * jion8(2,i,1)
+         Pelect(i,60)  = Po2plus(i,60) !o2xinput * jion8(2,i,1)
+
+
+c     R61:   O + hv    -->    O+   +  e
+         
+         Lo3p(i,61)    = jion8(3,i,1)
+         Poplus(i,61)  = o3pxinput * jion8(3,i,1)
+         Pelect(i,61)  = Poplus(i,61) !o3pxinput * jion8(3,i,1)
+
+
+c     R62 :   CO2+  +  NO   -->  NO+  +  CO2
+
+         Lco2plus(i,62)    = ch62 * noxinput
+         Lno(i,62)         = ch62 * co2plusxinput
+         Pnoplus(i,62)     = ch62 *  co2plusxinput * noxinput
+         Pco2(i,62)        = Pnoplus(i,62) !ch62 *  co2plusxinput * noxinput
+
+
+c     R63 :   CO2+  +  N    -->  NO  + CO+
+
+         Lco2plus(i,63)    = ch63 * nxinput
+         Ln(i,63)          = ch63 * co2plusxinput
+         Pcoplus(i,63)     = ch63 * co2plusxinput * nxinput
+         Pno(i,63)         = Pcoplus(i,63) !ch63 * co2plusxinput * nxinput
+
+
+c     R64 :   O2+  +  NO    -->  NO+  + O2
+
+         Lo2plus(i,64)    = ch64 * noxinput
+         Lno(i,64)        = ch64 * o2plusxinput
+         Pnoplus(i,64)    = ch64 * o2plusxinput * noxinput
+         Po2(i,64)        = Pnoplus(i,64) !ch64 * o2plusxinput * noxinput
+
+
+c     R65 :   O2+  +  N2    -->  NO+  + NO
+
+         Lo2plus(i,65)    = ch65 * n2xinput
+         Ln2(i,65)        = ch65 * o2plusxinput
+         Pnoplus(i,65)    = ch65 * o2plusxinput * n2xinput
+         Pno(i,65)        = Pnoplus(i,65) !ch65 * o2plusxinput * n2xinput
+
+
+c     R66:   O2+  +  N    -->  NO+  + O
+
+         Lo2plus(i,66)    = ch66 * nxinput
+         Ln(i,66)         = ch66 * o2plusxinput
+         Pnoplus(i,66)    = ch66 * o2plusxinput * nxinput
+         Po3p(i,66)       = Pnoplus(i,66) !ch66 * o2plusxinput * nxinput
+
+
+c     R67 :   O+  +  N2    -->  NO+  + N
+
+         Loplus(i,67)    = ch67 * n2xinput
+         Ln2(i,67)       = ch67 * oplusxinput
+         Pnoplus(i,67)   = ch67 * oplusxinput * n2xinput
+         Pn(i,67)        = Pnoplus(i,67) !ch67 * oplusxinput * n2xinput
+
+
+c     R68 :   N2+  +  CO2    -->  CO2+  + N2
+
+         Ln2plus(i,68)    = ch68 * co2xinput
+         Lco2(i,68)       = ch68 * n2plusxinput
+         Pco2plus(i,68)   = ch68 * n2plusxinput * co2xinput
+         Pn2(i,68)        = Pco2plus(i,68) !ch68 * n2plusxinput * co2xinput
+
+
+c     R69 :   N2+  +  O3p    -->  NO+  + N
+
+         Ln2plus(i,69)    = ch69 * o3pxinput
+         Lo3p(i,69)       = ch69 * n2plusxinput
+         Pnoplus(i,69)    = ch69 * n2plusxinput * o3pxinput
+         Pn(i,69)         = Pnoplus(i,69) !ch69 * n2plusxinput * o3pxinput
+
+
+c     R70 :   N2+  +  CO    -->  N2  + CO+
+
+         Ln2plus(i,70)    = ch70 *  coxinput
+         Lco(i,70)        = ch70 *  n2plusxinput
+         Pcoplus(i,70)    = ch70 *  n2plusxinput * coxinput
+         Pn2(i,70)        = Pcoplus(i,70) !ch70 *  n2plusxinput * coxinput
+
+
+c     R71 :   N2+  +  e-    -->  N  + N
+
+         Ln2plus(i,71)   = ch71 * electxinput
+         Lelect(i,71)    = ch71 * n2plusxinput
+         Pn(i,71)        = 2. * ch71 *  n2plusxinput * electxinput
+
+
+c     R72 :   N2+  +  O3p    -->  O+  + N2
+
+         Ln2plus(i,72) = ch72 * o3pxinput
+         Lo3p(i,72)    = ch72 * n2plusxinput
+         Poplus(i,72)  = ch72 *  n2plusxinput * o3pxinput
+         Pn2(i,72)     = Poplus(i,72) !ch72 *  n2plusxinput * o3pxinput
+
+
+c     R73 :   CO+  +  H    -->  H+  + CO
+         
+         Lcoplus(i,73) = ch73 * hxinput
+         Lh(i,73)      = ch73 * coplusxinput
+         Phplus(i,73)  = ch73 * coplusxinput * hxinput
+         Pco(i,73)     = Phplus(i,73) !ch73 * coplusxinput * hxinput
+
+c     R74 :   O+  +  H    -->  H+  + O
+
+         Loplus(i,74) = ch74 * hxinput
+         Lh(i,74)     = ch74 * oplusxinput
+         Phplus(i,74) = ch74*  oplusxinput * hxinput
+         Po3p(i,74)   = Phplus(i,74) !ch74 * oplusxinput * hxinput
+		
+
+c     R75:   NO+  +  e-  -->  N  +  O
+
+         Lnoplus(i,75)    = ch75 * electxinput
+         Lelect(i,75)    = ch75 * noplusxinput
+         Pn(i,75)= ch75 *  noplusxinput * electxinput
+         Po3p(i,75)= Pn(i,75)   !ch75 *  noplusxinput * electxinput
+
+
+c     R76:   H+  +  O3p  -->  O+  +  H
+
+         Lhplus(i,76)  = ch76 * o3pxinput
+         Lo3p(i,76)    = ch76 * hplusxinput
+         Poplus(i,76)  = ch76 *  hplusxinput * o3pxinput
+         Ph(i,76)      = Poplus(i,76) !ch76 *  hplusxinput * o3pxinput
+
+
+c     R77:   CO + hv   -->  CO+ + e-
+
+         Lco(i,77)    = jion8(11,i,1)
+         Pcoplus(i,77) = coxinput * jion8(11,i,1)
+         Pelect(i,77)  = Pcoplus(i,77) !coxinput * jion8(11,i,1)
+
+
+c     R78:   CO + hv   -->  C+   +   O    + e-
+
+         Lco(i,78)     = jion8(11,i,2)
+         Pcplus(i,78)  = coxinput * jion8(11,i,2)
+         Po3p(i,78)    = Pcplus(i,78) !coxinput * jion8(11,i,2)
+         Pelect(i,78)  = Pcplus(i,78) !coxinput * jion8(11,i,2)
+
+
+c     R79:   CO + hv   -->  C  +   O+   + e-
+
+!     Lco(i,79)    = jion8(11,i,3)
+!     Pc(i,79) = coxinput * jion8(11,i,3)
+!     Poplus(i,79) = Pc(i,79)!Pc(i,79)coxinput * jion8(11,i,3)
+!     Pelect(i,79)  = Pc(i,79)!coxinput * jion8(11,i,3)
+
+
+c     R80:   NO + hv   -->  NO+  +  e-
+
+         Lno(i,80)    = jion8(10,i,1)
+         Pnoplus(i,80) = noxinput * jion8(10,i,1)
+         Pelect(i,80)  = Pnoplus(i,80) !noxinput * jion8(10,i,1)
+
+
+c     R81:   N2 + hv   -->  N2+  +   e-
+
+         Ln2(i,81)    = jion8(8,i,1)
+         Pn2plus(i,81) = n2xinput * jion8(8,i,1)
+         Pelect(i,81)  = Pn2plus(i,81) !n2xinput * jion8(8,i,1)
+
+
+c     R82:   N2 + hv   -->  N+  +   N  +  e-
+
+         Ln2(i,82)     = jion8(8,i,2)
+         Pnplus(i,82)  = n2xinput * jion8(8,i,2)
+         Pn(i,82)      = Pnplus(i,82) !n2xinput * jion8(8,i,2)
+         Pelect(i,82)  = Pnplus(i,82) !n2xinput * jion8(8,i,2)
+
+
+c     R83:   H + hv   -->   H+   +  e
+
+         Lh(i,83)     = jion8(12,i,1)
+         Phplus(i,83)     = hxinput * jion8(12,i,1)
+         Pelect(i,83)     = Phplus(i,83) !hxinput * jion8(12,i,1)
+
+
+c     R84:   N + hv   -->   N+   +  e
+
+         Ln(i,84)     = jion8(9,i,1)
+         Pnplus(i,84)     = nxinput * jion8(9,i,1)
+         Pelect(i,84)     = Pnplus(i,84) !nxinput * jion8(9,i,1)
+
+
+c     R85:   N+ + CO2   -->   CO2+  +   N
+
+         Pn(i,85)       = ch85 * co2xinput * nplusxinput
+         Pco2plus(i,85) = Pn(i,85) !ch85 * co2xinput * nplusxinput
+         Lnplus(i,85)   = ch85 * co2xinput
+         Lco2(i,85)     = ch85 * nplusxinput
+
+
+c     R86:   H2 + CO2+   --> H + HCO2+
+         Ph(i,86) = ch86 * co2plusxinput * h2xinput
+         Lco2plus(i,86) = ch86 * h2xinput
+         Lh2(i,86) = ch86 * co2plusxinput
+                                !!! 
+
+c     R87: HCO2+ + e --> H + CO2
+         Ph(i,87) = ch87 * hco2plusxinput * electxinput
+         Pco2(i,87) = Ph(i,87)
+         Lhco2plus(i,87) = ch87 * electxinput
+         Lelect(i,87) = ch87 * hco2plusxinput
+
+
+c     R88:   N  +  e  -->  N+  +  e  +  e
+      
+         Pnplus(i,88)   = ionsec_nplus(zenit,zx(i))*Pnplus(i,84)
+         Pelect(i,88)    = Pnplus(i,88)
+         if(nxinput.ge.1.d-20) then
+            Ln(i,88)    = Pnplus(i,88)/nxinput
+         else
+            Ln(i,88)    = 1.d-30
+         endif
+
+
+c     R89:   N2  +  e  -->  N2+  +  e  +  e
+
+         Pn2plus(i,89)  = ionsec_n2plus(zenit,zx(i))*Pn2plus(i,81)
+         Pelect(i,89)    = Pn2plus(i,89)
+         if(n2xinput.ge.1.d-20) then
+            Ln2(i,89)   = Pn2plus(i,89)/n2xinput
+         else
+            Ln2(i,89)   = 1.d-30
+         endif
+
+
+c     R90:  O  +  e  -->  O+  +  e  +  e
+
+         Poplus(i,90)   = ionsec_oplus(zenit,zx(i))*Poplus(i,61)
+         Pelect(i,90)    = Poplus(i,90)
+         if(o3pxinput.ge.1.d-20) then
+            Lo3p(i,90)    = Poplus(i,90)/o3pxinput
+         else
+            Lo3p(i,90)    = 1.d-30
+         endif
+
+
+c     R91:  CO  +  e  -->  CO+  +  e  +  e
+      
+         Pcoplus(i,91)  = ionsec_coplus(zenit,zx(i))*Pcoplus(i,77)
+         Pelect(i,91)    = Pcoplus(i,91)
+         if(coxinput.ge.1.d-20) then
+            Lco(i,91)   = Pcoplus(i,91)/coxinput
+         else
+            Lco(i,91)   = 1.d-30
+         endif
+
+
+c     R92:  CO2  +  e  -->  CO2+  +  e  +  e
+      
+         Pco2plus(i,92) = ionsec_co2plus(zenit,zx(i))*
+     $        Pco2plus(i,51)
+         Pelect(i,92)    = Pco2plus(i,92)
+         if(co2xinput.ge. 1.d-20) then
+            Lco2(i,92)  = Pco2plus(i,92)/co2xinput
+         else
+            Lco2(i,92)  = 1.d-30
+         endif
+
+
+c     R93:  O2  +  e  -->  O2+  +  e
+         Po2plus(i,93)  = ionsec_o2plus(zenit,zx(i))*Po2plus(i,60)
+         Pelect(i,93)    = Po2plus(i,93)
+         if(o2xinput.ge.1.d-20) then
+            Lo2(i,93)   = Po2plus(i,93)/o2xinput
+         else
+            Lo2(i,93)   = 1.d-30
+         endif
+         
+      endif   !Of chemthermod.eq.3
+
+
+
+c     Total production and loss for each species. To save CPU time, we 
+c     do not sum over all reactions, but only over those where the species
+c     participates
+
+c     CO2: 
+c     Prod: R4, R46, R47, R62, R87
+c     Loss: R1, R16, R38, R50, R51, R52, R53, R54, R57, R59, R68, R85, R92
+      
+      Pco2tot(i) = Pco2(i,4) + Pco2(i,46) + Pco2(i,47) + Pco2(i,62)
+     $     + Pco2(i,87)
+      Lco2tot(i) = Lco2(i,1) + Lco2(i,16) + Lco2(i,38) + Lco2(i,50) +
+     $     Lco2(i,51) + Lco2(i,52) + Lco2(i,53) + Lco2(i,54) +
+     $     Lco2(i,56) + Lco2(i,57) + Lco2(i,59) + Lco2(i,68) + 
+     $     Lco2(i,85) + Lco2(i,92)
+
+c     O2
+c     Prod: R3, R5, R7, R10, R11, R13, R22, R23, R24, R25, R26, R34, R41, R42,
+c           R54, R64
+c     Loss: R2, R12, R17, R21, R32, R46, R60, R93
+
+      Po2tot(i) = Po2(i,3) + Po2(i,5) + Po2(i,7) + Po2(i,10) + 
+     $     Po2(i,11) + Po2(i,13) + Po2(i,22) + Po2(i,23) + Po2(i,24) +
+     $     Po2(i,25) + Po2(i,26) + Po2(i,34) + Po2(i,41) + Po2(i,42) +
+     $     Po2(i,54) + Po2(i,56) + Po2(i,64)
+      Lo2tot(i) = Lo2(i,2) + Lo2(i,12) + Lo2(i,17) + Lo2(i,21) +
+     $     Lo2(i,32) + Lo2(i,46) + Lo2(i,60) + Lo2(i,93)
+
+      
+c     O(3p)
+c     Prod: R1, R12, R17, R19, R20, R25, R29, R30, R31, R32, R44, R49, R53,
+c           R55, R66, R74, R75, R78
+c     Loss: R3, R10, R11, R21, R40, R41, R45, R47, R48, R58, R61, R69, R72,
+c           R76, R90
+
+      Po3ptot(i) = Po3p(i,1) + Po3p(i,12) + Po3p(i,17) + Po3p(i,19) +
+     $     Po3p(i,20) + Po3p(i,25) + Po3p(i,29) + Po3p(i,30) + 
+     $     Po3p(i,31) + Po3p(i,32) + Po3p(i,44) + Po3p(i,49) +
+     $     Po3p(i,53) + Po3p(i,55) + Po3p(i,66) + Po3p(i,74) +
+     $     Po3p(i,75) + Po3p(i,78)
+      Lo3ptot(i) = Lo3p(i,3) + Lo3p(i,10) + Lo3p(i,11) + Lo3p(i,21) +
+     $     Lo3p(i,40) + Lo3p(i,41) + Lo3p(i,45) + Lo3p(i,47) +
+     $     Lo3p(i,48) + Lo3p(i,58) + Lo3p(i,61) + Lo3p(i,69) +
+     $     Lo3p(i,72) + Lo3p(i,76) + Lo3p(i,90)
+
+
+c     CO
+c     Prod: R1, R16, R38, R48, R50, R52, R55, R57, R58, R59, R73
+c     Loss: R4, R70, R77, R78, R91
+      
+      Pcotot(i) = Pco(i,1) + Pco(i,16) + Pco(i,38) + Pco(i,48) +
+     $     Pco(i,50) + Pco(i,52) + Pco(i,55) + Pco(i,57) + Pco(i,58) +
+     $     Pco(i,59) + Pco(i,73)
+      Lcotot(i) = Lco(i,4) + Lco(i,70) + Lco(i,77) + Lco(i,78) +
+     $     Lco(i,90)
+
+
+c     H
+c     Prod: R4, R8, R11, R14, R15, R27, R33, R76, R86, R87
+c     Loss: R2, R13, R22, R43, R73, R74, R83
+      
+      Phtot(i) = Ph(i,4) + Ph(i,8) + Ph(i,11) + Ph(i,14) + Ph(i,15) +
+     $     Ph(i,27) + Ph(i,33) + Ph(i,76) + Ph(i,86) + Ph(i,87)
+      Lhtot(i) = Lh(i,2) + Lh(i,13) + Lh(i,22) + Lh(i,43) + Lh(i,73) +
+     $     Lh(i,74) + Lh(i,83)
+      
+
+c     OH
+c     Prod: R3, R6, R8, R9, R14, R22, R24, R35, R39, R43
+c     Loss: R4, R7, R11, R15, R18, R23, R33
+
+      Pohtot(i) = Poh(i,3) + Poh(i,6) + Poh(i,8) + Poh(i,9) +
+     $     Poh(i,14) + Poh(i,22) + Poh(i,24) + Poh(i,35) + Poh(i,39) +
+     $     Poh(i,43)
+      Lohtot(i) = Loh(i,4) + Loh(i,7) + Loh(i,11) + Loh(i,15) +
+     $     Loh(i,18) + Loh(i,23) + Loh(i,33)
+
+
+c     HO2
+c     Prod: R2, R18, R23
+c     Loss: R3, R5, R7, R13, R24, R35, R39
+
+      Pho2tot(i) = Pho2(i,2) + Pho2(i,18) + Pho2(i,23)
+      Lho2tot(i) = Lho2(i,3) + Lho2(i,5) + Lho2(i,7) + Lho2(i,13) +
+     $     Lho2(i,24) + Lho2(i,35) + Lho2(i,39)
+
+
+c     H2
+c     Prod: R13
+c     Loss: R14, R15, R27, R86
+
+      Ph2tot(i) = Ph2(i,13)
+      Lh2tot(i) = Lh2(i,14) + Lh2(i,15) + Lh2(i,27) + Lh2(i,86)
+      
+
+c     H2O
+c     Prod: R7, R15, R18
+c     Loss: R8, R9
+
+      Ph2otot(i) = Ph2o(i,7) + Ph2o(i,15) + Ph2o(i,18)
+      Lh2otot(i) = Lh2o(i,8) + Lh2o(i,9)
+      
+
+c     O(1d)
+c     Prod: R16, R17, R26
+c     Loss: R9, R14, R19, R20, R31
+
+      Po1dtot(i) = Po1d(i,16) + Po1d(i,17) + Po1d(i,26)
+      Lo1dtot(i) = Lo1d(i,9) + Lo1d(i,14) + Lo1d(i,19) + Lo1d(i,20) +
+     $     Lo1d(i,31)
+      
+
+c     H2O2
+c     Prod: R5
+c     Loss: R6, R18
+
+      Ph2o2tot(i) = Ph2o2(i,5)
+      Lh2o2tot(i) = Lh2o2(i,6) + Lh2o2(i,18)
+      
+
+      !Only if O3, N or ion chemistry requested
+      if(chemthermod.ge.1) then
+
+c     O3
+c     Prod: R21
+c     Loss: R22, R23, R24, R25, R26, R34, R42
+
+         Po3tot(i) = Po3(i,21)
+         Lo3tot(i) = Lo3(i,22) + Lo3(i,23) + Lo3(i,24) + Lo3(i,25) +
+     $        Lo3(i,26) + Lo3(i,34) + Lo3(i,42)
+
+      endif
+
+
+      !Only if N or ion chemistry requested
+      if(chemthermod.ge.2) then
+
+c     N
+c     Prod: R28, R29, R36, R37, R67, R69, R71, R75, R82, R85
+c     Loss: R30, R32, R33, R34, R35, R45, R63, R66, R84, R88
+         
+         Pntot(i) = Pn(i,28) + Pn(i,29) + Pn(i,36) + Pn(i,37) +Pn(i,67)+
+     $        Pn(i,69) + Pn(i,71) + Pn(i,75) + Pn(i,82) + Pn(i,85)
+         Lntot(i) = Ln(i,30) + Ln(i,32) + Ln(i,33) + Ln(i,34) +Ln(i,35)+
+     $        Ln(i,45) + Ln(i,63) + Ln(i,66) + Ln(i,84) + Ln(i,88)
+      
+
+c     NO
+c     Prod: R32, R33, R34, R35, R38, R41, R43, R44, R45, R63, R65 
+c     Loss: R29, R30, R39, R40, R42, R62, R64, R80
+
+         Pnotot(i) = Pno(i,32) + Pno(i,33) + Pno(i,34) + Pno(i,35) +
+     $        Pno(i,38) + Pno(i,41) + Pno(i,43) + Pno(i,44) + Pno(i,45)+
+     $        Pno(i,63) + Pno(i,65)
+         Lnotot(i) = Lno(i,29) + Lno(i,30) + Lno(i,39) + Lno(i,40) +
+     $        Lno(i,42) + Lno(i,62) + Lno(i,64) + Lno(i,80)
+      
+
+c     N2
+c     Prod: R30, R68, R70, R72
+c     Loss: R28, R65, R67, R81, R82, R89
+
+         Pn2tot(i) = Pn2(i,30) + Pn2(i,68) + Pn2(i,70) + Pn2(i,72)
+         Ln2tot(i) = Ln2(i,28) + Ln2(i,65) + Ln2(i,67) + Ln2(i,81) + 
+     $        Ln2(i,82) + Ln2(i,89)
+      
+
+c     N(2d)
+c     Prod: R28
+c     Loss: R36, R37, R38
+
+         Pn2dtot(i) = Pn2d(i,28)
+         Ln2dtot(i) = Ln2d(i,36) + Ln2d(i,37) + Ln2d(i,38)
+      
+
+c     NO2
+c     Prod: R39, R40, R42
+c     Loss: R41, R43, R44
+
+         Pno2tot(i) = Pno2(i,39) + Pno2(i,40) + Pno2(i,42)
+         Lno2tot(i) = Lno2(i,41) + Lno2(i,43) + Lno2(i,44)
+      
+      endif    !Of chemthermod.ge.2
+                                ! 
+      
+      !Only if ion chemistry requested
+      if(chemthermod.eq.3) then
+
+c     CO2+
+c     Prod: R51,R57, R68, R85, R92
+c     Loss: R46, R47, R48, R55, R62, R63, R86
+
+         Pco2plustot(i) = Pco2plus(i,51) + Pco2plus(i,57) + 
+     $        Pco2plus(i,68) + Pco2plus(i,85) + Pco2plus(i,92)
+         Lco2plustot(i) = Lco2plus(i,46) + Lco2plus(i,47) + 
+     $        Lco2plus(i,48) + Lco2plus(i,55) + Lco2plus(i,62) + 
+     $        Lco2plus(i,63) + Lco2plus(i,86)
+      
+
+c     O+
+c     Prod: R47, R52, R58, R61, R72, R76, R90
+c     Loss: 50,67,74
+
+         Poplustot(i) = Poplus(i,47) + Poplus(i,52) + Poplus(i,58) +
+     $        Poplus(i,61) + Poplus(i,72) + Poplus(i,76) + Poplus(i,90)
+         Loplustot(i) = Loplus(i,50) + Loplus(i,56) + Loplus(i,67) + 
+     $        Loplus(i,74)
+
+c     O2+
+c     Prod: R46, R48, R50, R60, R93
+c     Loss: R49, R64, R65, R66
+
+         Po2plustot(i) = Po2plus(i,46) + Po2plus(i,48) + Po2plus(i,50) +
+     $        Po2plus(i,60) + Po2plus(i,93)
+         Lo2plustot(i) = Lo2plus(i,49) + Lo2plus(i,64) + Lo2plus(i,65) +
+     $        Lo2plus(i,66)
+
+
+c     CO+
+c     Prod: R53, R59, R63, R70, R77, R91
+c     Loss: R57, R58, R73
+      
+         Pcoplustot(i) = Pcoplus(i,53) + Pcoplus(i,56) + Pcoplus(i,59) + 
+     $        Pcoplus(i,63) + Pcoplus(i,70) + Pcoplus(i,77) + 
+     $        Pcoplus(i,91)
+         Lcoplustot(i) = Lcoplus(i,57) + Lcoplus(i,58) + Lcoplus(i,73)
+      
+
+c     C+
+c     Prod: R54, R78
+c     Loss: R59
+
+         Pcplustot(i) = Pcplus(i,54) + Pcplus(i,78)
+         Lcplustot(i) = Lcplus(i,59)
+      
+
+c     N+
+c     Prod: R82, R84, R88
+c     Loss: R85
+
+         Pnplustot(i) = Pnplus(i,82) + Pnplus(i,84) + Pnplus(i,88)
+         Lnplustot(i) = Lnplus(i,85)
+      
+
+c     N2+
+c     Prod: R81, R89
+c     Loss: R68, R69, R70, R71, R72
+
+         Pn2plustot(i) = Pn2plus(i,81) + Pn2plus(i,89)
+         Ln2plustot(i) = Ln2plus(i,68) + Ln2plus(i,69) + Ln2plus(i,70) +
+     $        Ln2plus(i,71) + Ln2plus(i,72)
+      
+
+c     NO+
+c     Prod: R62, R64, R65, R66, R67, R69, R80
+c     Loss: R75
+
+         Pnoplustot(i) = Pnoplus(i,62) + Pnoplus(i,64) + Pnoplus(i,65) +
+     $        Pnoplus(i,66) + Pnoplus(i,67) + Pnoplus(i,69) + 
+     $        Pnoplus(i,80)
+         Lnoplustot(i) = Lnoplus(i,75)
+      
+
+c     H+
+c     Prod: R73, R74, R83
+c     Loss: R76
+
+         Phplustot(i) = Phplus(i,73) + Phplus(i,74) + Phplus(i,83)
+         Lhplustot(i) = Lhplus(i,76)
+      
+
+c     HCO2+
+c     Prod: R86
+c     Loss: R87
+
+         Phco2plustot(i) = Phco2plus(i,86)
+         Lhco2plustot(i) = Lhco2plus(i,87)
+
+c     e-
+c     Prod: R51, R52, R53, R54, R60, R61, R77, R78, R80, R81, R82, R83, R84, 
+c           R88, R89, R90, R91, R92, R93
+c     Loss: R49, R55, R71, R75, R87
+
+         Pelecttot(i) = Pelect(i,51) + Pelect(i,52) + Pelect(i,53) + 
+     $        Pelect(i,54) + Pelect(i,60) + Pelect(i,61) + Pelect(i,77)+
+     $        Pelect(i,78) + Pelect(i,80) + Pelect(i,81) + Pelect(i,82)+
+     $        Pelect(i,83) + Pelect(i,84) + Pelect(i,88) + Pelect(i,89)+
+     $        Pelect(i,90) + Pelect(i,91) + Pelect(i,92) + Pelect(i,93)
+         Lelecttot(i) = Lelect(i,49) + Lelect(i,55) + Lelect(i,71) +
+     $        Lelect(i,75) + Lelect(i,87)
+      
+      endif    !Of chemthermod.eq.3
+
+      return
+c END
+      end
+
+
+
+
+c**********************************************************************
+c**********************************************************************
+
+      subroutine EF_oscilacion
+     &               (ig,i,paso,chemthermod,zenit, zx,
+     &                 jdistot8, jdistot8_b,jion8, 
+     &                 tminaux, 
+     &                           co2xoutput,     co2xinput,
+     $                           o2xoutput,      o2xinput,
+     $                           o3pxoutput,     o3pxinput,
+     $                           coxoutput,      coxinput,
+     $                           h2xoutput,      h2xinput,
+     $                           h2oxoutput,     h2oxinput,
+     $                           h2o2xoutput,    h2o2xinput,
+     $                           o3xoutput,      o3xinput,
+     $                           nxoutput,       nxinput,
+     $                           noxoutput,      noxinput,
+     $                           n2xoutput,      n2xinput,
+     &                           o1dxoutput,     o1dxinput, 
+     &                           ohxoutput,      ohxinput, 
+     &                           ho2xoutput,     ho2xinput, 
+     &                           hxoutput,       hxinput, 
+     &                           n2dxoutput,     n2dxinput, 
+     &                           no2xoutput,     no2xinput, 
+     &                         co2plusxoutput, co2plusxinput, 
+     &                         o2plusxoutput,  o2plusxinput, 
+     &                         coplusxoutput,  coplusxinput, 
+     &                         oplusxoutput,   oplusxinput, 
+     &                         cplusxoutput,   cplusxinput, 
+     &                         noplusxoutput,  noplusxinput, 
+     &                         n2plusxoutput,  n2plusxinput, 
+     &                         hplusxoutput,   hplusxinput, 
+     &                         nplusxoutput,   nplusxinput, 
+     $                         hco2plusxoutput,hco2plusxinput,
+     &                         electxoutput,   electxinput, 
+     &                           electxoutput_timemarching )
+
+  
+c Calculates the concentrations of the fast species in PE
+c
+
+c         2009      FGG       Adaptation to GCM
+c     jul 2008      MA        Version en subrutina
+c     nov 2007      MA        Original. Evita oscilacion en EF
+c**********************************************************************
+
+      implicit none
+
+      include "dimensions.h"
+      include "dimphys.h"
+      include 'param.h'
+      include 'param_v4.h'
+      include 'iono.h'
+
+
+c     arguments
+      
+      integer   ig
+      integer   i         ! I. Layer                              
+      integer   paso      ! I. paso temporal del timemarching, 1,numpasos
+      integer   chemthermod
+      real*8    tminaux   ! I.
+      real      zx(nlayermx)
+      real      zenit
+      real*8    jdistot8(nabs,nlayermx)                  ! I.
+      real*8    jdistot8_b(nabs,nlayermx)                ! I.
+      real*8    jion8(nabs,nlayermx,4)
+
+      real*8    co2xoutput,o2xoutput,o3pxoutput,coxoutput,h2xoutput
+      real*8    h2o2xoutput,o3xoutput,h2oxoutput
+      real*8    nxoutput,noxoutput,n2xoutput
+      real*8    ho2xoutput,      hxoutput,       ohxoutput    ! O.
+      real*8    o1dxoutput,      n2dxoutput,     no2xoutput   ! O.
+
+      real*8    co2xinput,o2xinput,o3pxinput,coxinput,h2xinput
+      real*8    h2o2xinput,o3xinput,h2oxinput
+      real*8    nxinput,noxinput,n2xinput
+      real*8    ho2xinput,       hxinput,        ohxinput     ! I.
+      real*8    o1dxinput,       n2dxinput,      no2xinput    ! I. 
+
+      real*8    co2plusxoutput,  coplusxoutput,  oplusxoutput   ! O.
+      real*8    o2plusxoutput,   cplusxoutput,   noplusxoutput  ! O.
+      real*8    n2plusxoutput,   hplusxoutput                   ! O.
+      real*8    electxoutput,    nplusxoutput, hco2plusxoutput  ! O.
+      real*8    co2plusxinput,   coplusxinput,   oplusxinput    ! I.
+      real*8    o2plusxinput,    cplusxinput,    noplusxinput   ! I.
+      real*8    n2plusxinput,    hplusxinput                    ! I.
+      real*8    electxinput,     nplusxinput, hco2plusxinput    ! I.
+
+      real*8    electxoutput_timemarching           ! I. 
+
+   
+
+c     local variables
+
+      integer   npasitos
+      parameter (npasitos=20)
+      real*8    electxoutput_neutr
+
+      real*8    ho2xoutput2, hxoutput2, ohxoutput2
+      real*8    o1dxoutput2, n2dxoutput2, no2xoutput2
+      real*8    co2plusxoutput2, coplusxoutput2, oplusxoutput2
+      real*8    o2plusxoutput2, hplusxoutput2, nplusxoutput2
+      real*8    cplusxoutput2, noplusxoutput2, n2plusxoutput2
+      real*8    hco2plusxoutput2
+      !real*8    electxoutput2
+
+      integer   correc_oscil,  ip 
+      real*8    avg_pares, avg_impar, dispersion
+      real*8    dif_impar, dif_pares , dif_pares_impar
+      real*8    ho2xpares(3), hxpares(3), ohxpares(3)
+      real*8    o1dxpares(3), n2dxpares(3), no2xpares(3)
+      real*8    co2plusxpares(3), coplusxpares(3), oplusxpares(3)
+      real*8    o2plusxpares(3), hplusxpares(3), nplusxpares(3)
+      real*8    cplusxpares(3), noplusxpares(3), n2plusxpares(3)
+      real*8    hco2plusxpares(3)
+      real*8    ho2ximpar(3), hximpar(3), ohximpar(3)
+      real*8    o1dximpar(3), n2dximpar(3), no2ximpar(3)
+      real*8    co2plusximpar(3), coplusximpar(3), oplusximpar(3)
+      real*8    o2plusximpar(3), hplusximpar(3), nplusximpar(3)
+      real*8    cplusximpar(3), noplusximpar(3), n2plusximpar(3)
+      real*8    hco2plusximpar(3)
+      real*8    auxp,auxl,ca, cb,cc, cd1,cd2,ce
+      real*8    IonMostAbundant
+
+      real*8    cocimin
+      parameter (cocimin=1.d-30)
+
+      integer   cociopt
+      parameter (cociopt=1)
+
+c external functions
+c
+      external cociente
+      real*8   cociente
+
+      external ionsec_nplus
+      real*8   ionsec_nplus
+
+      external ionsec_n2plus
+      real*8   ionsec_n2plus
+
+      external ionsec_oplus
+      real*8   ionsec_oplus
+
+      external ionsec_coplus
+      real*8   ionsec_coplus
+
+      external ionsec_co2plus
+      real*8   ionsec_co2plus
+
+      external ionsec_o2plus
+      real*8   ionsec_o2plus
+
+ccccccccccccccc CODE STARTS 
+
+           !!! Starts iteration to avoid oscilations
+
+      correc_oscil=0
+
+      do ip = 1, npasitos 
+
+         if (ip.eq.1) then 
+            if (o1d_eq(i).eq.'Y') o1dxoutput = o1dxinput 
+            if (oh_eq(i).eq.'Y') ohxoutput = ohxinput 
+            if (ho2_eq(i).eq.'Y') ho2xoutput = ho2xinput 
+            if (h_eq(i).eq.'Y') hxoutput = hxinput 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dxoutput = n2dxinput 
+               if (no2_eq(i).eq.'Y') no2xoutput = no2xinput
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.ge.3) then
+               if (n2plus_eq(i).eq.'Y') n2plusxoutput=n2plusxinput 
+               if (cplus_eq(i).eq.'Y') cplusxoutput=cplusxinput 
+               if (coplus_eq(i).eq.'Y') coplusxoutput=coplusxinput 
+               if (oplus_eq(i).eq.'Y') oplusxoutput=oplusxinput 
+               if (hplus_eq(i).eq.'Y') hplusxoutput=hplusxinput 
+               if (co2plus_eq(i).eq.'Y') co2plusxoutput=co2plusxinput 
+               if (noplus_eq(i).eq.'Y') noplusxoutput=noplusxinput 
+               if (o2plus_eq(i).eq.'Y') o2plusxoutput=o2plusxinput 
+               if (nplus_eq(i).eq.'Y') nplusxoutput=nplusxinput 
+               if (hco2plus_eq(i).eq.'Y') hco2plusxoutput=hco2plusxinput
+               electxoutput = electxinput 
+            endif
+         endif
+
+              
+         ! 6 neutral , O1D, OH, HO2, H, N2D, NO2
+
+         !O1D
+         if (o1d_eq(i).eq.'Y') then
+            auxp = jdistot8_b(1,i) * co2xoutput 
+     &           + jdistot8_b(2,i) * o2xoutput
+     &           + jdistot8_b(7,i) * o3xoutput
+            auxl = ch9 * h2oxoutput
+     &           + ch14 * h2xoutput
+     &           + ch19 * co2xoutput
+     &           + ch20 * o2xoutput
+     &           + ch31 * n2xoutput
+            o1dxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+         end if
+           
+           !OH
+         if (oh_eq(i).eq.'Y') then
+            auxp = ch3 * o3pxoutput * ho2xoutput
+     &           + 2.d0 * jdistot8(6,i) * h2o2xoutput
+     &           + jdistot8(4,i) * h2oxoutput
+     &           + 2.d0 * ch9 * o1dxoutput * h2oxoutput 
+     &           + ch14 * o1dxoutput * h2xoutput
+     &           + ch22 * o3xoutput * hxoutput
+     &           + ch24 * o3xoutput * ho2xoutput
+     &           + ch35 * nxoutput * ho2xoutput
+     &           + ch39 * noxoutput * ho2xoutput
+     &           + ch43 * no2xoutput * hxoutput
+            auxl = ch4 * coxoutput
+     &           + ch7 * ho2xoutput
+     &           + ch11 * o3pxoutput
+     &           + ch15 * h2xoutput
+     &           + ch18 * h2o2xoutput
+     &           + ch23 * o3xoutput
+     &           + ch33 * nxoutput
+            ohxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+
+         end if
+
+			
+         !HO2
+         if (ho2_eq(i).eq.'Y') then
+            auxp = ch2 * hxoutput * o2xoutput * co2xoutput
+     &           + ch18 * ohxoutput * h2o2xoutput
+     &           + ch23 * ohxoutput * o3xoutput
+            auxl = ch3 * o3pxoutput
+     &           + 2.d0 * ch5 * ho2xoutput 
+     &           + ch7 * ohxoutput
+     &           + ch13 * hxoutput
+     &           + ch24 * o3xoutput
+     &           + ch35 * nxoutput
+     &           + ch39 * noxoutput
+            ho2xoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+         end if
+
+         !H
+         if (h_eq(i).eq.'Y') then
+            auxp = ch4 * coxoutput * ohxoutput
+     &           + jdistot8(4,i) * h2oxoutput
+     &           + ch11 * o3pxoutput * ohxoutput
+     &           + ch14 * o1dxoutput * h2xoutput
+     &           + ch15 * ohxoutput * h2xoutput
+     &           + 2.d0 * jdistot8(5,i) * h2xoutput
+     &           +  ch33 * nxoutput * ohxoutput
+     &           + ch76 *  hplusxoutput * o3pxoutput
+     &           + hxoutput * jion8(12,i,1) 
+     $           + ch86 * h2xoutput * co2plusxoutput
+     $           + ch87 * hco2plusxoutput * electxoutput
+            auxl = ch2 * o2xoutput * co2xoutput
+     &           + ch13 * ho2xoutput
+     &           + ch22 * o3xoutput
+     &           + ch43 * no2xoutput
+     &           + ch73 * coplusxoutput
+     &           + ch74 * oplusxoutput
+     &           + jion8(12,i,1)
+            hxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+         end if
+			
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+         !N2D
+            if (n2d_eq(i).eq.'Y') then
+               auxp = jdistot8(8,i) * n2xoutput
+               auxl = ch36 * o3pxoutput
+     &              + ch37 * n2xoutput
+     &              + ch38 * co2xoutput
+               n2dxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+
+         !NO2
+            if (no2_eq(i).eq.'Y') then
+               auxp = ch39 * noxoutput * ho2xoutput
+     &              + ch40 * o3pxoutput * noxoutput * co2xoutput
+     &              + ch42 * noxoutput * o3xoutput
+               auxl = ch41 * o3pxoutput
+     &              + ch43 * hxoutput
+     &              + jdistot8(13,i)
+               no2xoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+            
+         endif    !Of chemthermod.ge.2
+         
+         ! 9 ions 
+
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+         ! N2+
+            if (n2plus_eq(i).eq.'Y') then
+               auxp = jion8(8,i,1)*n2xoutput*
+     $              (1.d0+ionsec_n2plus(zenit,zx(i)))
+               auxl = ch68*co2xoutput
+     &              + ch69*o3pxoutput 
+     &              + ch70*coxoutput
+     $              + ch71*electxoutput
+     &              + ch72*o3pxoutput
+               n2plusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+
+         ! C+
+            if (cplus_eq(i).eq.'Y') then
+               auxp = jion8(1,i,4)*co2xoutput 
+     &              + jion8(11,i,2)*coxoutput
+               auxl = ch59*co2xoutput
+               cplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+            
+         ! CO+
+            if (coplus_eq(i).eq.'Y') then
+               auxp = jion8(1,i,3)*co2xoutput 
+     $              + ch59*cplusxoutput *co2xoutput 
+     $              + ch63*co2plusxoutput*nxoutput 
+     $              + ch70*n2plusxoutput*coxoutput 
+     $              + jion8(11,i,1)*coxoutput*
+     $              (1.d0+ionsec_coplus(zenit,zx(i))) 
+               auxl = ch57*co2xoutput 
+     &              + ch58*o3pxoutput 
+     &              + ch73*hxoutput
+               coplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+
+         ! CO2+
+            if (co2plus_eq(i).eq.'Y') then
+               auxp = jion8(1,i,1)*co2xoutput*
+     $              (1.d0+ionsec_co2plus(zenit,zx(i))) 
+     &              + ch57*coplusxoutput*co2xoutput
+     $              + ch68*n2plusxoutput*co2xoutput 
+     &              + ch85*nplusxoutput*co2xoutput
+               auxl = ch46*o2xoutput 
+     &              + ch47*o3pxoutput 
+     &              + ch55*electxoutput
+     $              + ch62*noxoutput 
+     &              + ch63*nxoutput 
+     &              + ch48*o3pxoutput
+     $              + ch86*h2xoutput
+               co2plusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+
+         !
+         !   [O+] [H+] are linked: 2 equations with 2 unknowns 
+         !
+         !      [H+] = (ca + cb [O+])/cd1
+         !      [O+] = (cc + ce [H+])/cd2
+         !        
+            ca  = ch73 * coplusxoutput * hxoutput 
+     &           + jion8(12,i,1)*hxoutput 
+            cb  = ch74 * hxoutput
+            cd1 = ch76 * o3pxoutput              
+            cc  = ch47*co2plusxoutput*o3pxoutput 
+     &           + jion8(1,i,2)*co2xoutput
+     $           + jion8(3,i,1)*o3pxoutput*
+     $           (1.d0+ionsec_oplus(zenit,zx(i))) 
+     &           + ch58*coplusxoutput*o3pxoutput
+     $           + ch72*n2plusxoutput*o3pxoutput 
+            ce  = ch76 * o3pxoutput
+            cd2 = ch50*co2xoutput + ch67*n2xoutput + ch74*hxoutput
+            
+         ! O+
+            if (oplus_eq(i).eq.'Y') then
+               auxp = cc*cd1 + ce*ca
+               auxl = cd1*cd2 -ce*cb
+               oplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            end if
+         
+         ! H+
+            if (hplus_eq(i).eq.'Y') then 
+               auxp = ca + cb * oplusxoutput
+               auxl = cd1
+               hplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+           
+         ! O2+
+            if (o2plus_eq(i).eq.'Y') then
+               auxp = ch46*co2plusxoutput*o2xoutput  
+     $              + ch48*co2plusxoutput*o3pxoutput
+     $              + ch50*oplusxoutput*co2xoutput 
+     $              + jion8(2,i,1)*o2xoutput*
+     $              (1.d0+ionsec_o2plus(zenit,zx(i)))
+               auxl = ch49*electxoutput + ch64*noxoutput 
+     $              + ch65*n2xoutput + ch66*nxoutput
+               o2plusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+
+         ! NO+
+            if(noplus_eq(i).eq.'Y') then
+               auxp = ch62*coplusxoutput*noxoutput 
+     $              + ch64*o2plusxoutput*noxoutput
+     $              + ch65*o2plusxoutput*n2xoutput 
+     $              + ch66*o2plusxoutput*nxoutput
+     $              + ch67*oplusxoutput*n2xoutput 
+     $              + ch69*n2plusxoutput*o3pxoutput
+     $              + jion8(10,i,1)*noxoutput 
+               auxl = ch75*electxoutput
+               noplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+
+         ! N+
+            if(nplus_eq(i).eq.'Y') then
+               auxp = jion8(8,i,2)*n2xoutput 
+     &              + jion8(9,i,1)*nxoutput*
+     $              (1.d0+ionsec_nplus(zenit,zx(i))) 
+               auxl = ch85*co2xoutput
+               nplusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+
+         ! HCO2+
+            if(hco2plus_eq(i).eq.'Y') then
+               auxp = ch86*h2xoutput*co2plusxoutput
+               auxl = ch87*electxoutput
+               hco2plusxoutput2 = cociente(auxp,auxl,cocimin,cociopt)
+            endif
+
+         endif    !Of chemthermod.eq.3
+
+         ! Detection of oscilations and elimination
+           
+         if (ip.eq.4 .or. ip.eq.14) then ! ***pares(1) 
+            
+            if (o1d_eq(i).eq.'Y') o1dxpares(1)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohxpares(1)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2xpares(1)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hxpares(1)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dxpares(1)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2xpares(1)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusxpares(1)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusxpares(1)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusxpares(1)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusxpares(1)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusxpares(1)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusxpares(1)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusxpares(1)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusxpares(1)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusxpares(1)=nplusxoutput2
+               if (hco2plus_eq(i).eq.'Y') 
+     $              hco2plusxpares(1)=hco2plusxoutput2
+            endif
+
+         elseif (ip.eq.6 .or. ip.eq.16) then ! ***pares(2)
+
+            if (o1d_eq(i).eq.'Y') o1dxpares(2)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohxpares(2)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2xpares(2)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hxpares(2)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dxpares(2)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2xpares(2)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusxpares(2)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusxpares(2)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusxpares(2)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusxpares(2)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusxpares(2)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusxpares(2)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusxpares(2)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusxpares(2)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusxpares(2)=nplusxoutput2 
+               if (hco2plus_eq(i).eq.'Y')
+     $              hco2plusxpares(2)=hco2plusxoutput2
+            endif
+            
+         elseif (ip.eq.8 .or. ip.eq.18) then ! ***pares(3)
+            
+            if (o1d_eq(i).eq.'Y') o1dxpares(3)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohxpares(3)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2xpares(3)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hxpares(3)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dxpares(3)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2xpares(3)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusxpares(3)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusxpares(3)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusxpares(3)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusxpares(3)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusxpares(3)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusxpares(3)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusxpares(3)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusxpares(3)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusxpares(3)=nplusxoutput2 
+               if (hco2plus_eq(i).eq.'Y')
+     $              hco2plusxpares(3)=hco2plusxoutput2
+            endif
+
+         elseif (ip.eq.5 .or. ip.eq.15) then ! ***impar(1) 
+            
+            if (o1d_eq(i).eq.'Y') o1dximpar(1)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohximpar(1)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2ximpar(1)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hximpar(1)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dximpar(1)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2ximpar(1)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusximpar(1)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusximpar(1)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusximpar(1)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusximpar(1)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusximpar(1)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusximpar(1)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusximpar(1)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusximpar(1)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusximpar(1)=nplusxoutput2 
+               if (hco2plus_eq(i).eq.'Y')
+     $              hco2plusximpar(1)=hco2plusxoutput2
+            endif
+            
+         elseif (ip.eq.7 .or. ip.eq.17) then ! ***impar(2)
+            
+            if (o1d_eq(i).eq.'Y') o1dximpar(2)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohximpar(2)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2ximpar(2)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hximpar(2)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dximpar(2)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2ximpar(2)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusximpar(2)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusximpar(2)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusximpar(2)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusximpar(2)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusximpar(2)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusximpar(2)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusximpar(2)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusximpar(2)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusximpar(2)=nplusxoutput2 
+               if (hco2plus_eq(i).eq.'Y')
+     $              hco2plusximpar(2)=hco2plusxoutput2
+            endif
+            
+         elseif (ip.eq.9 .or. ip.eq.19) then ! ***impar(3)
+            
+            if (o1d_eq(i).eq.'Y') o1dximpar(3)=o1dxoutput2
+            if (oh_eq(i).eq.'Y')  ohximpar(3)=ohxoutput2 
+            if (ho2_eq(i).eq.'Y') ho2ximpar(3)=ho2xoutput2 
+            if (h_eq(i).eq.'Y')   hximpar(3)=hxoutput2 
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') n2dximpar(3)=n2dxoutput2 
+               if (no2_eq(i).eq.'Y') no2ximpar(3)=no2xoutput2
+            endif
+                                ! 
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (n2plus_eq(i).eq.'Y')  n2plusximpar(3)=n2plusxoutput2 
+               if (cplus_eq(i).eq.'Y')   cplusximpar(3)=cplusxoutput2 
+               if (coplus_eq(i).eq.'Y')  coplusximpar(3)=coplusxoutput2 
+               if (oplus_eq(i).eq.'Y')   oplusximpar(3)=oplusxoutput2 
+               if (hplus_eq(i).eq.'Y')   hplusximpar(3)=hplusxoutput2 
+               if (co2plus_eq(i).eq.'Y')co2plusximpar(3)=co2plusxoutput2 
+               if (noplus_eq(i).eq.'Y')  noplusximpar(3)=noplusxoutput2 
+               if (o2plus_eq(i).eq.'Y')  o2plusximpar(3)=o2plusxoutput2 
+               if (nplus_eq(i).eq.'Y')   nplusximpar(3)=nplusxoutput2 
+               if (hco2plus_eq(i).eq.'Y')
+     $              hco2plusximpar(3)=hco2plusxoutput2
+            endif
+            
+            
+            if (o1d_eq(i).eq.'Y') then
+               avg_pares = ( dlog10(o1dxpares(1)) +
+     &              dlog10(o1dxpares(2)) +
+     &              dlog10(o1dxpares(3)) )*0.333
+               dif_pares = ( abs(log10(o1dxpares(1))-avg_pares) + 
+     &              abs(dlog10(o1dxpares(2))-avg_pares) +   
+     &              abs(log10(o1dxpares(3))-avg_pares) ) * 0.333   
+               avg_impar = ( dlog10(o1dximpar(1)) + 
+     &              dlog10(o1dximpar(2)) +
+     &              dlog10(o1dximpar(3)) )*0.333
+               dif_impar = ( abs(dlog10(o1dximpar(1))-avg_impar) + 
+     &              abs(dlog10(o1dximpar(2))-avg_impar) +   
+     &              abs(dlog10(o1dximpar(3))-avg_impar) ) * 0.333
+               dispersion = dif_pares + dif_impar
+               dif_pares_impar = abs(avg_pares-avg_impar)
+               if (dif_pares_impar .gt. 5.d0*dispersion) then
+                  correc_oscil=correc_oscil+1
+                  o1dxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+               endif
+            endif
+            
+            if (oh_eq(i).eq.'Y') then
+               avg_pares = ( dlog10(ohxpares(1)) +
+     &              dlog10(ohxpares(2)) +
+     &              dlog10(ohxpares(3)) )*0.333
+               dif_pares = ( abs(dlog10(ohxpares(1))-avg_pares) + 
+     &              abs(dlog10(ohxpares(2))-avg_pares) +   
+     &              abs(dlog10(ohxpares(3))-avg_pares) ) * 0.333   
+               avg_impar = ( dlog10(ohximpar(1)) + 
+     &              dlog10(ohximpar(2)) +
+     &              dlog10(ohximpar(3)) )*0.333
+               dif_impar = ( abs(dlog10(ohximpar(1))-avg_impar) + 
+     &              abs(dlog10(ohximpar(2))-avg_impar) +   
+     &              abs(dlog10(ohximpar(3))-avg_impar) ) * 0.333
+               dispersion = dif_pares + dif_impar
+               dif_pares_impar = abs(avg_pares-avg_impar)
+               if (dif_pares_impar .gt. 5.*dispersion) then
+                  correc_oscil=correc_oscil+1
+                  ohxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+               endif
+               
+            endif
+            
+            if (ho2_eq(i).eq.'Y') then
+               avg_pares = ( dlog10(ho2xpares(1)) +
+     &              dlog10(ho2xpares(2)) +
+     &              dlog10(ho2xpares(3)) )*0.333
+               dif_pares = ( abs(dlog10(ho2xpares(1))-avg_pares) + 
+     &              abs(dlog10(ho2xpares(2))-avg_pares) +   
+     &              abs(dlog10(ho2xpares(3))-avg_pares) ) * 0.333   
+               avg_impar = ( dlog10(ho2ximpar(1)) + 
+     &              dlog10(ho2ximpar(2)) +
+     &              dlog10(ho2ximpar(3)) )*0.333
+               dif_impar = ( abs(dlog10(ho2ximpar(1))-avg_impar) + 
+     &              abs(dlog10(ho2ximpar(2))-avg_impar) +   
+     &              abs(dlog10(ho2ximpar(3))-avg_impar) ) * 0.333
+               dispersion = dif_pares + dif_impar
+               dif_pares_impar = abs(avg_pares-avg_impar)
+               if (dif_pares_impar .gt. 5.*dispersion) then
+                  correc_oscil=correc_oscil+1
+                  ho2xoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+               endif
+            endif
+            
+            if (h_eq(i).eq.'Y') then
+               avg_pares = ( dlog10(hxpares(1)) +
+     &              dlog10(hxpares(2)) +
+     &              dlog10(hxpares(3)) )*0.333
+               dif_pares = ( abs(dlog10(hxpares(1))-avg_pares) + 
+     &              abs(dlog10(hxpares(2))-avg_pares) +   
+     &              abs(dlog10(hxpares(3))-avg_pares) ) * 0.333   
+               avg_impar = ( dlog10(hximpar(1)) + 
+     &              dlog10(hximpar(2)) + 
+     &              dlog10(hximpar(3)) )*0.333
+               dif_impar = ( abs(dlog10(hximpar(1))-avg_impar) + 
+     &              abs(dlog10(hximpar(2))-avg_impar) +   
+     &              abs(dlog10(hximpar(3))-avg_impar) ) * 0.333
+               dispersion = dif_pares + dif_impar
+               dif_pares_impar = abs(avg_pares-avg_impar)
+               if (dif_pares_impar .gt. 5.*dispersion) then
+                  correc_oscil=correc_oscil+1
+                  hxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+               endif
+            endif
+            
+            !Only if N or ion chemistry requested
+            if(chemthermod.ge.2) then
+               if (n2d_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(n2dxpares(1)) +
+     &                 dlog10(n2dxpares(2)) +
+     &                 dlog10( n2dxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(n2dxpares(1))-avg_pares) + 
+     &                 abs(dlog10(n2dxpares(2))-avg_pares) +   
+     &                 abs(dlog10(n2dxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(n2dximpar(1)) + 
+     &                 dlog10(n2dximpar(2)) +
+     &                 dlog10( n2dximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(n2dximpar(1))-avg_impar) + 
+     &                 abs(dlog10(n2dximpar(2))-avg_impar) +   
+     &                 abs(dlog10(n2dximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     n2dxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+            
+               if (no2_eq(i).eq.'Y') then
+                  avg_pares = (dlog10(no2xpares(1)) + 
+     &                 dlog10(no2xpares(2)) +
+     &                 dlog10( no2xpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(no2xpares(1))-avg_pares) + 
+     &                 abs(dlog10(no2xpares(2))-avg_pares) +   
+     &                 abs(dlog10(no2xpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(no2ximpar(1)) + 
+     &                 dlog10(no2ximpar(2)) +
+     &                 dlog10( no2ximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(no2ximpar(1))-avg_impar) + 
+     &                 abs(dlog10(no2ximpar(2))-avg_impar) +   
+     &                 abs(dlog10(no2ximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     no2xoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+            endif    !Of chemthermod.ge.2
+
+                                ! IONS
+            !Only if ion chemistry requested
+            if(chemthermod.eq.3) then
+               if (cplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(cplusxpares(1)) +
+     &                 dlog10(cplusxpares(2)) +
+     &                 dlog10(cplusxpares(3)) ) * 0.333
+                  dif_pares = ( abs(dlog10(cplusxpares(1))-avg_pares) + 
+     &                 abs(dlog10(cplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(cplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(cplusximpar(1)) + 
+     &                 dlog10(cplusximpar(2)) +
+     &                 dlog10(cplusximpar(3)) ) * 0.333
+                  dif_impar = ( abs(dlog10(cplusximpar(1))-avg_impar) + 
+     &                 abs(dlog10(cplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(cplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     cplusxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (coplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(coplusxpares(1)) +
+     &                 dlog10(coplusxpares(2)) +
+     &                 dlog10(coplusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(coplusxpares(1))-avg_pares)+ 
+     &                 abs(dlog10(coplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(coplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(coplusximpar(1)) + 
+     &                 dlog10(coplusximpar(2)) +
+     &                 dlog10(coplusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(coplusximpar(1))-avg_impar)+ 
+     &                 abs(dlog10(coplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(coplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     coplusxoutput2=10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (oplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(oplusxpares(1)) +
+     &                 dlog10(oplusxpares(2)) +
+     &                 dlog10( oplusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(oplusxpares(1))-avg_pares) + 
+     &                 abs(dlog10(oplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(oplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(oplusximpar(1)) + 
+     &                 dlog10(oplusximpar(2)) +
+     &                 dlog10(oplusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(oplusximpar(1))-avg_impar) + 
+     &                 abs(dlog10(oplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(oplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     oplusxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (n2plus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(n2plusxpares(1)) +
+     &                 dlog10(n2plusxpares(2)) +
+     &                 dlog10(n2plusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(n2plusxpares(1))-avg_pares)+ 
+     &                 abs(dlog10(n2plusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(n2plusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(n2plusximpar(1)) + 
+     &                 dlog10(n2plusximpar(2))+
+     &                 dlog10(n2plusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(n2plusximpar(1))-avg_impar)+ 
+     &                 abs(dlog10(n2plusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(n2plusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     n2plusxoutput2 =10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (hplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(hplusxpares(1)) +
+     &                 dlog10(hplusxpares(2)) +
+     &                 dlog10( hplusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(hplusxpares(1))-avg_pares) + 
+     &                 abs(dlog10(hplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(hplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(hplusximpar(1)) + 
+     &                 dlog10(hplusximpar(2)) +
+     &                 dlog10(hplusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(hplusximpar(1))-avg_impar) + 
+     &                 abs(dlog10(hplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(hplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     hplusxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (co2plus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(co2plusxpares(1)) +
+     &                 dlog10(co2plusxpares(2)) +
+     &                 dlog10(co2plusxpares(3)) )*0.333
+                  dif_pares = (abs(dlog10(co2plusxpares(1))-avg_pares)+ 
+     &                 abs(dlog10(co2plusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(co2plusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(co2plusximpar(1)) + 
+     &                 dlog10(co2plusximpar(2)) +
+     &                 dlog10(co2plusximpar(3)) )*0.333
+                  dif_impar = (abs(dlog10(co2plusximpar(1))-avg_impar)+ 
+     &                 abs(dlog10(co2plusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(co2plusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     co2plusxoutput2=10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (o2plus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(o2plusxpares(1)) +
+     &                 dlog10(o2plusxpares(2)) +
+     &                 dlog10(o2plusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(o2plusxpares(1))-avg_pares)+ 
+     &                 abs(dlog10(o2plusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(o2plusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(o2plusximpar(1)) + 
+     &                 dlog10(o2plusximpar(2)) +
+     &                 dlog10(o2plusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(o2plusximpar(1))-avg_impar)+ 
+     &                 abs(dlog10(o2plusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(o2plusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     o2plusxoutput2 =10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (noplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(noplusxpares(1)) +
+     &                 dlog10(noplusxpares(2)) +
+     &                 dlog10(noplusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(noplusxpares(1))-avg_pares)+ 
+     &                 abs(dlog10(noplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(noplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(noplusximpar(1)) + 
+     &                 dlog10(noplusximpar(2)) +
+     &                 dlog10(noplusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(noplusximpar(1))-avg_impar)+ 
+     &                 abs(dlog10(noplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(noplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     noplusxoutput2 =10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+               
+               if (nplus_eq(i).eq.'Y') then
+                  avg_pares = ( dlog10(nplusxpares(1)) +
+     &                 dlog10(nplusxpares(2)) +
+     &                 dlog10( nplusxpares(3)) )*0.333
+                  dif_pares = ( abs(dlog10(nplusxpares(1))-avg_pares) + 
+     &                 abs(dlog10(nplusxpares(2))-avg_pares) +   
+     &                 abs(dlog10(nplusxpares(3))-avg_pares) ) * 0.333   
+                  avg_impar = ( dlog10(nplusximpar(1)) + 
+     &                 dlog10(nplusximpar(2)) +
+     &                 dlog10(nplusximpar(3)) )*0.333
+                  dif_impar = ( abs(dlog10(nplusximpar(1))-avg_impar) + 
+     &                 abs(dlog10(nplusximpar(2))-avg_impar) +   
+     &                 abs(dlog10(nplusximpar(3))-avg_impar) ) * 0.333
+                  dispersion = dif_pares + dif_impar
+                  dif_pares_impar = abs(avg_pares-avg_impar)
+                  if (dif_pares_impar .gt. 5.*dispersion) then
+                     correc_oscil=correc_oscil+1
+                     nplusxoutput2 = 10.d0**(0.5*(avg_pares+avg_impar))
+                  endif
+               endif
+
+               if (hco2plus_eq(i).eq.'Y') then
+                 avg_pares = ( dlog10(hco2plusxpares(1)) +
+     &                dlog10(hco2plusxpares(2)) +
+     &                dlog10(hco2plusxpares(3)) )*0.333
+                 dif_pares = (abs(dlog10(hco2plusxpares(1))-avg_pares)+ 
+     &                abs(dlog10(hco2plusxpares(2))-avg_pares) +   
+     &                abs(dlog10(hco2plusxpares(3))-avg_pares) ) * 0.333   
+                 avg_impar = ( dlog10(hco2plusximpar(1)) + 
+     &                dlog10(hco2plusximpar(2)) +
+     &                dlog10(hco2plusximpar(3)) )*0.333
+                 dif_impar = (abs(dlog10(hco2plusximpar(1))-avg_impar)+ 
+     &                abs(dlog10(hco2plusximpar(2))-avg_impar) +   
+     &                abs(dlog10(hco2plusximpar(3))-avg_impar) ) * 0.333
+                 dispersion = dif_pares + dif_impar
+                 dif_pares_impar = abs(avg_pares-avg_impar)
+                 if (dif_pares_impar .gt. 5.*dispersion) then
+                    correc_oscil=correc_oscil+1
+                    hco2plusxoutput2=10.d0**(0.5*(avg_pares+avg_impar))
+                 endif
+              endif
+
+            endif   !Of chemthermod.eq.3
+            
+         endif
+
+
+          ! Preparation of next step
+         
+         if (o1d_eq(i).eq.'Y') o1dxoutput = o1dxoutput2
+         if (oh_eq(i).eq.'Y') ohxoutput = ohxoutput2 
+         if (ho2_eq(i).eq.'Y') ho2xoutput = ho2xoutput2 
+         if (h_eq(i).eq.'Y') hxoutput = hxoutput2 
+         !Only if N or ion chemistry requested
+         if(chemthermod.ge.2) then
+            if (n2d_eq(i).eq.'Y') n2dxoutput = n2dxoutput2 
+            if (no2_eq(i).eq.'Y') no2xoutput = no2xoutput2
+         endif
+                                ! 
+         !Only if ion chemistry requested
+         if(chemthermod.eq.3) then
+            if (n2plus_eq(i).eq.'Y') n2plusxoutput=n2plusxoutput2 
+            if (cplus_eq(i).eq.'Y') cplusxoutput=cplusxoutput2 
+            if (coplus_eq(i).eq.'Y') coplusxoutput=coplusxoutput2 
+            if (oplus_eq(i).eq.'Y') oplusxoutput=oplusxoutput2 
+            if (hplus_eq(i).eq.'Y') hplusxoutput=hplusxoutput2 
+            if (co2plus_eq(i).eq.'Y') co2plusxoutput=co2plusxoutput2 
+            if (noplus_eq(i).eq.'Y') noplusxoutput=noplusxoutput2 
+            if (o2plus_eq(i).eq.'Y') o2plusxoutput=o2plusxoutput2 
+            if (nplus_eq(i).eq.'Y') nplusxoutput=nplusxoutput2
+            if (hco2plus_eq(i).eq.'Y') hco2plusxoutput=hco2plusxoutput2
+            electxoutput = o2plusxoutput +
+     @           co2plusxoutput +
+     @           coplusxoutput +
+     @           oplusxoutput +
+     @           cplusxoutput +
+     @           n2plusxoutput +
+     @           nplusxoutput +
+     @           noplusxoutput +
+     @           hplusxoutput +
+     $           hco2plusxoutput
+            
+            electxoutput_neutr = electxoutput 
+         
+            IonMostAbundant = o2plusxoutput
+            IonMostAbundant = max( co2plusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( coplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( oplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( cplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( n2plusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( noplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( nplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( hplusxoutput, IonMostAbundant) 
+            IonMostAbundant = max( hco2plusxoutput, IonMostAbundant)
+            IonMostAbundant = IonMostAbundant / electxoutput
+
+         endif   !Of chemthermod.eq.3
+         
+
+
+      enddo
+            !!! End of iteration
+
+
+      return
+      end
+
+
+c**********************************************************************
+c***********************************************************************
+	function cociente (xnum, xdenom, minimo, option)                      
+
+c	Returns the ratio between XNUM and XDENOM avoiding null values
+c       according to the action given by OPTION. Checks that the are not
+c       negative values
+
+c       If XNUM = 0 -> cociente=0
+c       If XDENOM < minimo, increases XDENOM in a factor=1e20 to avoid
+c         overflow, and after the ratio XNUM/XDENOM the value is back to normal
+c         if cociente < minimo -> cociente=minimo
+c       If XDENOM = 0 then :  
+c          option = 0  .... warning message and stop
+c          option = 1  ....    "       "    and cociente=minimo
+
+c       MALV    Jul-08    Original
+c***********************************************************************
+                                                
+	implicit none             
+
+! Arguments 
+        real*8  cociente
+        real*8  xnum
+        real*8  xdenom
+        real*8  minimo
+        integer option
+
+! Local variables 
+        real*8  factor
+
+!!!!!!! Program starts
+
+	if (xnum .lt. 0.d0) then 
+	   write (*,*) log10( xnum )
+	   STOP ' ERROR. Negative productions. XNUM=0.'
+	elseif (xdenom .lt. 0.d0) then 
+	   STOP ' ERROR. Negative losses. XDENOM=0.'
+	endif
+
+        if (xnum .eq. 0.d0) then 
+          cociente = minimo
+          return
+        endif
+
+        if (xdenom .eq. 0.d0) then 
+          if (option .eq. 0) then 
+             STOP ' ERROR. xdenom=0. '
+          elseif (option .eq. 1) then 
+!             write (*,*) 'WARNING !!    xdenom=0  '
+!             write (*,*) 'WARNING !!    option=2 => cociente=minimo',
+!     $            xdenom
+             cociente = minimo
+             return
+          else
+             STOP ' ERROR. option undefined in call to cociente'
+          endif
+        endif
+            
+        if (xdenom .lt. minimo) then 
+           factor = xdenom * 1.d20
+           cociente = xnum / factor * 1.d20
+        else
+	   cociente = xnum / xdenom
+	endif
+
+	if (cociente .lt. minimo) cociente = minimo
+                                                
+	return                                         
+c END
+	end
Index: trunk/LMDZ.MARS/libf/aeronomars/phdisrate.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/phdisrate.F	(revision 633)
+++ 	(revision )
@@ -1,109 +1,0 @@
-c**********************************************************************
-
-      subroutine phdisrate(zenit,i)
-
-c     apr 2002       fgg           first version
-c**********************************************************************
-
-
-      implicit none
-
-      include 'param.h'
-      include 'param_v3.h'
-
-c     arguments
-
-      integer         i                !altitude
-      real            zenit
-
-c     local variables
-
-      integer         inter,iz
-      real            lambda
-      real            jdis(nabs,ninter,nzmax)
-      character*1     dn
-
-
-c**********************************************************************
-
-      if(zenit.gt.100.) then
-         dn='n'
-         else
-         dn='d'
-      end if
-
-      if(dn.eq.'n') then
-         jdistot(1,i) = 0.
-         jdistot(2,i) = 0.
-         jdistot(3,i) = 0.
-         jdistot(4,i) = 0.
-         jdistot(5,i) = 0.
-         jdistot(6,i) = 0.
-         jdistot_b(1,i) = 0.
-         jdistot_b(2,i) = 0.
-      else
-
-c     photodissociation rate
-
-         jdistot(1,i)=0.
-         jdistot(2,i)=0.
-         jdistot(4,i)=0.
-         jdistot(6,i)=0.
-         jdistot_b(1,i)=0.
-         jdistot_b(2,i)=0.
-         do inter=1,32
-            jdis(1,inter,i) = jfotsout(inter,1,i) * fluxtop(inter) 
-     $      * efdisco2(inter)
-            if(inter.gt.29.and.inter.le.32) then
-               jdistot(1,i) = jdistot(1,i) + jdis(1,inter,i)
-            else if(inter.le.29) then
-               jdistot_b(1,i) = jdistot_b(1,i) + jdis(1,inter,i)
-            end if
-         end do
-
-         do inter=1,31
-            jdis(2,inter,i) = jfotsout(inter,2,i) * fluxtop(inter)
-     $      * efdiso2(inter)
-            if(inter.ge.31) then
-               jdistot(2,i) = jdistot(2,i) + jdis(2,inter,i)
-            else if(inter.lt.31) then
-               jdistot_b(2,i) = jdistot_b(2,i) + jdis(2,inter,i)
-            end if
-         end do
-
-         jdistot(3,i) = 0.
-
-         do inter=25,31
-            jdis(4,inter,i) = jfotsout(inter,4,i) * fluxtop(inter)
-     $      * efdish2o(inter)
-            jdistot(4,i) = jdistot(4,i) + jdis(4,inter,i)
-         end do
-
-         do inter=1,15
-            jdis(5,inter,i) = jfotsout(inter,5,i) * fluxtop(inter)
-     $      * efdish2(inter)
-            jdistot(5,i) = jdistot(5,i) + jdis(5,inter,i)
-         end do
-
-         do inter=25,33
-            jdis(6,inter,i) = jfotsout(inter,6,i) * fluxtop(inter)
-     $      * efdish2o2(inter) 
-            jdistot(6,i) = jdistot(6,i) + jdis(6,inter,i)
-         end do 
-      end if
-
-
-      return
-      
-
-      end
-
-
-
-
-
-
-
-
-
-
Index: trunk/LMDZ.MARS/libf/aeronomars/surfacearea.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/surfacearea.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/surfacearea.F	(revision 635)
@@ -12,5 +12,5 @@
 !
 !     Franck Lefevre
-!     version 1.1 november 2011
+!     version 1.2 april 2012
 !==========================================================================
 
@@ -46,14 +46,28 @@
 ! local
 
-      integer l, ig
-      real rho                     ! density (kg/m3)
-      real dustnd                  ! uodated dust number density (kg/kg)
-      real icend                   ! uodated ice number density (kg/kg)
-      real ccntyp                  ! typical dust number density (#/kg)
-                                   ! (microphys = false)
-      real rdusttyp                ! typical dust radius (m)
-                                   ! (microphys = false)
+      integer    :: l, ig
+      real       :: rho                     ! density (kg/m3)
+      real       :: dustnd, icend           ! uodated dust and ice number densities (kg/kg)
+      real, save :: factor_ice, factor_dust ! multiplying factor to compute total surface area
+                                            ! from the mass-mean radius
+      real       :: sigma_ice, sigma_dust   ! variance of the ice and dust distributions
+      real       :: ccntyp                  ! typical dust number density (#/kg)
+                                            ! (microphys = false)
+      real       :: rdusttyp                ! typical dust radius (m)
+                                            ! (microphys = false)
+
+      logical, save :: firstcall = .true.
 
 !==========================================================================
+
+      if (firstcall) then ! compute the multiplying factors
+         sigma_dust  = varian
+         sigma_ice   = sqrt(log(nuice_sed + 1.))
+         factor_dust = exp(0.5*(log(sigma_dust))**2)
+         factor_ice  = exp(0.5*(log(sigma_ice))**2)
+         write(*,*) 'surfacearea : factor_dust = ', factor_dust 
+         write(*,*) 'surfacearea : factor_ice  = ', factor_ice 
+         firstcall = .false.
+      end if
 
       if (microphys) then ! improvedclouds
@@ -69,8 +83,8 @@
      $                + pdq(ig,l,igcm_ccn_number)*ptimestep
 !              dust surface area
-               surfdust(ig,l) = dustnd*rho*tauscaling(ig)
+               surfdust(ig,l) = factor_dust*dustnd*rho*tauscaling(ig)
      $                          *4.*pi*rdust(ig,l)**2
 !              ice surface area
-               surfice(ig,l)  = icend*rho*tauscaling(ig)
+               surfice(ig,l)  = factor_ice*icend*rho*tauscaling(ig)
      $                          *4.*pi*rice(ig,l)**2
             end do
@@ -88,10 +102,10 @@
                ccntyp = ccntyp/ccn_factor
                if (rice(ig,l) .gt. rdust(ig,l)) then
-                  surfdust(ig,l) = ccntyp*(ccn_factor - 1.)*rho
-     $                             *4.*pi*rdusttyp**2
-                  surfice(ig,l)  = ccntyp*4.*pi*rice(ig,l)**2
+                  surfdust(ig,l) = factor_dust*ccntyp*(ccn_factor - 1.)
+     $                             *rho*4.*pi*rdusttyp**2
+                  surfice(ig,l)  = factor_ice*ccntyp*4.*pi*rice(ig,l)**2
                else
-                  surfdust(ig,l) = ccntyp*ccn_factor*rho
-     $                             *4.*pi*rdusttyp**2
+                  surfdust(ig,l) = factor_dust*ccntyp*ccn_factor
+     $                             *rho*4.*pi*rdusttyp**2
                   surfice(ig,l)  = 0.
                end if
@@ -105,11 +119,9 @@
         call wstats(ngrid,"surfdust", "Dust surface area",
      $            "micron2 cm-3",3,surfdust*1.e6)
-      endif
-      call writediagfi(ngrid,"surfdust", "Dust cloud surface area",
-     $            "micron2 cm-3",3,surfdust*1.e6)
-      if (callstats) then
         call wstats(ngrid,"surfice", "Ice cloud surface area",
      $            "micron2 cm-3",3,surfice*1.e6)
       endif
+      call writediagfi(ngrid,"surfdust", "Dust surface area",
+     $            "micron2 cm-3",3,surfdust*1.e6)
       call writediagfi(ngrid,"surfice", "Ice cloud surface area",
      $            "micron2 cm-3",3,surfice*1.e6)
Index: trunk/LMDZ.MARS/libf/aeronomars/thermosphere.F
===================================================================
--- trunk/LMDZ.MARS/libf/aeronomars/thermosphere.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/aeronomars/thermosphere.F	(revision 635)
@@ -12,5 +12,5 @@
 #include "comdiurn.h"
 #include "param.h"
-#include "param_v3.h"
+#include "param_v4.h"
 #include "chimiedata.h"
 #include "conc.h"
@@ -58,5 +58,5 @@
       if (calleuv) then
         call zerophys(ngridmx*nlayermx,zdteuv)
-        call euvheat(pt,pdt,pplev,pplay,zzlay,dist_sol,
+        call euvheat(pt,pdt,pplev,pplay,zzlay,
      $               mu0,ptimestep,ptime,zday,pq,pdq,zdteuv)
       endif
@@ -79,5 +79,5 @@
       if (callmoldiff) THEN
         call zerophys(ngridmx*nlayermx*nqmx,zdqmoldiff)
-        call moldiff_red(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
+        call moldiff(pplay,pplev,pt,pdt,pq,pdq,ptimestep,
      &                   zzlay,zdteuv,zdtconduc,zdqmoldiff)
       endif
Index: trunk/LMDZ.MARS/libf/phymars/callkeys.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/callkeys.h	(revision 633)
+++ trunk/LMDZ.MARS/libf/phymars/callkeys.h	(revision 635)
@@ -16,5 +16,5 @@
      
       COMMON/callkeys_i/iradia,iaervar,iddist,ilwd,ilwb,ilwn,ncouche    &
-     &   ,dustbin,nqchem_min,nltemodel,nircorr
+     &   ,dustbin,nltemodel,nircorr
      
       COMMON/callkeys_r/topdustref,solarcondate,semi,alphan,euveff,     &
@@ -54,5 +54,4 @@
       logical sedimentation,activice,water,microphys,caps
       logical photochem
-      integer nqchem_min
       integer nltemodel
       integer nircorr
Index: trunk/LMDZ.MARS/libf/phymars/callsedim.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/callsedim.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/phymars/callsedim.F	(revision 635)
@@ -434,5 +434,6 @@
 c     Update the dust particle size "rdust"
 c     -------------------------------------
-      DO l = 1, nlay
+      if (doubleq) then
+       DO l = 1, nlay
         DO ig=1,ngrid
           rdust(ig,l)=
@@ -441,9 +442,11 @@
           rdust(ig,l)=min(max(rdust(ig,l),1.e-10),500.e-6)
         ENDDO
-      ENDDO
+       ENDDO
+      endif ! of if (doubleq)
       
 c     Update the ice particle size "rice"
 c     -------------------------------------
-      IF(scavenging) THEN 
+      if (water) then
+       IF(scavenging) THEN 
         DO l = 1, nlay
           DO ig=1,ngrid
@@ -464,5 +467,5 @@
           ENDDO
         ENDDO
-      ELSE
+       ELSE
         DO l = 1, nlay
           DO ig=1,ngrid
@@ -475,5 +478,6 @@
           ENDDO
         ENDDO
-      ENDIF
+       ENDIF ! of IF(scavenging)
+      endif ! of if (water)
 
       RETURN
Index: trunk/LMDZ.MARS/libf/phymars/initracer.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/initracer.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/phymars/initracer.F	(revision 635)
@@ -24,8 +24,4 @@
 c                  q(iq=2) is the dust number mixing ratio 
 
-c   If (photochem.or.thermochem) there is "ncomp" chemical species (ncomp
-c   is set in aeronomars/chimiedata.h) using the ncomp iq values starting at
-c      iq=nqchem_min = dustbin+1   (nqchem_min is defined in inifis.F)
-c   
 c
 c   author: F.Forget
@@ -43,5 +39,4 @@
 #include "advtrac.h"
 #include "comgeomfi.h"
-#include "chimiedata.h"
 
 #include "surfdat.h"
@@ -55,5 +50,4 @@
 c       et al. (2002), a value of 25 has been deduced;
       real, parameter :: popratio = 25.
-      logical :: oldnames ! =.true. if old tracer naming convention (q01,...)
       character(len=20) :: txt ! to store some text
 
@@ -71,11 +65,8 @@
 c-----------------------------------------------------------------------
 
-      integer :: nqchem_start
-
 ! Initialization: get tracer names from the dynamics and check if we are
 !                 using 'old' tracer convention ('q01',q02',...)
 !                 or new convention (full tracer names)
       ! check if tracers have 'old' names
-      oldnames=.false.
       count=0
       do iq=1,nqmx
@@ -90,119 +81,16 @@
         write(*,*) "initracer: tracers seem to follow old naming ",
      &             "convention (q01,q02,...)"
-        write(*,*) "   => will work for now ... "
-        write(*,*) "      but you should run newstart to rename them"
-        oldnames=.true.
+        write(*,*) "you should run newstart to rename them"
+        stop
       endif
 
-      ! copy/set tracer names
-      if (oldnames) then ! old names (derived from iq & option values)
-        ! 1. dust:
-        if (dustbin.ne.0) then ! transported dust
-          do iq=1,dustbin
-            txt=" "
-            write(txt,'(a4,i2.2)') 'dust',iq
-            noms(iq)=txt
-            mmol(iq)=100.
-          enddo
-          ! special case if doubleq
-          if (doubleq) then
-            if (dustbin.ne.2) then
-              write(*,*) 'initracer: error expected dustbin=2'
-            else
-!              noms(1)='dust_mass'   ! dust mass mixing ratio
-!              noms(2)='dust_number' ! dust number mixing ratio
-! same as above, but avoid explict possible out-of-bounds on array
-               noms(1)='dust_mass'   ! dust mass mixing ratio
-               do iq=2,2
-               noms(iq)='dust_number' ! dust number mixing ratio
-               enddo
-            endif
-          endif
-        endif
-        ! 2. water & ice
-        if (water) then
-          noms(nqmx)='h2o_vap'
-          mmol(nqmx)=18.
-!            noms(nqmx-1)='h2o_ice'
-!            mmol(nqmx-1)=18.
-          !"loop" to avoid potential out-of-bounds in array
-          do iq=nqmx-1,nqmx-1
-            noms(iq)='h2o_ice'
-            mmol(iq)=18.
-          enddo
-        endif
-        ! 3. Chemistry
-        if (photochem .or. callthermos) then
-          if (doubleq) then
-            nqchem_start=3
-          else
-            nqchem_start=dustbin+1
-          end if
-          do iq=nqchem_start,nqchem_start+ncomp-2
-            noms(iq)=nomchem(iq-nqchem_start+1)
-            mmol(iq)=mmolchem(iq-nqchem_start+1)
-          enddo
-        endif ! of if (photochem .or. callthermos)
-        ! 4. Other tracers ????
-        if ((dustbin.eq.0).and.(.not.water)) then
-          noms(1)='co2'
-          mmol(1)=44
-          if (nqmx.eq.2) then
-            noms(nqmx)='Ar_N2'
-            mmol(nqmx)=30
-          endif
-        endif
-      else
-        ! copy tracer names from dynamics
-        do iq=1,nqmx
-          noms(iq)=tnom(iq)
-        enddo
-        ! mmol(:) array is initialized later (see below)
-      endif ! of if (oldnames)
-
-      ! special modification when using 'old' tracers:
-      ! qsurf(nqmx) was h2o ice whereas q(nqmx) was water vapour
-      ! and (if iceparty) q(nqmx-1) was null whereas q(nqmx-1) was water ice
-      if (oldnames.and.water) then
-        write(*,*)'initracer: moving surface water ice to index ',nqmx-1
-        ! "loop" to avoid potential out-of-bounds on arrays
-        do iq=nqmx-1,nqmx-1
-          qsurf(1:ngridmx,iq)=qsurf(1:ngridmx,iq+1)
-        enddo
-        qsurf(1:ngridmx,nqmx)=0
-      endif 
-      
-c------------------------------------------------------------
-c     Test Dimensions tracers
-c------------------------------------------------------------
-
-! Ehouarn: testing number of tracers is obsolete...
-!      if(photochem.or.thermochem) then
-!          if (water) then
-!              if ((dustbin+ncomp+2).ne.nqmx) then
-!                 print*,'initracer: tracer dimension problem:'
-!                 print*,"(dustbin+ncomp+2).ne.nqmx"
-!                 print*,"ncomp: ",ncomp
-!                 print*,"dustbin: ",dustbin
-!                 print*,"nqmx: ",nqmx
-!                 print*,'Change ncomp in chimiedata.h'
-!               endif
-!          else
-!              if ((dustbin+ncomp+1).ne.nqmx) then
-!                 print*,'initracer: tracer dimension problem:'
-!                 print*,"(dustbin+ncomp+1).ne.nqmx"
-!                 print*,"ncomp: ",ncomp
-!                 print*,"dustbin: ",dustbin
-!                 print*,"nqmx: ",nqmx
-!                 print*,'Change ncomp in chimiedata.h'
-!                 STOP
-!               endif
-!            endif
-!      endif
+      ! copy tracer names from dynamics
+      do iq=1,nqmx
+        noms(iq)=tnom(iq)
+      enddo
 
 c------------------------------------------------------------
 c         NAME and molar mass of the tracer 
 c------------------------------------------------------------
-
    
 ! Identify tracers by their names: (and set corresponding values of mmol)
@@ -246,6 +134,6 @@
       igcm_n2plus=0
       igcm_hplus=0
+      igcm_hco2plus=0
       igcm_elec=0
-
 
       ! 1. find dust tracers
@@ -432,4 +320,9 @@
           count=count+1
         endif
+        if (noms(iq).eq."hco2plus") then
+          igcm_hco2plus=iq
+          mmol(igcm_hco2plus)=45.
+          count=count+1
+        endif
         if (noms(iq).eq."elec") then
           igcm_elec=iq
@@ -454,7 +347,5 @@
         endif
 
-
       enddo ! of do iq=1,nqmx
-!      count=count+nbqchem
       
       ! check that we identified all tracers:
Index: trunk/LMDZ.MARS/libf/phymars/physiq.F
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/physiq.F	(revision 633)
+++ trunk/LMDZ.MARS/libf/phymars/physiq.F	(revision 635)
@@ -131,5 +131,5 @@
 #include "chimiedata.h"
 #include "param.h"
-#include "param_v3.h"
+#include "param_v4.h"
 #include "conc.h"
 
Index: trunk/LMDZ.MARS/libf/phymars/tracer.h
===================================================================
--- trunk/LMDZ.MARS/libf/phymars/tracer.h	(revision 633)
+++ trunk/LMDZ.MARS/libf/phymars/tracer.h	(revision 635)
@@ -66,4 +66,5 @@
       integer :: igcm_n2plus 
       integer :: igcm_hplus
+      integer :: igcm_hco2plus
       integer :: igcm_elec
       ! other tracers
@@ -85,5 +86,5 @@
      & igcm_co2plus,igcm_oplus,igcm_o2plus,igcm_coplus,igcm_cplus,      &
      & igcm_nplus,igcm_noplus,igcm_n2plus,igcm_hplus,igcm_elec,         &
-     & igcm_ar_n2!,nbqchem,niqchem
+     & igcm_hco2plus,igcm_ar_n2!,nbqchem,niqchem
       COMMON/tracer3/noms
 !-----------------------------------------------------------------------
