Index: LMDZ4/branches/LMDZ4-dev/cosp_input_nl.txt
===================================================================
--- LMDZ4/branches/LMDZ4-dev/cosp_input_nl.txt	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/cosp_input_nl.txt	(revision 1262)
@@ -0,0 +1,104 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+! Namelist that sets up the main COSP options
+&COSP_INPUT
+  CMOR_NL='./cmor/cosp_cmor_nl.txt', ! CMOR namelist
+  NPOINTS=9026,! Number of gridpoints (klon dans LMDZi : ici correspond a klon de 96x95)
+  NPOINTS_IT=10000,! Max number of gridpoints to be processed in one iteration
+  NCOLUMNS=20,  ! Number of subcolumns
+  NLEVELS=39,   ! Number of model levels 
+  USE_VGRID=.true., ! Use fixed vertical grid for outputs? (if .true. then you need to define number of levels with Nlr)
+  NLR=40,       ! Number of levels in statistical outputs (only used if USE_VGRID=.true.)
+  CSAT_VGRID=.true., ! CloudSat vertical grid? (if .true. then the CloudSat standard grid is used for the outputs.
+                     !  USE_VGRID needs also be .true.)
+  FINPUT='histday.nc', ! NetCDF file with 1D inputs
+!  FINPUT='cosp_input_um_2d.nc', ! NetCDF file with 2D inputs
+  !----------------------------------------------------------------------------------
+  !--------------- Inputs related to radar simulations
+  !----------------------------------------------------------------------------------
+  RADAR_FREQ=94.0, ! CloudSat radar frequency (GHz)
+  SURFACE_RADAR=0, ! surface=1, spaceborne=0
+  use_mie_tables=0,! use a precomputed lookup table? yes=1,no=0
+  use_gas_abs=1,   ! include gaseous absorption? yes=1,no=0
+  do_ray=0,        ! calculate/output Rayleigh refl=1, not=0
+  melt_lay=0,      ! melting layer model off=0, on=1
+  k2=-1,           ! |K|^2, -1=use frequency dependent default
+  use_reff=.true., ! True if you want effective radius to be used by radar simulator (always used by lidar)
+  use_precipitation_fluxes=.true.,  ! True if precipitation fluxes are input to the algorithm 
+  !----------------------------------------------------------------------------------
+  !---------------- Inputs related to lidar simulations
+  !----------------------------------------------------------------------------------
+  Nprmts_max_hydro=12, ! Max number of parameters for hydrometeor size distributions
+  Naero=1,             ! Number of aerosol species (Not used)
+  Nprmts_max_aero=1,   ! Max number of parameters for aerosol size distributions (Not used)
+  lidar_ice_type=0,    ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical)
+  OVERLAP=3,   !  overlap type: 1=max, 2=rand, 3=max/rand
+  !----------------------------------------------------------------------------------
+  !---------------- Inputs related to ISCCP simulator
+  !----------------------------------------------------------------------------------
+  ISCCP_TOPHEIGHT=1,  !  1 = adjust top height using both a computed
+                       !  infrared brightness temperature and the visible
+                       !  optical depth to adjust cloud top pressure. Note
+                       !  that this calculation is most appropriate to compare
+                       !  to ISCCP data during sunlit hours.
+                      !  2 = do not adjust top height, that is cloud top
+                       !  pressure is the actual cloud top pressure
+                       !  in the model
+                      !  3 = adjust top height using only the computed
+                       !  infrared brightness temperature. Note that this
+                       !  calculation is most appropriate to compare to ISCCP
+                       !  IR only algortihm (i.e. you can compare to nighttime
+                       !  ISCCP data with this option)
+  ISCCP_TOPHEIGHT_DIRECTION=1,   ! direction for finding atmosphere pressure level
+                                 ! with interpolated temperature equal to the radiance
+                                 ! determined cloud-top temperature
+                                 ! 1 = find the *lowest* altitude (highest pressure) level
+                                 ! with interpolated temperature equal to the radiance
+                                 ! determined cloud-top temperature
+                                 ! 2 = find the *highest* altitude (lowest pressure) level
+                                 ! with interpolated temperature equal to the radiance 
+                                 ! determined cloud-top temperature
+                                 ! ONLY APPLICABLE IF top_height EQUALS 1 or 3
+                                 ! 1 = default setting, and matches all versions of 
+                                 ! ISCCP simulator with versions numbers 3.5.1 and lower
+                                 ! 2 = experimental setting  
+  !----------------------------------------------------------------------------------
+  !-------------- RTTOV inputs
+  !----------------------------------------------------------------------------------
+  Platform=1,    ! satellite platform
+  Satellite=15,  ! satellite
+  Instrument=0,  ! instrument
+  Nchannels=8,   ! Number of channels to be computed
+  Channels=1,3,5,6,8,10,11,13,        ! Channel numbers (please be sure that you supply Nchannels)
+  Surfem=0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,  ! Surface emissivity (please be sure that you supply Nchannels)
+  ZenAng=50.0, ! Satellite Zenith Angle
+  CO2=5.241e-04, ! Mixing ratios of trace gases
+  CH4=9.139e-07,
+  N2O=4.665e-07,
+  CO=2.098e-07
+/
+
+
Index: LMDZ4/branches/LMDZ4-dev/cosp_output_nl.txt
===================================================================
--- LMDZ4/branches/LMDZ4-dev/cosp_output_nl.txt	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/cosp_output_nl.txt	(revision 1262)
@@ -0,0 +1,63 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+! Namelist that sets up output-related variables. It controls 
+! the instrument simulators to run and the list of variables 
+! to be written to file
+&COSP_OUTPUT
+  ! Simulator flags
+  Lradar_sim=.false.,
+  Llidar_sim=.true.,
+  Lisccp_sim=.true.,
+  Lmisr_sim=.false.,
+  ! Output variables
+  Lalbisccp=.true.,
+  Latb532=.true.,
+  Lboxptopisccp=.true.,
+  Lboxtauisccp=.true.,
+  Lcfad_dbze94=.false.,
+  Lcfad_lidarsr532=.true.,
+  Lclcalipso=.true.,
+  Lclhcalipso=.true.,
+  Lclisccp2=.true.,
+  Lcllcalipso=.true.,
+  Lclmcalipso=.true.,
+  Lcltcalipso=.true.,
+  Lctpisccp=.true.,
+  Ldbze94=.false.,
+  Ltauisccp=.true.,
+  Ltclisccp=.true.,
+  Llongitude=.false.,
+  Llatitude=.false.,
+  Lparasol_refl=.true.,
+  LclMISR=.false.,
+  Lmeantbisccp=.true.,
+  Lmeantbclrisccp=.true.,
+  ! Use lidar and radar
+  Lclcalipso2=.false.,
+  Lcltlidarradar=.false.,
+  ! These are provided for debugging or special purposes
+  Lfrac_out=.false.,
+  Lbeta_mol532=.true.,  
+/
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/MISR_simulator.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/MISR_simulator.F	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/MISR_simulator.F	(revision 1262)
@@ -0,0 +1,460 @@
+! 
+! Copyright (c) 2009,  Roger Marchand, version 1.2
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list of 
+!       conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list 
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the University of Washington nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
+! BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT 
+! SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
+! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 
+! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+!
+
+      SUBROUTINE MISR_simulator(
+     &     npoints,
+     &     nlev,
+     &     ncol,
+     &     sunlit,
+     & 	   zfull,
+     &	   at,
+     &     dtau_s,
+     &	   dtau_c,
+     &	   frac_out,
+     & 	   fq_MISR_TAU_v_CTH,
+     &	   dist_model_layertops,
+     & 	   MISR_mean_ztop,
+     &     MISR_cldarea
+     & )
+	
+
+      implicit none
+      integer n_MISR_CTH
+      parameter(n_MISR_CTH=16)
+         
+!     -----
+!     Input 
+!     -----
+
+      INTEGER npoints                   !  if ncol ==1, the number of model points in the horizontal grid  
+      				        !   else 	the number of GCM grid points
+      				        
+      INTEGER nlev                      !  number of model vertical levels
+      
+      INTEGER ncol                      !  number of model sub columns 
+      					!  (must already be generated in via scops and passed to this
+      					!   routine via the variable frac_out )
+  
+      INTEGER sunlit(npoints)           !  1 for day points, 0 for night time
+
+      REAL zfull(npoints,nlev)	      	!  height (in meters) of full model levels (i.e. midpoints)
+                                        !  zfull(npoints,1)    is    top level of model
+                                        !  zfull(npoints,nlev) is bottom level of model (closest point to surface)  
+
+      REAL at(npoints,nlev)             !  temperature in each model level (K)
+ 
+      REAL dtau_s(npoints,nlev)         !  visible wavelength cloud optical depth ... for "stratiform" condensate
+                                        !  NOTE:  this the cloud optical depth of only the
+					!	  the model cell (i,j)
+					
+      REAL dtau_c(npoints,nlev)         !  visible wavelength cloud optical depth ... for "convective" condensate
+                                        !  NOTE:  this the cloud optical depth of only the
+					!	  the model cell (i,j)
+                                     
+      REAL frac_out(npoints,ncol,nlev)  !  NOTE: only need if columns>1 ... subgrid scheme in use.
+                                 
+!     ------
+!     Outputs
+!     ------
+       		
+      REAL fq_MISR_TAU_v_CTH(npoints,7,n_MISR_CTH)      
+      REAL dist_model_layertops(npoints,n_MISR_CTH)
+      REAL MISR_cldarea(npoints)		       ! fractional area coverged by clouds 
+      REAL MISR_mean_ztop(npoints)		       ! mean cloud top hieght(m) MISR would observe
+      						       ! NOTE: == 0 if area ==0
+      						
+
+!     ------
+!     Working variables 
+!     ------
+
+      REAL tau(npoints,ncol) 		! total column optical depth ... 
+
+      INTEGER j,ilev,ilev2,ibox
+      INTEGER itau
+         
+      LOGICAL box_cloudy(npoints,ncol)
+      
+      real isccp_taumin
+      real boxarea
+      real tauchk
+      REAL box_MISR_ztop(npoints,ncol)	! cloud top hieght(m) MISR would observe
+      
+      integer thres_crossed_MISR 
+      integer loop,iMISR_ztop
+      
+      real dtau, cloud_dtau, MISR_penetration_height,ztest     
+      
+      real MISR_CTH_boundaries(n_MISR_CTH+1)
+      
+      DATA MISR_CTH_boundaries / -99, 0, 0.5, 1, 1.5, 2, 2.5, 3,
+     c				      4, 5, 7, 9, 11, 13, 15, 17, 99 /
+      
+      DATA isccp_taumin / 0.3 /
+    
+      tauchk = -1.*log(0.9999999)
+    	
+      !
+      !	For each GCM cell or horizontal model grid point ...
+      !	
+      do j=1,npoints	
+
+         !
+         !	estimate distribution of Model layer tops
+         !	
+         dist_model_layertops(j,:)=0
+
+	 do ilev=1,nlev	
+			
+		! define location of "layer top"
+		if(ilev.eq.1 .or. ilev.eq.nlev) then
+			ztest=zfull(j,ilev)
+		else
+			ztest=0.5*(zfull(j,ilev)+zfull(j,ilev-1)) 
+		endif	
+
+		! find MISR layer that contains this level
+		! note, the first MISR level is "no height" level
+		iMISR_ztop=2
+		do loop=2,n_MISR_CTH
+		
+			if ( ztest .gt.
+     &				  1000*MISR_CTH_boundaries(loop+1) ) then
+	    
+  				iMISR_ztop=loop+1
+   			endif
+		enddo
+
+		dist_model_layertops(j,iMISR_ztop)=
+     &			dist_model_layertops(j,iMISR_ztop)+1
+	 enddo
+	
+	
+         !
+         ! compute total cloud optical depth for each column
+         !       
+         do ibox=1,ncol     
+	   
+	    ! Initialize tau to zero in each subcolum
+      	    tau(j,ibox)=0. 
+	    box_cloudy(j,ibox)=.false.
+	    box_MISR_ztop(j,ibox)=0  
+	    
+	    ! initialize threshold detection for each sub column 
+	    thres_crossed_MISR=0;
+	   
+	    do ilev=1,nlev
+     
+     		 dtau=0
+     		 
+     		 if (frac_out(j,ibox,ilev).eq.1) then
+                        dtau = dtau_s(j,ilev)
+                 endif
+                 
+                 if (frac_out(j,ibox,ilev).eq.2) then
+                        dtau = dtau_c(j,ilev)
+                 end if	
+                 
+        	 tau(j,ibox)=tau(j,ibox)+ dtau
+        	  
+        	    	 
+		! NOW for MISR ..
+		! if there a cloud ... start the counter ... store this height
+		if(thres_crossed_MISR .eq. 0 .and. dtau .gt. 0.) then
+		
+			! first encountered a "cloud"
+			thres_crossed_MISR=1  
+			cloud_dtau=0			
+		endif	
+				
+		if( thres_crossed_MISR .lt. 99 .and.
+     &		    	thres_crossed_MISR .gt. 0 ) then
+     
+     			if( dtau .eq. 0.) then
+		
+     				! we have come to the end of the current cloud
+				! layer without yet selecting a CTH boundary.
+				! ... restart cloud tau counter 
+				cloud_dtau=0
+			else
+				! add current optical depth to count for 
+				! the current cloud layer
+				cloud_dtau=cloud_dtau+dtau
+			endif
+				
+			! if the cloud is continuous but optically thin (< 1)
+			! from above the current layer cloud top to the current level
+			! then MISR will like see a top below the top of the current 
+			! layer
+			if( dtau.gt.0 .and. (cloud_dtau-dtau) .lt. 1) then
+			
+				if(dtau .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then
+
+					! MISR will likely penetrate to some point
+					! within this layer ... the middle
+					MISR_penetration_height=zfull(j,ilev)
+
+				else
+				   	! take the OD = 1.0 level into this layer
+				   	MISR_penetration_height=
+     &					   0.5*(zfull(j,ilev)+zfull(j,ilev-1)) - 
+     &					   0.5*(zfull(j,ilev-1)-zfull(j,ilev+1))
+     &					/dtau 
+				endif	
+
+				box_MISR_ztop(j,ibox)=MISR_penetration_height
+				
+			endif
+		
+			! check for a distinctive water layer
+			if(dtau .gt. 1 .and. at(j,ilev).gt.273 ) then
+     
+     				! must be a water cloud ... 
+				! take this as CTH level
+				thres_crossed_MISR=99
+			endif
+		
+			! if the total column optical depth is "large" than
+			! MISR can't seen anything else ... set current point as CTH level
+			if(tau(j,ibox) .gt. 5) then	
+
+				thres_crossed_MISR=99			
+			endif
+
+		endif ! MISR CTH booundary not set
+		
+      	    enddo  !ilev - loop over vertical levesl
+	
+	    ! written by roj 5/2006
+	    ! check to see if there was a cloud for which we didn't 
+	    ! set a MISR cloud top boundary
+	    if( thres_crossed_MISR .eq. 1) then
+	
+		! if the cloud has a total optical depth of greater
+		! than ~ 0.5 MISR will still likely pick up this cloud
+		! with a height near the true cloud top
+		! otherwise there should be no CTH
+		if( tau(j,ibox) .gt. 0.5) then
+
+			! keep MISR detected CTH
+			
+		elseif(tau(j,ibox) .gt. 0.2) then
+
+			! MISR may detect but wont likley have a good height
+			box_MISR_ztop(j,ibox)=-1
+			
+		else
+			! MISR not likely to even detect.
+			! so set as not cloudy
+			box_MISR_ztop(j,ibox)=0
+
+		endif
+						
+	    endif
+	
+	 enddo  ! loop of subcolumns
+       enddo    ! loop of gridpoints
+       
+
+        !     
+        !	Modify MISR CTH for satellite spatial / pattern matcher effects
+	!
+	!	Code in this region added by roj 5/2006 to account
+	!	for spatial effect of the MISR pattern matcher.
+	!	Basically, if a column is found between two neighbors
+	! 	at the same CTH, and that column has no hieght or
+	!	a lower CTH, THEN misr will tend to but place the
+	!	odd column at the same height as it neighbors.
+	!
+	!	This setup assumes the columns represent a about a 1 to 4 km scale
+	!	it will need to be modified significantly, otherwise
+	if(ncol.eq.1) then
+	
+	   ! adjust based on neightboring points ... i.e. only 2D grid was input
+           do j=2,npoints-1
+			
+			if(box_MISR_ztop(j-1,1).gt.0 .and. 
+     &			   box_MISR_ztop(j+1,1).gt.0 	   ) then
+
+				if( abs( box_MISR_ztop(j-1,1) -  
+     &				  	 box_MISR_ztop(j+1,1) ) .lt. 500 
+     & 				.and.
+     &					 box_MISR_ztop(j,1) .lt. 
+     &					 box_MISR_ztop(j+1,1)     ) then
+			
+					box_MISR_ztop(j,1) =
+     &						box_MISR_ztop(j+1,1)    
+				endif
+
+			endif
+         enddo
+      else
+         
+         ! adjust based on neighboring subcolumns ....
+         do ibox=2,ncol-1
+			
+			if(box_MISR_ztop(1,ibox-1).gt.0 .and. 
+     &			   box_MISR_ztop(1,ibox+1).gt.0 	   ) then
+
+				if( abs( box_MISR_ztop(1,ibox-1) -  
+     &				  	 box_MISR_ztop(1,ibox+1) ) .lt. 500 
+     & 				.and.
+     &					 box_MISR_ztop(1,ibox) .lt. 
+     &					 box_MISR_ztop(1,ibox+1)     ) then
+			
+					box_MISR_ztop(1,ibox) =
+     &						box_MISR_ztop(1,ibox+1)    
+				endif
+
+			endif
+         enddo
+      
+      endif
+
+        !     
+	!     DETERMINE CLOUD TYPE FREQUENCIES
+	!
+	!     Now that ztop and tau have been determined, 
+	!     determine amount of each cloud type
+      boxarea=1./real(ncol)  
+      do j=1,npoints 
+
+         ! reset frequencies -- modified loop structure, roj 5/2006 
+         do ilev=1,7  ! "tau loop"	
+            do  ilev2=1,n_MISR_CTH	    		        
+      		fq_MISR_TAU_v_CTH(j,ilev,ilev2)=0.     
+            enddo
+      	 enddo
+      	   
+	 MISR_cldarea(j)=0.
+      	 MISR_mean_ztop(j)=0.
+
+         do ibox=1,ncol
+
+            if (tau(j,ibox) .gt. (tauchk)) then
+               box_cloudy(j,ibox)=.true.
+            endif
+  
+  	    itau = 0
+  	    
+            if (box_cloudy(j,ibox)) then
+	
+	      !determine optical depth category
+              if (tau(j,ibox) .lt. isccp_taumin) then
+                  itau=1
+              else if (tau(j,ibox) .ge. isccp_taumin                                    
+     &          .and. tau(j,ibox) .lt. 1.3) then
+                  itau=2
+              else if (tau(j,ibox) .ge. 1.3 
+     &          .and. tau(j,ibox) .lt. 3.6) then
+                  itau=3
+              else if (tau(j,ibox) .ge. 3.6 
+     &          .and. tau(j,ibox) .lt. 9.4) then
+                  itau=4
+              else if (tau(j,ibox) .ge. 9.4 
+     &          .and. tau(j,ibox) .lt. 23.) then
+                  itau=5
+              else if (tau(j,ibox) .ge. 23. 
+     &          .and. tau(j,ibox) .lt. 60.) then
+                  itau=6
+              else if (tau(j,ibox) .ge. 60.) then
+                  itau=7
+              endif
+              
+	   endif  
+
+	   ! update MISR histograms and summary metrics - roj 5/2005
+	   if (sunlit(j).eq.1) then 
+              	     
+              !if cloudy added by roj 5/2005
+	      if( box_MISR_ztop(j,ibox).eq.0) then
+	      
+			! no cloud detected
+			iMISR_ztop=0
+
+	      elseif( box_MISR_ztop(j,ibox).eq.-1) then
+
+			! cloud can be detected but too thin to get CTH
+			iMISR_ztop=1    
+
+     			fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop)=
+     &          		fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop) + boxarea
+
+	      else
+	      	
+			!
+			! determine index for MISR bin set
+			!
+
+			iMISR_ztop=2
+			
+			do loop=2,n_MISR_CTH
+		
+				if ( box_MISR_ztop(j,ibox) .gt.
+     &				  1000*MISR_CTH_boundaries(loop+1) ) then
+	    
+				  iMISR_ztop=loop+1
+
+   				endif
+			enddo
+	      
+			if(box_cloudy(j,ibox)) then
+			
+				! there is an isccp clouds so itau(j) is defined
+     				fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop)=
+     &          			fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop) + boxarea
+     
+			else
+				! MISR CTH resolution is trying to fill in a
+				! broken cloud scene where there is no condensate.
+				! The MISR CTH-1D-OD product will only put in a cloud
+				! if the MISR cloud mask indicates cloud.
+				! therefore we will not include this column in the histogram
+				! in reality aerosoal and 3D effects or bright surfaces
+				! could fool the MISR cloud mask
+
+				! the alternative is to count as very thin cloud ??
+!				fq_MISR_TAU_v_CTH(1,iMISR_ztop)=
+!     &          			fq_MISR_TAU_v_CTH(1,iMISR_ztop) + boxarea
+			endif
+
+
+			MISR_mean_ztop(j)=MISR_mean_ztop(j)+
+     &					     box_MISR_ztop(j,ibox)*boxarea   		
+
+			MISR_cldarea(j)=MISR_cldarea(j) + boxarea 
+ 
+	      endif
+		
+	   endif ! is sunlight ?
+	   
+	enddo ! ibox - loop over subcolumns          
+      
+	if( MISR_cldarea(j) .gt. 0.) then
+	  	MISR_mean_ztop(j)= MISR_mean_ztop(j) / MISR_cldarea(j)   ! roj 5/2006
+	endif
+
+      enddo  ! loop over grid points
+
+      return
+      end 
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/array_lib.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/array_lib.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/array_lib.F90	(revision 1262)
@@ -0,0 +1,165 @@
+! ARRAY_LIB: Array procedures for F90
+! Compiled/Modified:
+!   07/01/06  John Haynes (haynes@atmos.colostate.edu)
+!
+! infind (function)
+! lin_interpolate (function)
+  
+  module array_lib
+  implicit none
+
+  contains
+
+! ----------------------------------------------------------------------------
+! function INFIND
+! ----------------------------------------------------------------------------
+  function infind(list,val,sort,dist)
+  use m_mrgrnk
+  implicit none
+!
+! Purpose:
+!   Finds the index of an array that is closest to a value, plus the
+!   difference between the value found and the value specified
+!
+! Inputs:
+!   [list]   an array of sequential values
+!   [val]    a value to locate
+! Optional input:
+!   [sort]   set to 1 if [list] is in unknown/non-sequential order
+!
+! Returns:
+!   index of [list] that is closest to [val]
+!
+! Optional output:
+!   [dist]   set to variable containing [list([result])] - [val]
+!
+! Requires:
+!   mrgrnk library
+!
+! Created:
+!   10/16/03  John Haynes (haynes@atmos.colostate.edu)
+! Modified:
+!   01/31/06  IDL to Fortran 90
+ 
+! ----- INPUTS -----
+  real*8, dimension(:), intent(in) :: list
+  real*8, intent(in) :: val  
+  integer, intent(in), optional :: sort
+  
+! ----- OUTPUTS -----
+  integer*4 :: infind
+  real*8, intent(out), optional :: dist
+
+! ----- INTERNAL -----
+  real*8, dimension(size(list)) :: lists
+  integer*4 :: nlist, result, tmp(1), sort_list
+  integer*4, dimension(size(list)) :: mask, idx
+
+  if (present(sort)) then
+    sort_list = sort
+  else
+    sort_list = 0
+  endif  
+
+  nlist = size(list)
+  if (sort_list == 1) then
+    call mrgrnk(list,idx)
+    lists = list(idx)
+  else
+    lists = list
+  endif
+
+  if (val >= lists(nlist)) then
+    result = nlist
+  else if (val <= lists(1)) then
+    result = 1
+  else
+    mask(:) = 0
+    where (lists < val) mask = 1
+      tmp = minloc(mask,1)
+      if (abs(lists(tmp(1)-1)-val) < abs(lists(tmp(1))-val)) then
+        result = tmp(1) - 1
+      else
+        result = tmp(1)
+      endif
+  endif
+  if (present(dist)) dist = lists(result)-val
+  if (sort_list == 1) then
+    infind = idx(result)
+  else
+    infind = result
+  endif
+
+  end function infind
+
+! ----------------------------------------------------------------------------
+! function LIN_INTERPOLATE
+! ----------------------------------------------------------------------------  
+  subroutine lin_interpolate(yarr,xarr,yyarr,xxarr,tol)
+  use m_mrgrnk
+  implicit none
+!
+! Purpose:
+!   linearly interpolate a set of y2 values given a set of y1,x1,x2
+!
+! Inputs:
+!   [yarr]    an array of y1 values
+!   [xarr]    an array of x1 values
+!   [xxarr]   an array of x2 values
+!   [tol]     maximum distance for a match
+!
+! Output:
+!   [yyarr]   interpolated array of y2 values
+!
+! Requires:
+!   mrgrnk library
+!
+! Created:
+!   06/07/06  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----
+  real*8, dimension(:), intent(in) :: yarr, xarr, xxarr
+  real*8, intent(in) :: tol
+
+! ----- OUTPUTS -----
+  real*8, dimension(size(xxarr)), intent(out) :: yyarr
+
+! ----- INTERNAL -----
+  real*8, dimension(size(xarr)) :: ysort, xsort
+  integer*4, dimension(size(xarr)) :: ist
+  integer*4 :: nx, nxx, i, iloc
+  real*8 :: d, m
+
+  nx = size(xarr)
+  nxx = size(xxarr)
+
+! // xsort, ysort are sorted versions of xarr, yarr  
+  call mrgrnk(xarr,ist)
+  ysort = yarr(ist)
+  xsort = xarr(ist)
+  
+  do i=1,nxx
+    iloc = infind(xsort,xxarr(i),dist=d)
+    if (d > tol) then
+      print *, 'interpolation error'
+      stop
+    endif
+    if (iloc == nx) then
+!     :: set to the last value
+      yyarr(i) = ysort(nx)
+    else
+!     :: is there another closeby value?
+      if (abs(xxarr(i)-xsort(iloc+1)) < 2*tol) then
+!       :: yes, do a linear interpolation      
+        m = (ysort(iloc+1)-ysort(iloc))/(xsort(iloc+1)-xsort(iloc))
+        yyarr(i) = ysort(iloc) + m*(xxarr(i)-xsort(iloc))
+      else
+!       :: no, set to the only nearby value
+        yyarr(i) = ysort(iloc)
+      endif
+    endif
+  enddo
+  
+  end subroutine lin_interpolate
+
+  end module array_lib
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/atmos_lib.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/atmos_lib.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/atmos_lib.F90	(revision 1262)
@@ -0,0 +1,135 @@
+! ATMOS_LIB: Atmospheric science procedures for F90
+! Compiled/Modified:
+!   07/01/06  John Haynes (haynes@atmos.colostate.edu)
+!
+! mcclatchey (subroutine)
+  
+  module atmos_lib
+  implicit none
+  
+  contains
+  
+! ----------------------------------------------------------------------------
+! subroutine MCCLATCHEY
+! ----------------------------------------------------------------------------
+  subroutine mcclatchey(stype,hgt,prs,tk,rh)
+  implicit none
+!
+! Purpose:
+!   returns a standard atmospheric profile
+!
+! Input:
+!   [stype]   type of profile to return
+!             1 = mid-latitude summer
+!             2 = mid-latitude winter
+!             3 = tropical
+!
+! Outputs:
+!   [hgt]     height (m)
+!   [prs]     pressure (hPa)
+!   [tk]      temperature (K)
+!   [rh]      relative humidity (%)
+!
+! Created:
+!   06/01/2006  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----
+  integer, intent(in) :: &
+  stype
+
+  integer, parameter :: ndat = 33
+
+! ----- OUTPUTS -----
+  real*8, intent(out), dimension(ndat) :: &
+  hgt, &                        ! height (m)
+  prs, &                        ! pressure (hPa)
+  tk, &                         ! temperature (K)
+  rh                            ! relative humidity (%)
+  
+  hgt = (/0.00000,1000.00,2000.00,3000.00,4000.00,5000.00, &
+          6000.00,7000.00,8000.00,9000.00,10000.0,11000.0, &
+          12000.0,13000.0,14000.0,15000.0,16000.0,17000.0, &
+          18000.0,19000.0,20000.0,21000.0,22000.0,23000.0, &
+          24000.0,25000.0,30000.0,35000.0,40000.0,45000.0, &
+          50000.0,70000.0,100000./)
+
+  select case(stype)
+
+  case(1)
+!   // mid-latitide summer  
+    prs = (/1013.00, 902.000, 802.000, 710.000, 628.000, 554.000, &
+            487.000, 426.000, 372.000, 324.000, 281.000, 243.000, &
+            209.000, 179.000, 153.000, 130.000, 111.000, 95.0000, &
+            81.2000, 69.5000, 59.5000, 51.0000, 43.7000, 37.6000, &
+            32.2000, 27.7000, 13.2000, 6.52000, 3.33000, 1.76000, &
+            0.951000,0.0671000,0.000300000/)
+	   
+    tk =  (/294.000, 290.000, 285.000, 279.000, 273.000, 267.000, &
+            261.000, 255.000, 248.000, 242.000, 235.000, 229.000, &
+            222.000, 216.000, 216.000, 216.000, 216.000, 216.000, &
+            216.000, 217.000, 218.000, 219.000, 220.000, 222.000, &
+            223.000, 224.000, 234.000, 245.000, 258.000, 270.000, &
+            276.000, 218.000, 210.000/)
+
+    rh =  (/74.8384, 63.4602, 55.0485, 45.4953, 39.3805, 31.7965, &
+            30.3958, 29.5966, 30.1626, 29.3624, 30.3334, 19.0768, &
+            11.0450, 6.61278, 3.67379, 2.79209, 2.35123, 2.05732, &
+            1.83690, 1.59930, 1.30655, 1.31890, 1.17620,0.994076, &
+            0.988566,0.989143,0.188288,0.0205613,0.00271164,0.000488798, &
+            0.000107066,0.000406489,7.68645e-06/)
+
+  case(2)
+!   // mid-latitude winter
+    prs = (/1018.00, 897.300, 789.700, 693.800, 608.100, 531.300, &
+            462.700, 401.600, 347.300, 299.200, 256.800, 219.900, &
+            188.200, 161.000, 137.800, 117.800, 100.700, 86.1000, &
+            73.5000, 62.8000, 53.7000, 45.8000, 39.1000, 33.4000, &
+            28.6000, 24.3000, 11.1000, 5.18000, 2.53000, 1.29000, &
+            0.682000,0.0467000,0.000300000/)
+
+    tk =  (/272.200, 268.700, 265.200, 261.700, 255.700, 249.700, &
+            243.700, 237.700, 231.700, 225.700, 219.700, 219.200, &
+            218.700, 218.200, 217.700, 217.200, 216.700, 216.200, &
+            215.700, 215.200, 215.200, 215.200, 215.200, 215.200, &
+            215.200, 215.200, 217.400, 227.800, 243.200, 258.500, &
+            265.700, 230.700, 210.200/)
+
+    rh =  (/76.6175, 70.1686, 65.2478, 56.6267, 49.8755, 47.1765, &
+            44.0477, 31.0565, 23.0244, 19.6510, 17.8987, 17.4376, &
+            16.0621, 5.10608, 3.00679, 2.42293, 2.16406, 2.00901, &
+            1.90374, 1.98072, 1.81902, 2.06155, 2.06154, 2.18280, &
+            2.42531,2.70824,1.12105,0.108119,0.00944200,0.00115201, &
+            0.000221094,0.000101946,7.49350e-06/)
+
+  case(3)
+!   // tropical
+    prs = (/1013.00, 904.000, 805.000, 715.000, 633.000, 559.000, &
+            492.000, 432.000, 378.000, 329.000, 286.000, 247.000, &
+            213.000, 182.000, 156.000, 132.000, 111.000, 93.7000, &
+            78.9000, 66.6000, 56.5000, 48.0000, 40.9000, 35.0000, &
+            30.0000, 25.7000, 12.2000, 6.00000, 3.05000, 1.59000, &
+            0.854000,0.0579000,0.000300000/)
+
+    tk =  (/300.000, 294.000, 288.000, 284.000, 277.000, 270.000, &
+            264.000, 257.000, 250.000, 244.000, 237.000, 230.000, &
+            224.000, 217.000, 210.000, 204.000, 197.000, 195.000, &
+            199.000, 203.000, 207.000, 211.000, 215.000, 217.000, &
+            219.000, 221.000, 232.000, 243.000, 254.000, 265.000, &
+            270.000, 219.000, 210.000/)
+
+    rh =  (/71.4334, 69.4097, 71.4488, 46.7724, 34.7129, 38.3820, &
+            33.7214, 32.0122, 30.2607, 24.5059, 19.5321, 13.2966, &
+            8.85795, 5.87496, 7.68644, 12.8879, 29.4976, 34.9351, &
+            17.1606, 9.53422, 5.10154, 3.45407, 2.11168, 1.76247, &
+            1.55162,1.37966,0.229799,0.0245943,0.00373686,0.000702138, &
+            0.000162076,0.000362055,7.68645e-06/)
+	    
+  case default
+    print *, 'Must enter a profile type'
+    stop
+    
+  end select
+  
+  end subroutine mcclatchey
+  
+  end module atmos_lib
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/congvec.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/congvec.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/congvec.h	(revision 1262)
@@ -0,0 +1,54 @@
+
+! *****************************COPYRIGHT****************************
+! (c) British Crown Copyright 2009, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without 
+! modification, are permitted provided that the
+! following conditions are met:
+! 
+!     * Redistributions of source code must retain the above 
+!       copyright  notice, this list of conditions and the following 
+!       disclaimer.
+!     * Redistributions in binary form must reproduce the above 
+!       copyright notice, this list of conditions and the following 
+!       disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its 
+!       contributors may be used to endorse or promote products
+!       derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
+! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
+! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
+! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
+! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 
+! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 
+! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
+! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  
+! 
+! *****************************COPYRIGHT*******************************
+! *****************************COPYRIGHT*******************************
+
+      do irand = 1, npoints
+          ! Marsaglia CONG algorithm
+          seed(irand)=69069*seed(irand)+1234567
+          ! mod 32 bit overflow
+          seed(irand)=mod(seed(irand),2**30)   
+          ran(irand)=seed(irand)*0.931322574615479E-09
+      enddo
+
+      ! convert to range 0-1 (32 bit only)
+      overflow_32=i2_16*i2_16
+      if ( overflow_32 .le. huge32 ) then
+          do irand = 1, npoints
+              ran(irand)=ran(irand)+1
+              ran(irand)=(ran(irand))-int(ran(irand))
+          enddo
+      endif
+
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp.F90	(revision 1262)
@@ -0,0 +1,490 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+MODULE MOD_COSP
+  USE MOD_COSP_TYPES
+  USE MOD_COSP_SIMULATOR
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP ---------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
+
+  ! Arguments
+  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
+  integer,intent(in) :: Ncolumns
+  type(cosp_config),intent(in) :: cfg   ! Configuration options
+  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
+  type(cosp_gridbox),intent(inout) :: gbx
+  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+
+  ! Local variables 
+  integer :: Npoints   ! Number of gridpoints
+  integer :: Nlevels   ! Number of levels
+  integer :: Nhydro    ! Number of hydrometeors
+  integer :: Niter     ! Number of calls to cosp_simulator
+  integer :: i_first,i_last ! First and last gridbox to be processed in each iteration
+  integer :: i,j,k,Ni
+  integer,dimension(2) :: ix,iy
+  logical :: reff_zero
+  real :: minv,maxv
+  real :: maxp,minp
+  integer,dimension(:),allocatable :: & ! Dimensions nPoints
+                  seed    !  It is recommended that the seed is set to a different value for each model
+                          !  gridbox it is called on, as it is possible that the choice of the same 
+                          !  seed value every time may introduce some statistical bias in the results, 
+                          !  particularly for low values of NCOL.
+  ! Types used in one iteration
+  type(cosp_gridbox) :: gbx_it
+  type(cosp_subgrid) :: sgx_it
+  type(cosp_vgrid)   :: vgrid_it
+  type(cosp_sgradar) :: sgradar_it
+  type(cosp_sglidar) :: sglidar_it
+  type(cosp_isccp)   :: isccp_it
+  type(cosp_misr)    :: misr_it
+  type(cosp_radarstats) :: stradar_it
+  type(cosp_lidarstats) :: stlidar_it
+  
+  !++++++++++ Dimensions ++++++++++++
+  Npoints  = gbx%Npoints
+  Nlevels  = gbx%Nlevels
+  Nhydro   = gbx%Nhydro
+
+!++++++++++ Apply sanity checks to inputs ++++++++++
+!  call cosp_check_input('longitude',gbx%longitude,min_val=0.0,max_val=360.0)
+  call cosp_check_input('longitude',gbx%longitude,min_val=-180.0,max_val=180.0)
+  call cosp_check_input('latitude',gbx%latitude,min_val=-90.0,max_val=90.0)
+  call cosp_check_input('dlev',gbx%dlev,min_val=0.0)
+  call cosp_check_input('p',gbx%p,min_val=0.0)
+  call cosp_check_input('ph',gbx%ph,min_val=0.0)
+  call cosp_check_input('T',gbx%T,min_val=0.0)
+  call cosp_check_input('q',gbx%q,min_val=0.0)
+  call cosp_check_input('sh',gbx%sh,min_val=0.0)
+  call cosp_check_input('dtau_s',gbx%dtau_s,min_val=0.0)
+  call cosp_check_input('dtau_c',gbx%dtau_c,min_val=0.0)
+  call cosp_check_input('dem_s',gbx%dem_s,min_val=0.0,max_val=1.0)
+  call cosp_check_input('dem_c',gbx%dem_c,min_val=0.0,max_val=1.0)
+  ! Point information (Npoints)
+  call cosp_check_input('land',gbx%land,min_val=0.0,max_val=1.0)
+  call cosp_check_input('psfc',gbx%psfc,min_val=0.0)
+  call cosp_check_input('sunlit',gbx%sunlit,min_val=0.0,max_val=1.0)
+  call cosp_check_input('skt',gbx%skt,min_val=0.0)
+  ! TOTAL and CONV cloud fraction for SCOPS
+  call cosp_check_input('tca',gbx%tca,min_val=0.0,max_val=1.0)
+  call cosp_check_input('cca',gbx%cca,min_val=0.0,max_val=1.0)
+  ! Precipitation fluxes on model levels
+  call cosp_check_input('rain_ls',gbx%rain_ls,min_val=0.0)
+  call cosp_check_input('rain_cv',gbx%rain_cv,min_val=0.0)
+  call cosp_check_input('snow_ls',gbx%snow_ls,min_val=0.0)
+  call cosp_check_input('snow_cv',gbx%snow_cv,min_val=0.0)
+  call cosp_check_input('grpl_ls',gbx%grpl_ls,min_val=0.0)
+  ! Hydrometeors concentration and distribution parameters
+  call cosp_check_input('mr_hydro',gbx%mr_hydro,min_val=0.0)
+  ! Effective radius [m]. (Npoints,Nlevels,Nhydro)
+  call cosp_check_input('Reff',gbx%Reff,min_val=0.0)
+  reff_zero=.true.
+  if (any(gbx%Reff > 1.e-8)) then
+     reff_zero=.false.
+      ! reff_zero == .false.
+      !     and gbx%use_reff == .true.   Reff use in radar and lidar
+      !     and reff_zero    == .false.  Reff use in lidar and set to 0 for radar
+  endif
+  if ((gbx%use_reff) .and. (reff_zero)) then ! Inconsistent choice. Want to use Reff but not inputs passed
+        print *, '---------- COSP ERROR ------------'
+        print *, ''
+        print *, 'use_reff==.true. but Reff is always zero'
+        print *, ''
+        print *, '----------------------------------'
+        stop
+  endif
+  if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar
+        gbx%Reff = DEFAULT_LIDAR_REFF
+        print *, '---------- COSP WARNING ------------'
+        print *, ''
+        print *, 'Using default Reff in lidar simulations'
+        print *, ''
+        print *, '----------------------------------'
+  endif
+  
+  ! Aerosols concentration and distribution parameters
+  call cosp_check_input('conc_aero',gbx%conc_aero,min_val=0.0)
+  ! Checks for CRM mode
+  if (Ncolumns == 1) then
+     if (gbx%use_precipitation_fluxes) then
+        print *, '---------- COSP ERROR ------------'
+        print *, ''
+        print *, 'Use of precipitation fluxes not supported in CRM mode (Ncolumns=1)'
+        print *, ''
+        print *, '----------------------------------'
+        stop
+     endif
+     if ((maxval(gbx%dtau_c) > 0.0).or.(maxval(gbx%dem_c) > 0.0)) then
+        print *, '---------- COSP ERROR ------------'
+        print *, ''
+        print *, ' dtau_c > 0.0 or dem_c > 0.0. In CRM mode (Ncolumns=1), '
+        print *, ' the optical depth (emmisivity) of all clouds must be '
+        print *, ' passed through dtau_s (dem_s)'
+        print *, ''
+        print *, '----------------------------------'
+        stop
+     endif
+  endif
+
+   
+   ! We base the seed in the decimal part of the surface pressure.
+   allocate(seed(Npoints))
+   seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1   
+      ! Roj Oct/2008 ... Note: seed value of 0 caused me some problems + I want to 
+      ! randomize for each call to COSP even when Npoints ==1
+   minp = minval(gbx%psfc)
+   maxp = maxval(gbx%psfc)
+   if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1
+
+  
+   if (gbx%Npoints_it >= gbx%Npoints) then ! One iteration gbx%Npoints
+        call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
+   else ! Several iterations to save memory
+        Niter = gbx%Npoints/gbx%Npoints_it ! Integer division
+        if (Niter*gbx%Npoints_it < gbx%Npoints) Niter = Niter + 1
+        do i=1,Niter
+            i_first = (i-1)*gbx%Npoints_it + 1
+            i_last  = i_first + gbx%Npoints_it - 1
+            i_last  = min(i_last,gbx%Npoints)
+            Ni = i_last - i_first + 1
+            if (i == 1) then
+                ! Allocate types for all but last iteration
+                call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, &
+                                            gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
+                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
+                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
+                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
+                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
+                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
+                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
+                                            gbx_it)
+                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
+                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
+                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
+                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
+                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
+                call construct_cosp_misr(cfg,Ni,misr_it)
+                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
+                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
+            elseif (i == Niter) then ! last iteration
+                call free_cosp_gridbox(gbx_it,.true.)
+                call free_cosp_subgrid(sgx_it)
+                call free_cosp_vgrid(vgrid_it)
+                call free_cosp_sgradar(sgradar_it)
+                call free_cosp_sglidar(sglidar_it)
+                call free_cosp_isccp(isccp_it)
+                call free_cosp_misr(misr_it)
+                call free_cosp_radarstats(stradar_it)
+                call free_cosp_lidarstats(stlidar_it)
+                ! Allocate types for iterations
+                call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, &
+                                            gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
+                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
+                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
+                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
+                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
+                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
+                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
+                                            gbx_it)
+                ! --- Copy arrays without Npoints as dimension ---
+                gbx_it%dist_prmts_hydro = gbx%dist_prmts_hydro
+                gbx_it%dist_type_aero   = gbx_it%dist_type_aero
+                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
+                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
+                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
+                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
+                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
+                call construct_cosp_misr(cfg,Ni,misr_it)
+                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
+                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
+            endif
+            ! --- Copy sections of arrays with Npoints as dimension ---
+            ix=(/i_first,i_last/)
+            iy=(/1,Ni/)
+            call cosp_gridbox_cpsection(ix,iy,gbx,gbx_it)
+              ! These serve as initialisation of *_it types
+            call cosp_subgrid_cpsection(ix,iy,sgx,sgx_it)
+            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar,sgradar_it)
+            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar,sglidar_it)
+            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp,isccp_it)
+            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr,misr_it)
+            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar,stradar_it)
+            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar,stlidar_it)
+            print *,'---------ix: ',ix
+            call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, &
+                           sglidar_it,isccp_it,misr_it,stradar_it,stlidar_it)
+            
+            ! --- Copy results to output structures ---
+!             call cosp_gridbox_cphp(gbx_it,gbx)
+            ix=(/1,Ni/)
+            iy=(/i_first,i_last/)
+            call cosp_subgrid_cpsection(ix,iy,sgx_it,sgx)
+            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar_it,sgradar)
+            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar_it,sglidar)
+            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp_it,isccp)
+            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr_it,misr)
+            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar_it,stradar)
+            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar_it,stlidar)
+        enddo
+        ! Deallocate types
+        call free_cosp_gridbox(gbx_it,.true.)
+        call free_cosp_subgrid(sgx_it)
+        call free_cosp_vgrid(vgrid_it)
+        call free_cosp_sgradar(sgradar_it)
+        call free_cosp_sglidar(sglidar_it)
+        call free_cosp_isccp(isccp_it)
+        call free_cosp_misr(misr_it)
+        call free_cosp_radarstats(stradar_it)
+        call free_cosp_lidarstats(stlidar_it)
+   endif
+   deallocate(seed)
+
+    
+END SUBROUTINE COSP
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP_ITER ----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
+
+  ! Arguments
+  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
+  integer,dimension(:),intent(in) :: seed
+  type(cosp_config),intent(in) :: cfg   ! Configuration options
+  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
+  type(cosp_gridbox),intent(inout) :: gbx
+  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+
+  ! Local variables 
+  integer :: Npoints   ! Number of gridpoints
+  integer :: Ncolumns  ! Number of subcolumns
+  integer :: Nlevels   ! Number of levels
+  integer :: Nhydro    ! Number of hydrometeors
+  integer :: Niter     ! Number of calls to cosp_simulator
+  integer :: i,j,k
+  real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out
+  integer :: scops_debug=0    !  set to non-zero value to print out inputs for debugging in SCOPS
+  real,dimension(:, :),allocatable :: cca_scops,ls_p_rate,cv_p_rate, &
+                     tca_scops ! Cloud cover in each model level (HORIZONTAL gridbox fraction) of total cloud.
+                               ! Levels are from TOA to SURFACE. (nPoints, nLev)
+  real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level
+                                                                     ! Levels are from SURFACE to TOA
+  type(cosp_sghydro) :: sghydro   ! Subgrid info for hydrometeors en each iteration
+
+  
+  !++++++++++ Dimensions ++++++++++++
+  Npoints  = gbx%Npoints
+  Ncolumns = gbx%Ncolumns
+  Nlevels  = gbx%Nlevels
+  Nhydro   = gbx%Nhydro
+    
+   
+  !++++++++++ Climate/NWP mode ++++++++++  
+  if (Ncolumns > 1) then
+        !++++++++++ Subgrid sampling ++++++++++
+        ! Allocate arrays before calling SCOPS
+        allocate(frac_ls(Npoints,Nlevels),frac_cv(Npoints,Nlevels),prec_ls(Npoints,Nlevels),prec_cv(Npoints,Nlevels))
+        allocate(tca_scops(Npoints,Nlevels),cca_scops(Npoints,Nlevels), &
+                ls_p_rate(Npoints,Nlevels),cv_p_rate(Npoints,Nlevels))
+        ! Initialize to zero
+        frac_ls=0.0
+        prec_ls=0.0
+        frac_cv=0.0
+        prec_cv=0.0
+        ! Cloud fractions for SCOPS from TOA to SFC
+        tca_scops = gbx%tca(:,Nlevels:1:-1)
+        cca_scops = gbx%cca(:,Nlevels:1:-1)
+        
+        ! Call to SCOPS
+        ! strat and conv arrays are passed with levels from TOA to SURFACE.
+        call scops(Npoints,Nlevels,Ncolumns,seed,tca_scops,cca_scops,overlap,sgx%frac_out,scops_debug)
+        
+        ! temporarily use prec_ls/cv to transfer information about precipitation flux into prec_scops
+        if(gbx%use_precipitation_fluxes) then
+            ls_p_rate(:,Nlevels:1:-1)=gbx%rain_ls(:,1:Nlevels)+gbx%snow_ls(:,1:Nlevels)+gbx%grpl_ls(:,1:Nlevels)
+            cv_p_rate(:,Nlevels:1:-1)=gbx%rain_cv(:,1:Nlevels)+gbx%snow_cv(:,1:Nlevels)
+        else
+            ls_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_LSRAIN)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_LSSNOW)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_LSGRPL)
+            cv_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_CVRAIN)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_CVSNOW)
+        endif
+        
+        call prec_scops(Npoints,Nlevels,Ncolumns,ls_p_rate,cv_p_rate,sgx%frac_out,sgx%prec_frac)
+        
+        ! Precipitation fraction
+        do j=1,Npoints,1
+        do k=1,Nlevels,1
+            do i=1,Ncolumns,1
+                if (sgx%frac_out (j,i,Nlevels+1-k) .eq. 1) frac_ls(j,k)=frac_ls(j,k)+1.
+                if (sgx%frac_out (j,i,Nlevels+1-k) .eq. 2) frac_cv(j,k)=frac_cv(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 1) prec_ls(j,k)=prec_ls(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 2) prec_cv(j,k)=prec_cv(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 3) then
+                    prec_cv(j,k)=prec_cv(j,k)+1.
+                    prec_ls(j,k)=prec_ls(j,k)+1.
+                endif
+            enddo  !i
+            frac_ls(j,k)=frac_ls(j,k)/Ncolumns
+            frac_cv(j,k)=frac_cv(j,k)/Ncolumns
+            prec_ls(j,k)=prec_ls(j,k)/Ncolumns
+            prec_cv(j,k)=prec_cv(j,k)/Ncolumns
+        enddo  !k
+        enddo  !j
+        
+         ! Levels from SURFACE to TOA.
+        if (Npoints*Ncolumns*Nlevels < 10000) then
+            sgx%frac_out(1:Npoints,:,1:Nlevels)  = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+            sgx%prec_frac(1:Npoints,:,1:Nlevels) = sgx%prec_frac(1:Npoints,:,Nlevels:1:-1)
+        else
+            ! This is done within a loop (unvectorized) over nPoints to save memory
+            do j=1,Npoints
+                sgx%frac_out(j,:,1:Nlevels)  = sgx%frac_out(j,:,Nlevels:1:-1)
+                sgx%prec_frac(j,:,1:Nlevels) = sgx%prec_frac(j,:,Nlevels:1:-1)
+            enddo
+        endif
+       
+       ! Deallocate arrays that will no longer be used
+        deallocate(tca_scops,cca_scops,ls_p_rate,cv_p_rate)
+         
+        ! Populate the subgrid arrays
+        call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
+        do k=1,Ncolumns
+            !--------- Mixing ratios for clouds and Reff for Clouds and precip -------
+            column_frac_out => sgx%frac_out(:,k,:)
+            where (column_frac_out == 1)     !+++++++++++ LS clouds ++++++++
+                sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ)
+                sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE)
+                
+                sghydro%Reff(:,k,:,I_LSCLIQ)     = gbx%Reff(:,:,I_LSCLIQ)
+                sghydro%Reff(:,k,:,I_LSCICE)     = gbx%Reff(:,:,I_LSCICE)
+                sghydro%Reff(:,k,:,I_LSRAIN)     = gbx%Reff(:,:,I_LSRAIN)
+                sghydro%Reff(:,k,:,I_LSSNOW)     = gbx%Reff(:,:,I_LSSNOW)
+                sghydro%Reff(:,k,:,I_LSGRPL)     = gbx%Reff(:,:,I_LSGRPL)
+            elsewhere (column_frac_out == 2) !+++++++++++ CONV clouds ++++++++
+                sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 
+                sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) 
+                
+                sghydro%Reff(:,k,:,I_CVCLIQ)     = gbx%Reff(:,:,I_CVCLIQ) 
+                sghydro%Reff(:,k,:,I_CVCICE)     = gbx%Reff(:,:,I_CVCICE) 
+                sghydro%Reff(:,k,:,I_CVRAIN)     = gbx%Reff(:,:,I_CVRAIN) 
+                sghydro%Reff(:,k,:,I_CVSNOW)     = gbx%Reff(:,:,I_CVSNOW) 
+            end where 
+            !--------- Precip -------
+            if (.not. gbx%use_precipitation_fluxes) then
+                where (column_frac_out == 1)  !+++++++++++ LS Precipitation ++++++++
+                    sghydro%mr_hydro(:,k,:,I_LSRAIN) = gbx%mr_hydro(:,:,I_LSRAIN)
+                    sghydro%mr_hydro(:,k,:,I_LSSNOW) = gbx%mr_hydro(:,:,I_LSSNOW)
+                    sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL)
+                elsewhere (column_frac_out == 2) !+++++++++++ CONV Precipitation ++++++++
+                    sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 
+                    sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) 
+                end where 
+            endif
+        enddo
+        ! convert the mixing ratio and precipitation flux from gridbox mean to the fraction-based values
+        do k=1,Nlevels
+            do j=1,Npoints
+                !--------- Clouds -------
+                if (frac_ls(j,k) .ne. 0.) then
+                    sghydro%mr_hydro(j,:,k,I_LSCLIQ) = sghydro%mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
+                    sghydro%mr_hydro(j,:,k,I_LSCICE) = sghydro%mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
+                endif
+                if (frac_cv(j,k) .ne. 0.) then
+                    sghydro%mr_hydro(j,:,k,I_CVCLIQ) = sghydro%mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
+                    sghydro%mr_hydro(j,:,k,I_CVCICE) = sghydro%mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
+                endif
+                !--------- Precip -------
+                if (gbx%use_precipitation_fluxes) then
+                    if (prec_ls(j,k) .ne. 0.) then
+                        gbx%rain_ls(j,k) = gbx%rain_ls(j,k)/prec_ls(j,k)
+                        gbx%snow_ls(j,k) = gbx%snow_ls(j,k)/prec_ls(j,k)
+                        gbx%grpl_ls(j,k) = gbx%grpl_ls(j,k)/prec_ls(j,k)
+                    endif
+                    if (prec_cv(j,k) .ne. 0.) then
+                        gbx%rain_cv(j,k) = gbx%rain_cv(j,k)/prec_cv(j,k)
+                        gbx%snow_cv(j,k) = gbx%snow_cv(j,k)/prec_cv(j,k)
+                    endif
+                else
+                    if (prec_ls(j,k) .ne. 0.) then
+                        sghydro%mr_hydro(j,:,k,I_LSRAIN) = sghydro%mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
+                        sghydro%mr_hydro(j,:,k,I_LSSNOW) = sghydro%mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
+                        sghydro%mr_hydro(j,:,k,I_LSGRPL) = sghydro%mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
+                    endif
+                    if (prec_cv(j,k) .ne. 0.) then
+                        sghydro%mr_hydro(j,:,k,I_CVRAIN) = sghydro%mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
+                        sghydro%mr_hydro(j,:,k,I_CVSNOW) = sghydro%mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
+                    endif
+                endif  
+            enddo !k
+        enddo !j
+        deallocate(frac_ls,prec_ls,frac_cv,prec_cv)
+        
+        if (gbx%use_precipitation_fluxes) then
+            ! convert precipitation flux into mixing ratio
+            call pf_to_mr(Npoints,Nlevels,Ncolumns,gbx%rain_ls,gbx%snow_ls,gbx%grpl_ls, &
+                        gbx%rain_cv,gbx%snow_cv,sgx%prec_frac,gbx%p,gbx%T, &
+                        sghydro%mr_hydro(:,:,:,I_LSRAIN),sghydro%mr_hydro(:,:,:,I_LSSNOW),sghydro%mr_hydro(:,:,:,I_LSGRPL), &
+                        sghydro%mr_hydro(:,:,:,I_CVRAIN),sghydro%mr_hydro(:,:,:,I_CVSNOW))
+        endif
+   !++++++++++ CRM mode ++++++++++
+   else
+      sghydro%mr_hydro(:,1,:,:) = gbx%mr_hydro
+      sghydro%Reff(:,1,:,:) = gbx%Reff
+      !--------- Clouds -------
+      where ((gbx%dtau_s > 0.0))
+             sgx%frac_out(:,1,:) = 1  ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
+      endwhere
+   endif ! Ncolumns > 1
+  
+   
+   !++++++++++ Simulator ++++++++++
+    call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,stradar,stlidar)
+
+    ! Deallocate subgrid arrays
+    call free_cosp_sghydro(sghydro)
+END SUBROUTINE COSP_ITER
+
+END MODULE MOD_COSP
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_constants.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_constants.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_constants.F90	(revision 1262)
@@ -0,0 +1,124 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Jul 2008 - A. Bodas-Salcedo - Added definitions of ISCCP axes
+! Oct 2008 - H. Chepfer       - Added PARASOL_NREFL
+!
+! 
+MODULE MOD_COSP_CONSTANTS
+!    use netcdf, only: nf90_fill_rea
+    IMPLICIT NONE
+    
+    ! Indices to address arrays of LS and CONV hydrometeors
+    integer,parameter :: I_LSCLIQ = 1
+    integer,parameter :: I_LSCICE = 2
+    integer,parameter :: I_LSRAIN = 3
+    integer,parameter :: I_LSSNOW = 4
+    integer,parameter :: I_CVCLIQ = 5
+    integer,parameter :: I_CVCICE = 6
+    integer,parameter :: I_CVRAIN = 7
+    integer,parameter :: I_CVSNOW = 8
+    integer,parameter :: I_LSGRPL = 9
+    
+    ! Missing value
+!!    real,parameter :: R_UNDEF = -1.0E30
+     real,parameter :: R_UNDEF = 9.96921e+36
+!      real,parameter :: R_UNDEF = nf90_fill_rea
+    ! Number of possible output variables
+    integer,parameter :: N_OUT_LIST = 27
+    
+    !--- Radar constants
+    ! CFAD constants
+    integer,parameter :: DBZE_BINS     =   15   ! Number of dBZe bins in histogram (cfad)
+    real,parameter    :: DBZE_MIN      = -100.0 ! Minimum value for radar reflectivity
+    real,parameter    :: DBZE_MAX      =   30.0 ! Maximum value for radar reflectivity
+    real,parameter    :: CFAD_ZE_MIN   =  -50.0 ! Lower value of the first CFAD Ze bin
+    real,parameter    :: CFAD_ZE_WIDTH =    5.0 ! Bin width (dBZe)
+
+   
+    !--- Lidar constants
+    ! CFAD constants
+    integer,parameter :: SR_BINS       =   15
+    integer,parameter :: DPOL_BINS     =   6
+    real,parameter    :: LIDAR_UNDEF   =   999.999
+    ! Other constants
+    integer,parameter :: LIDAR_NCAT    =   4
+    integer,parameter :: PARASOL_NREFL =   5 ! parasol
+!     real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 15.0, 30.0, 45.0, 60.0/)
+    real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/1.0, 2.0, 3.0, 4.0, 5.0/)
+    real,parameter    :: DEFAULT_LIDAR_REFF = 30.0e-6 ! Default lidar effective radius
+    
+    !--- MISR constants
+    integer,parameter :: MISR_N_CTH = 16
+
+    !--- RTTOV constants
+    integer,parameter :: RTTOV_MAX_CHANNELS = 20
+    
+    ! ISCCP tau-Pc axes
+    real,parameter,dimension(7) :: ISCCP_TAU = (/0.15, 0.80, 2.45, 6.5, 16.2, 41.5, 50000.0/)
+    real,parameter,dimension(2,7) :: ISCCP_TAU_BNDS = reshape(source=(/0.0,0.3,0.3,1.30,1.30,3.6,3.6,9.4, &
+                                                      9.4,23.0,23.0,60.0,60.0,100000.0/), shape=(/2,7/))
+   
+!     real,parameter,dimension(7) :: ISCCP_PC = (/9000., 24500., 37500., 50000., 62000., 74000., 90000./)
+!     real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/0.0,18000.0,18000.0,31000.0,31000.0, &
+!                                44000.0,44000.0,56000.0,56000.0,68000.0,68000.0,80000.0,80000.0,100000.0/), shape=(/2,7/))
+   
+    real,parameter,dimension(7) :: ISCCP_PC = (/90000., 74000., 62000., 50000., 37500., 24500., 9000./)
+    real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/100000.0,80000.0,80000.0,68000.0,68000.0,56000.0 &
+                               ,56000.0,44000.0,44000.0,31000.0,31000.0,18000.0,18000.0,0.0/), shape=(/2,7/))
+    
+    real,parameter,dimension(MISR_N_CTH) :: MISR_CTH = (/ 0., 0.25, 0.75, 1.25, 1.75, 2.25, 2.75, 3.5, &
+                                            4.5, 6., 8., 10., 12., 14.5, 16., 18./)
+    real,parameter,dimension(2,MISR_N_CTH) :: MISR_CTH_BNDS = reshape(source=(/ &
+                                            -99.0,  0.0,       0.0,  0.5,       0.5,  1.0,      1.0,  1.5, &
+                                              1.5,  2.0,       2.0,  2.5,       2.5,  3.0,      3.0,  4.0, &
+                                              4.0,  5.0,       5.0,  7.0,       7.0,  9.0,      9.0, 11.0, &
+                                             11.0, 13.0,      13.0, 15.0,      15.0, 17.0,     17.0, 99.0/), &
+                                             shape=(/2,MISR_N_CTH/))
+            
+    !  Table hclass for quickbeam
+    integer,parameter :: N_HYDRO = 9
+    real :: HCLASS_TYPE(N_HYDRO),HCLASS_COL(N_HYDRO),HCLASS_PHASE(N_HYDRO), &
+            HCLASS_CP(N_HYDRO),HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO)
+    real :: HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
+            HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
+    data HCLASS_TYPE/5,1,2,2,5,1,2,2,2/
+    data HCLASS_COL/1,2,3,4,5,6,7,8,9/
+    data HCLASS_PHASE/0,1,0,1,0,1,0,1,1/
+    data HCLASS_CP/0,0,1,1,0,0,1,1,1/
+    data HCLASS_DMIN/-1,-1,-1,-1,-1,-1,-1,-1,-1/
+    data HCLASS_DMAX/-1,-1,-1,-1,-1,-1,-1,-1,-1/
+    data HCLASS_APM/524,110.8,524,-1,524,110.8,524,-1,-1/
+    data HCLASS_BPM/3,2.91,3,-1,3,2.91,3,-1,-1/
+    data HCLASS_RHO/-1,-1,-1,100,-1,-1,-1,100,400/
+    data HCLASS_P1/-1,-1,8000000.,3000000.,-1,-1,8000000.,3000000.,4000000./
+    data HCLASS_P2/6,40,-1,-1,6,40,-1,-1,-1/
+    data HCLASS_P3/0.3,2,-1,-1,0.3,2,-1,-1,-1/
+
+    
+    
+END MODULE MOD_COSP_CONSTANTS
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_isccp_simulator.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_isccp_simulator.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_isccp_simulator.F90	(revision 1262)
@@ -0,0 +1,96 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+MODULE MOD_COSP_ISCCP_SIMULATOR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------- SUBROUTINE COSP_ISCCP_SIMULATOR -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_ISCCP_SIMULATOR(gbx,sgx,y)
+  
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
+  type(cosp_isccp),intent(inout) :: y   ! ISCCP simulator output
+  
+  ! Local variables 
+  integer :: i,Nlevels,Npoints
+  real :: pfull(gbx%Npoints, gbx%Nlevels)
+  real :: phalf(gbx%Npoints, gbx%Nlevels + 1)
+  real :: qv(gbx%Npoints, gbx%Nlevels)
+  real :: cc(gbx%Npoints, gbx%Nlevels)
+  real :: conv(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  real :: at(gbx%Npoints, gbx%Nlevels)
+  real :: dem_s(gbx%Npoints, gbx%Nlevels)
+  real :: dem_c(gbx%Npoints, gbx%Nlevels)
+  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  integer :: sunlit(gbx%Npoints)
+  
+  Nlevels = gbx%Nlevels
+  Npoints = gbx%Npoints
+  ! Flip inputs. Levels from TOA to surface
+  pfull  = gbx%p(:,Nlevels:1:-1) 
+  phalf(:,1)         = 0.0 ! Top level
+  phalf(:,2:Nlevels+1) = gbx%ph(:,Nlevels:1:-1)
+  qv     = gbx%sh(:,Nlevels:1:-1) 
+  cc     = 0.999999*gbx%tca(:,Nlevels:1:-1) 
+  conv   = 0.999999*gbx%cca(:,Nlevels:1:-1) 
+  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
+  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
+  at     = gbx%T(:,Nlevels:1:-1) 
+  dem_s  = gbx%dem_s(:,Nlevels:1:-1) 
+  dem_c  = gbx%dem_c(:,Nlevels:1:-1) 
+  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+  sunlit = int(gbx%sunlit)
+  call icarus(0,0,gbx%npoints,sunlit,gbx%nlevels,gbx%ncolumns, &
+            pfull,phalf,qv,cc,conv,dtau_s,dtau_c, &
+            gbx%isccp_top_height,gbx%isccp_top_height_direction, &
+            gbx%isccp_overlap,frac_out, &
+            gbx%skt,gbx%isccp_emsfc_lw,at,dem_s,dem_c,y%fq_isccp,y%totalcldarea, &
+            y%meanptop,y%meantaucld,y%meanalbedocld, &
+            y%meantb,y%meantbclr,y%boxtau,y%boxptop)
+
+  ! Flip outputs. Levels from surface to TOA
+  ! --- (npoints,tau=7,pressure=7)
+  y%fq_isccp(:,:,:) = y%fq_isccp(:,:,7:1:-1)
+     
+  ! Change boxptop from hPa to Pa. This avoids using UDUNITS in CMOR
+  y%boxptop = y%boxptop*100.0
+  
+  ! Check if there is any value slightly greater than 1
+  where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5))
+    y%totalcldarea = 1.0
+  endwhere
+              
+END SUBROUTINE COSP_ISCCP_SIMULATOR
+
+END MODULE MOD_COSP_ISCCP_SIMULATOR
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_lidar.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_lidar.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_lidar.F90	(revision 1262)
@@ -0,0 +1,86 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Oct 2008 - S. Bony          - Instructions "Call for large-scale cloud" removed  -> sgx%frac_out is used instead.
+!                               Call lidar_simulator changed (lsca, gbx%cca and depol removed; 
+!                               frac_out changed in sgx%frac_out)
+!
+! 
+MODULE MOD_COSP_LIDAR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_LIDAR ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_LIDAR(gbx,sgx,sghydro,y)
+  
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_sglidar),intent(inout) :: y ! Subgrid output
+  
+  ! Local variables 
+  integer :: i
+  real :: presf(sgx%Npoints, sgx%Nlevels + 1)
+  real :: frac_out(sgx%Npoints, sgx%Nlevels)
+  real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci
+  real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot
+  real,dimension(sgx%Npoints, PARASOL_NREFL)  :: refle
+  
+  
+  presf(:,1:sgx%Nlevels) = gbx%ph
+  presf(:,sgx%Nlevels + 1) = 0.0
+!   presf(:,sgx%Nlevels + 1) = gbx%p(:,sgx%Nlevels) - (presf(:,sgx%Nlevels) - gbx%p(:,sgx%Nlevels)) 
+  lsca = gbx%tca-gbx%cca
+  do i=1,sgx%Ncolumns
+      ! Temporary arrays for simulator call
+      mr_ll(:,:) = sghydro%mr_hydro(:,i,:,I_LSCLIQ)
+      mr_li(:,:) = sghydro%mr_hydro(:,i,:,I_LSCICE)
+      mr_cl(:,:) = sghydro%mr_hydro(:,i,:,I_CVCLIQ)
+      mr_ci(:,:) = sghydro%mr_hydro(:,i,:,I_CVCICE)
+      call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4 &
+                 , PARASOL_NREFL, LIDAR_UNDEF  &
+                 , gbx%p, presf, gbx%T &
+                 , mr_ll, mr_li, mr_cl, mr_ci &
+                 , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE), gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) &
+                 , sgx%frac_out, gbx%lidar_ice_type, y%beta_mol, beta_tot, tau_tot  &
+                 , refle ) ! reflectance
+      
+      y%beta_tot(:,i,:) = beta_tot(:,:)
+      y%tau_tot(:,i,:)  = tau_tot(:,:)
+      y%refl(:,i,:)     = refle(:,:)
+  enddo
+
+END SUBROUTINE COSP_LIDAR
+
+END MODULE MOD_COSP_LIDAR
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_misr_simulator.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_misr_simulator.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_misr_simulator.F90	(revision 1262)
@@ -0,0 +1,80 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Nov 2008 - A. Bodas-Salcedo - Initial version
+!
+!
+
+MODULE MOD_COSP_MISR_SIMULATOR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------- SUBROUTINE COSP_MISR_SIMULATOR -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_MISR_SIMULATOR(gbx,sgx,y)
+  
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
+  type(cosp_misr),intent(inout) :: y    ! MISR simulator output
+  
+  ! Local variables 
+  integer :: i,Nlevels,Npoints
+  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  real :: at(gbx%Npoints, gbx%Nlevels)
+  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  integer :: sunlit(gbx%Npoints)
+  
+  real :: zfull(gbx%Npoints, gbx%Nlevels) !  height (in meters) of full model levels (i.e. midpoints)
+                                          !  zfull(npoints,1)    is    top level of model
+                                          !  zfull(npoints,nlev) is bottom level of model
+  real :: phy_t0p1_mean_ztop              ! mean cloud top height(m) of 0.1 tau treshold
+  real :: fq_phy_t0p1_TAU_v_CTH(7,16)      
+     
+  	
+  Nlevels = gbx%Nlevels
+  Npoints = gbx%Npoints
+  ! Levels from TOA to surface
+  zfull  = gbx%zlev(:,Nlevels:1:-1)
+  at     = gbx%T(:,Nlevels:1:-1) 
+  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
+  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
+  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+  sunlit = int(gbx%sunlit)
+ 
+  call MISR_simulator(gbx%npoints,gbx%nlevels,gbx%ncolumns,&
+                     sunlit,zfull,at,dtau_s,dtau_c,frac_out, &
+                     y%fq_MISR,y%MISR_dist_model_layertops,y%MISR_meanztop,y%MISR_cldarea)
+            
+END SUBROUTINE COSP_MISR_SIMULATOR
+
+END MODULE MOD_COSP_MISR_SIMULATOR
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_radar.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_radar.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_radar.F90	(revision 1262)
@@ -0,0 +1,212 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+MODULE MOD_COSP_RADAR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  use radar_simulator_types
+  use array_lib
+  use atmos_lib
+  use format_input
+  IMPLICIT NONE
+  
+  INTERFACE
+    subroutine radar_simulator(freq,k2,do_ray,use_gas_abs,use_mie_table,mt, &
+        nhclass,hp,nprof,ngate,nsizes,D,hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix, &
+        rh_matrix,Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe, &
+        g_to_vol_in,g_to_vol_out)
+  
+        use m_mrgrnk 
+        use array_lib
+        use math_lib
+        use optics_lib
+        use radar_simulator_types
+        implicit none
+        ! ----- INPUTS -----  
+        type(mie), intent(in) :: mt
+        type(class_param) :: hp
+        real*8, intent(in) :: freq,k2
+        integer, intent(in) ::  do_ray,use_gas_abs,use_mie_table, &
+            nhclass,nprof,ngate,nsizes
+        real*8, dimension(nsizes), intent(in) :: D
+        real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
+            t_matrix,rh_matrix
+        real*8, dimension(nhclass,nprof,ngate), intent(in) :: hm_matrix
+        real*8, dimension(nhclass,nprof,ngate), intent(inout) :: re_matrix
+        ! ----- OUTPUTS -----
+        real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
+            g_atten_to_vol,dBZe,h_atten_to_vol    
+        ! ----- OPTIONAL -----
+        real*8, optional, dimension(ngate,nprof) :: &
+            g_to_vol_in,g_to_vol_out
+     end subroutine radar_simulator
+  END INTERFACE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_RADAR ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_RADAR(gbx,sgx,sghydro,z)
+  IMPLICIT NONE
+
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_sgradar),intent(inout) :: z ! Output from simulator, subgrid
+
+  ! Local variables 
+  integer :: & 
+  nsizes			! num of discrete drop sizes
+
+  real*8 :: &
+  freq, &			! radar frequency (GHz)
+  k2 				! |K|^2, -1=use frequency dependent default
+  
+  real*8, dimension(:,:), allocatable :: &
+  g_to_vol ! integrated atten due to gases, r>v (dB)
+  
+  real*8, dimension(:,:), allocatable :: &
+  Ze_non, &			! radar reflectivity withOUT attenuation (dBZ)
+  Ze_ray, &			! Rayleigh reflectivity (dBZ)
+  h_atten_to_vol, &		! attenuation by hydromets, radar to vol (dB)
+  g_atten_to_vol, &		! gaseous atteunation, radar to vol (dB)
+  dBZe, &			! effective radar reflectivity factor (dBZ)
+  hgt_matrix, &			! height of hydrometeors (km)
+  t_matrix, &                   !temperature (k)
+  p_matrix, &                   !pressure (hPa)
+  rh_matrix                     !relative humidity (%)
+  
+  real*8, dimension(:,:,:), allocatable :: &
+  hm_matrix, &			! hydrometeor mixing ratio (g kg^-1)
+  re_matrix
+
+  integer, parameter :: one = 1
+  logical :: hgt_reversed
+  integer :: pr,i,j,k,unt
+
+! ----- main program settings ------
+
+  freq = gbx%radar_freq
+  k2 = gbx%k2
+ 
+  !
+  ! note:  intitialization section that was here has been relocated to SUBROUTINE CONSTRUCT_COSP_GRIDBOX by roj, Feb 2008
+  !
+  mt_ttl=gbx%mt_ttl  ! these variables really should be moved into the mt structure rather than kept as global arrays.
+  mt_tti=gbx%mt_tti
+
+  ! Inputs to Quickbeam
+  allocate(hgt_matrix(gbx%Npoints,gbx%Nlevels),p_matrix(gbx%Npoints,gbx%Nlevels), &
+           t_matrix(gbx%Npoints,gbx%Nlevels),rh_matrix(gbx%Npoints,gbx%Nlevels))
+  allocate(hm_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels)) 
+  allocate(re_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
+
+  ! Outputs from Quickbeam
+  allocate(Ze_non(gbx%Npoints,gbx%Nlevels))
+  allocate(Ze_ray(gbx%Npoints,gbx%Nlevels))
+  allocate(h_atten_to_vol(gbx%Npoints,gbx%Nlevels))
+  allocate(g_atten_to_vol(gbx%Npoints,gbx%Nlevels))
+  allocate(dBZe(gbx%Npoints,gbx%Nlevels))
+  
+  ! Optional argument. It is computed and returned in the first call to
+  ! radar_simulator, and passed as input in the rest
+  allocate(g_to_vol(gbx%Nlevels,gbx%Npoints))
+  
+  p_matrix   = gbx%p/100.0     ! From Pa to hPa
+  hgt_matrix = gbx%zlev/1000.0 ! From m to km
+  t_matrix   = gbx%T-273.15    ! From K to C
+  rh_matrix  = gbx%q
+  re_matrix  = 0.0
+  
+  ! Quickbeam assumes the first row is closest to the radar
+  call order_data(hgt_matrix,hm_matrix,p_matrix,t_matrix, &
+      rh_matrix,gbx%surface_radar,hgt_reversed)
+  
+  ! ----- loop over subcolumns -----
+  do pr=1,sgx%Ncolumns
+      !  atmospheric profiles are the same within the same gridbox
+      !  only hydrometeor profiles will be different
+      if (hgt_reversed) then  
+         do i=1,gbx%Nhydro  
+            hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,gbx%Nlevels:1:-1,i)*1000.0 ! Units from kg/kg to g/kg
+            if (gbx%use_reff) then
+              re_matrix(i,:,:) = sghydro%Reff(:,pr,gbx%Nlevels:1:-1,i)*1.e6     ! Units from m to micron
+            endif
+         enddo  
+      else  
+         do i=1,gbx%Nhydro
+            hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,:,i)*1000.0 ! Units from kg/kg to g/kg
+            if (gbx%use_reff) then
+              re_matrix(i,:,:) = sghydro%Reff(:,pr,:,i)*1.e6       ! Units from m to micron
+            endif
+         enddo
+      endif  
+
+      !   ----- call radar simulator -----
+      if (pr == 1) then ! Compute gaseous attenuation for all profiles
+         j=0
+         if (gbx%Npoints == 53) then
+           unt=10
+           j=1
+         endif
+         if (gbx%Npoints == 153) then
+           unt=11
+           j=101
+         endif
+         call radar_simulator(freq,k2,gbx%do_ray,gbx%use_gas_abs,gbx%use_mie_tables,gbx%mt, &    !  v0.2: mt changed to gbx%mt, roj
+           gbx%Nhydro,gbx%hp,gbx%Npoints,gbx%Nlevels,gbx%nsizes,gbx%D, &                         !  v0.2: hp->gbx%hp, D->gbx%d, nsizes->gbx%nsizes, roj
+           hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix,rh_matrix, &
+           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_out=g_to_vol)
+      else ! Use gaseous atteunuation for pr = 1
+         call radar_simulator(freq,k2,gbx%do_ray,gbx%use_gas_abs,gbx%use_mie_tables,gbx%mt, &
+           gbx%Nhydro,gbx%hp,gbx%Npoints,gbx%Nlevels,gbx%nsizes,gbx%D, &
+           hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix,rh_matrix, &
+           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_in=g_to_vol)
+      endif
+      ! ----- BEGIN output section -----
+      ! spaceborne radar : from TOA to SURFACE
+      if (gbx%surface_radar == 1) then
+        z%Ze_tot(:,pr,:)=dBZe(:,:)
+      else if (gbx%surface_radar == 0) then ! Spaceborne
+        z%Ze_tot(:,pr,:)=dBZe(:,gbx%Nlevels:1:-1)
+      endif
+
+  enddo !pr
+  
+  ! Change undefined value to one defined in COSP
+  where (z%Ze_tot == -999.0) z%Ze_tot = R_UNDEF
+
+  deallocate(hgt_matrix,p_matrix,t_matrix,rh_matrix)
+  deallocate(hm_matrix,re_matrix, &
+      Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe)
+  deallocate(g_to_vol)
+ 
+  ! deallocate(mt_ttl,mt_tti)	!v0.2: roj feb 2008 can not be done here,
+                                !these variables now part of gbx structure and dealocated later
+
+END SUBROUTINE COSP_RADAR
+
+END MODULE MOD_COSP_RADAR
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_simulator.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_simulator.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_simulator.F90	(revision 1262)
@@ -0,0 +1,127 @@
+! (c) British Crown Copyright 2008, the Met Office.
+
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+!
+!
+
+MODULE MOD_COSP_SIMULATOR
+  USE MOD_COSP_TYPES
+  USE MOD_COSP_RADAR
+  USE MOD_COSP_LIDAR
+  USE MOD_COSP_ISCCP_SIMULATOR
+  USE MOD_COSP_MISR_SIMULATOR
+  USE MOD_COSP_STATS
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP_SIMULATOR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,stradar,stlidar)
+
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx      ! Grid-box inputs
+  type(cosp_subgrid),intent(in) :: sgx      ! Subgrid inputs
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_config),intent(in) :: cfg       ! Configuration options
+  type(cosp_vgrid),intent(in)   :: vgrid    ! Information on vertical grid of stats
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+  ! Local variables
+  ! ***Timing variables (to be deleted in final version)
+  integer :: t0,t1,count_rate,count_max
+
+  !+++++++++ Radar model ++++++++++  
+  if (cfg%Lradar_sim) then
+    call system_clock(t0,count_rate,count_max)
+    call cosp_radar(gbx,sgx,sghydro,sgradar)
+    call system_clock(t1,count_rate,count_max)
+    print *, '%%%%%%  Radar:', (t1-t0)*1.0/count_rate, ' s'
+  else 
+    print *, '%%%%%%  Radar not used'
+  endif
+  
+  !+++++++++ Lidar model ++++++++++
+  if (cfg%Llidar_sim) then
+    call system_clock(t0,count_rate,count_max)
+    call cosp_lidar(gbx,sgx,sghydro,sglidar)
+    call system_clock(t1,count_rate,count_max)
+    print *, '%%%%%%  Lidar:', (t1-t0)*1.0/count_rate, ' s'
+  else 
+    print *, '%%%%%%  Lidar not used'
+  endif
+
+  
+  !+++++++++ ISCCP simulator ++++++++++
+  if (cfg%Lisccp_sim) then
+    call system_clock(t0,count_rate,count_max)
+    call cosp_isccp_simulator(gbx,sgx,isccp)
+    call system_clock(t1,count_rate,count_max)
+    print *, '%%%%%%  ISCCP:', (t1-t0)*1.0/count_rate, ' s'
+  else 
+    print *, '%%%%%%  ISCCP not used'
+  endif
+  
+  !+++++++++ MISR simulator ++++++++++
+  if (cfg%Lmisr_sim) then
+    call system_clock(t0,count_rate,count_max)
+    call cosp_misr_simulator(gbx,sgx,misr)
+    call system_clock(t1,count_rate,count_max)
+    print *, '%%%%%%  MISR:', (t1-t0)*1.0/count_rate, ' s'
+  else 
+    print *, '%%%%%%  MISR not used'
+  endif
+  
+
+  !+++++++++++ Summary statistics +++++++++++
+!   write(*,*) 'Stats:'
+!   read(*,*) c 
+  if (cfg%Lstats) then
+    call system_clock(t0,count_rate,count_max)
+    call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
+    call system_clock(t1,count_rate,count_max)
+    print *, '%%%%%%  Stats:', (t1-t0)*1.0/count_rate, ' s'
+  endif
+  !+++++++++++ change of units after computation of statistics +++++++++++
+  if (cfg%Llidar_sim) then
+    where((sglidar%beta_tot > 0.0) .and. (sglidar%beta_tot /= R_UNDEF)) 
+        sglidar%beta_tot = log10(sglidar%beta_tot)
+    elsewhere
+        sglidar%beta_tot = R_UNDEF
+    end where
+  endif
+
+END SUBROUTINE COSP_SIMULATOR
+
+END MODULE MOD_COSP_SIMULATOR
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_stats.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_stats.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_stats.F90	(revision 1262)
@@ -0,0 +1,236 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Jul 2008 - A. Bodas-Salcedo - Added capability of producing outputs in standard grid
+! Oct 2008 - J.-L. Dufresne   - Bug fixed. Assignment of Npoints,Nlevels,Nhydro,Ncolumns in COSP_STATS
+! Oct 2008 - H. Chepfer       - Added PARASOL reflectance arguments
+!
+! 
+MODULE MOD_COSP_STATS
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  USE MOD_LLNL_STATS
+  USE MOD_LMD_IPSL_STATS
+  IMPLICIT NONE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_STATS ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_STATS(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
+  
+   ! Input arguments
+   type(cosp_gridbox),intent(in) :: gbx
+   type(cosp_subgrid),intent(in) :: sgx
+   type(cosp_config),intent(in)  :: cfg
+   type(cosp_sgradar),intent(in) :: sgradar
+   type(cosp_sglidar),intent(in) :: sglidar
+   type(cosp_vgrid),intent(in)   :: vgrid
+   ! Output arguments
+   type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics for radar
+   type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics for lidar 
+   
+   ! Local variables 
+   integer :: Npoints  !# of grid points
+   integer :: Nlevels  !# of levels
+   integer :: Nhydro   !# of hydrometeors
+   integer :: Ncolumns !# of columns
+   integer :: Nlr
+   logical :: ok_lidar_cfad = .false.
+   real,dimension(:,:,:),allocatable :: Ze_out,betatot_out,betamol_in,betamol_out,ph_in,ph_out
+   real,dimension(:,:),allocatable :: ph_c,betamol_c
+ 
+   Npoints  = gbx%Npoints
+   Nlevels  = gbx%Nlevels
+   Nhydro   = gbx%Nhydro
+   Ncolumns = gbx%Ncolumns
+   Nlr      = vgrid%Nlvgrid
+  
+   if (cfg%Lcfad_lidarsr532) ok_lidar_cfad=.true.
+
+   if (vgrid%use_vgrid) then ! Statistics in a different vertical grid
+        allocate(Ze_out(Npoints,Ncolumns,Nlr),betatot_out(Npoints,Ncolumns,Nlr), &
+                 betamol_in(Npoints,1,Nlevels),betamol_out(Npoints,1,Nlr),betamol_c(Npoints,Nlr), &
+                 ph_in(Npoints,1,Nlevels),ph_out(Npoints,1,Nlr),ph_c(Npoints,Nlr))
+        Ze_out = 0.0
+        betatot_out  = 0.0
+        betamol_in(:,1,:) = sglidar%beta_mol(:,:)
+        betamol_out= 0.0
+        betamol_c  = 0.0
+        ph_in(:,1,:)  = gbx%ph(:,:)
+        ph_out  = 0.0
+        ph_c    = 0.0
+        !++++++++++++ Radar CFAD ++++++++++++++++
+        if (cfg%Lradar_sim) then
+            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sgradar%Ze_tot, &
+                                           Nlr,vgrid%zl,vgrid%zu,Ze_out,log_units=.true.)
+            stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,Ze_out, &
+                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
+        endif
+        !++++++++++++ Lidar CFAD ++++++++++++++++
+        if (cfg%Llidar_sim) then
+            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,betamol_in, &
+                                           Nlr,vgrid%zl,vgrid%zu,betamol_out)
+            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%beta_tot, &
+                                           Nlr,vgrid%zl,vgrid%zu,betatot_out)
+            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,ph_in, &
+                                           Nlr,vgrid%zl,vgrid%zu,ph_out)
+            ph_c(:,:) = ph_out(:,1,:)
+            betamol_c(:,:) = betamol_out(:,1,:)
+            ! Stats from lidar_stat_summary
+            call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
+                            ,betatot_out,betamol_c,sglidar%refl,gbx%land,ph_c &
+                            ,LIDAR_UNDEF,ok_lidar_cfad &
+                            ,stlidar%cfad_sr,stlidar%srbval &
+                            ,LIDAR_NCAT,stlidar%lidarcld,stlidar%cldlayer,stlidar%parasolrefl)
+        endif
+        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
+        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
+                                    betatot_out,betamol_c,Ze_out, &
+                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)   
+        ! Deallocate arrays at coarse resolution
+        deallocate(Ze_out,betatot_out,betamol_in,betamol_out,betamol_c,ph_in,ph_out,ph_c)
+   else ! Statistics in model levels
+        !++++++++++++ Radar CFAD ++++++++++++++++
+        if (cfg%Lradar_sim) stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,sgradar%Ze_tot, &
+                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
+        !++++++++++++ Lidar CFAD ++++++++++++++++
+        ! Stats from lidar_stat_summary
+        if (cfg%Llidar_sim) call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
+                        ,sglidar%beta_tot,sglidar%beta_mol,sglidar%refl,gbx%land,gbx%ph &
+                        ,LIDAR_UNDEF,ok_lidar_cfad &
+                        ,stlidar%cfad_sr,stlidar%srbval &
+                        ,LIDAR_NCAT,stlidar%lidarcld,stlidar%cldlayer,stlidar%parasolrefl)
+        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
+        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
+                                    sglidar%beta_tot,sglidar%beta_mol,sgradar%Ze_tot, &
+                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)   
+   endif
+   ! Replace undef
+   where (stlidar%cfad_sr   == LIDAR_UNDEF) stlidar%cfad_sr   = R_UNDEF 
+   where (stlidar%lidarcld  == LIDAR_UNDEF) stlidar%lidarcld  = R_UNDEF 
+   where (stlidar%cldlayer  == LIDAR_UNDEF) stlidar%cldlayer  = R_UNDEF 
+   where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF 
+
+END SUBROUTINE COSP_STATS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!---------- SUBROUTINE COSP_CHANGE_VERTICAL_GRID ----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_CHANGE_VERTICAL_GRID(Npoints,Ncolumns,Nlevels,zfull,zhalf,y,M,zl,zu,r,log_units)
+   implicit none
+   ! Input arguments
+   integer,intent(in) :: Npoints  !# of grid points
+   integer,intent(in) :: Nlevels  !# of levels
+   integer,intent(in) :: Ncolumns !# of columns
+   real,dimension(Npoints,Nlevels),intent(in) :: zfull ! Height at model levels [m] (Bottom of model layer)
+   real,dimension(Npoints,Nlevels),intent(in) :: zhalf ! Height at half model levels [m] (Bottom of model layer)
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: y     ! Variable to be changed to a different grid
+   integer,intent(in) :: M  !# levels in the new grid
+   real,dimension(M),intent(in) :: zl ! Lower boundary of new levels  [m]
+   real,dimension(M),intent(in) :: zu ! Upper boundary of new levels  [m]
+   logical,optional,intent(in) :: log_units ! log units, need to convert to linear units
+   ! Output
+   real,dimension(Npoints,Ncolumns,M),intent(out) :: r ! Variable on new grid
+
+   ! Local variables
+   integer :: i,j,k
+   logical :: lunits
+   real :: ws
+   real,dimension(Nlevels) :: xl,xu ! Lower and upper boundaries of model grid
+   real,dimension(M) :: dz          ! Layer depth
+   real,dimension(Nlevels,M) :: w   ! Weights to do the mean at each point
+   real,dimension(Ncolumns,Nlevels) :: yp  ! Variable to be changed to a different grid.
+                                           ! Local copy at a particular point.
+                                           ! This allows for change of units.
+   
+   lunits=.false.
+   if (present(log_units)) lunits=log_units
+   
+   r = 0.0
+   do i=1,Npoints
+     ! Vertical grid at that point
+     xl = zhalf(i,:)
+     xu(1:Nlevels-1) = xl(2:Nlevels)
+     xu(Nlevels) = zfull(i,Nlevels) +  zfull(i,Nlevels) - zhalf(i,Nlevels) ! Top level symmetric
+     dz = zu - zl
+     yp = y(i,:,:) ! Temporary variable to regrid
+     ! Find weights
+     w = 0.0
+     do k=1,M
+       do j=1,Nlevels
+         if ((xl(j) < zl(k)).and.(xu(j) > zl(k)).and.(xu(j) <= zu(k))) then
+           !xl(j)-----------------xu(j)
+           !      zl(k)------------------------------zu(k)
+           w(j,k) = xu(j) - zl(k)
+         else if ((xl(j) >= zl(k)).and.(xu(j) <= zu(k))) then
+           !           xl(j)-----------------xu(j)
+           !      zl(k)------------------------------zu(k)
+           w(j,k) = xu(j) - xl(j)
+         else if ((xl(j) >= zl(k)).and.(xl(j) < zu(k)).and.(xu(j) >= zu(k))) then
+           !                           xl(j)-----------------xu(j)
+           !      zl(k)------------------------------zu(k)
+           w(j,k) = zu(k) - xl(j)
+         else if ((xl(j) <= zl(k)).and.(xu(j) >= zu(k))) then
+           !  xl(j)---------------------------xu(j)
+           !        zl(k)--------------zu(k)
+           w(j,k) = dz(j)
+         endif
+       enddo
+     enddo
+     ! Check for dBZ and change if necessary
+     if (lunits) then
+        where (yp /= R_UNDEF)
+          yp = 10.0**(yp/10.0)
+        elsewhere
+          yp = 0.0
+        end where
+     endif
+     ! Do the weighted mean
+     do j=1,Ncolumns
+       do k=1,M
+          ws = sum(w(:,k))
+          if (ws > 0.0) r(i,j,k) = sum(w(:,k)*yp(j,:))/ws
+       enddo
+     enddo
+     ! Check for dBZ and change if necessary
+     if (lunits) then
+        where (r(i,:,:) <= 0.0)
+          r(i,:,:) = R_UNDEF
+        elsewhere
+          r(i,:,:) = 10.0*log10(r(i,:,:))
+        end where
+     endif
+   enddo
+ 
+ 
+   
+END SUBROUTINE COSP_CHANGE_VERTICAL_GRID 
+
+END MODULE MOD_COSP_STATS
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_types.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_types.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_types.F90	(revision 1262)
@@ -0,0 +1,1379 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Feb 2008 - R. Marchand      - Added Quickbeam types and initialisation
+! Oct 2008 - H. Chepfer       - Added PARASOL reflectance diagnostic
+! Nov 2008 - R. Marchand      - Added MISR diagnostics
+! Nov 2008 - V. John          - Added RTTOV diagnostics
+!
+! 
+MODULE MOD_COSP_TYPES
+    USE MOD_COSP_CONSTANTS
+    USE MOD_COSP_UTILS
+
+    use radar_simulator_types, only: class_param, mie, nd, mt_nd, dmax, dmin, mt_ttl, mt_tti, cnt_liq, cnt_ice	! added by roj Feb 2008
+
+    IMPLICIT NONE
+    
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------------- DERIVED TYPES ----------------------------    
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+  ! Configuration choices (simulators, variables)
+  TYPE COSP_CONFIG
+     logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, &
+                Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, &
+                Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, &
+                Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, &
+                Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
+                Lfrac_out,Lbeta_mol532,Ltbrttov
+     character(len=32) :: out_list(N_OUT_LIST)
+  END TYPE COSP_CONFIG
+  
+  ! Outputs from RTTOV
+  TYPE COSP_RTTOV
+     ! Dimensions
+     integer :: Npoints   ! Number of gridpoints
+     integer :: Nchan     ! Number of channels
+     
+     ! Brightness temperatures (Npoints,Nchan)
+     real,pointer :: tbs(:,:)
+     
+  END TYPE COSP_RTTOV
+  
+  ! Outputs from MISR simulator
+  TYPE COSP_MISR
+     ! Dimensions
+     integer :: Npoints   ! Number of gridpoints
+     integer :: Ntau      ! Number of tau intervals
+     integer :: Nlevels   ! Number of cth levels
+
+     ! --- (npoints,ntau,nlevels)
+     !  the fraction of the model grid box covered by each of the MISR cloud types
+     real,pointer :: fq_MISR(:,:,:)  
+     
+     ! --- (npoints)
+     real,pointer :: MISR_meanztop(:), MISR_cldarea(:)
+     ! --- (npoints,nlevels)
+     real,pointer :: MISR_dist_model_layertops(:,:)
+  END TYPE COSP_MISR
+
+  ! Outputs from ISCCP simulator
+  TYPE COSP_ISCCP
+     ! Dimensions
+     integer :: Npoints   ! Number of gridpoints
+     integer :: Ncolumns  ! Number of columns
+     integer :: Nlevels   ! Number of levels
+
+    
+     ! --- (npoints,tau=7,pressure=7)
+     !  the fraction of the model grid box covered by each of the 49 ISCCP D level cloud types
+     real,pointer :: fq_isccp(:,:,:)
+     
+     ! --- (npoints) ---
+     ! The fraction of model grid box columns with cloud somewhere in them.
+     ! This should equal the sum over all entries of fq_isccp
+     real,pointer :: totalcldarea(:)
+     ! mean all-sky 10.5 micron brightness temperature
+     real,pointer ::  meantb(:)
+     ! mean clear-sky 10.5 micron brightness temperature
+     real,pointer ::  meantbclr(:)
+     
+     ! The following three means are averages over the cloudy areas only.  If no
+     ! clouds are in grid box all three quantities should equal zero.
+     
+     !  mean cloud top pressure (mb) - linear averaging in cloud top pressure.
+     real,pointer :: meanptop(:)
+     !  mean optical thickness linear averaging in albedo performed.
+     real,pointer :: meantaucld(:)
+     ! mean cloud albedo. linear averaging in albedo performed 
+     real,pointer :: meanalbedocld(:)  
+     
+     !--- (npoints,ncol) ---
+     !  optical thickness in each column     
+     real,pointer :: boxtau(:,:)
+     !  cloud top pressure (mb) in each column
+     real,pointer :: boxptop(:,:)        
+  END TYPE COSP_ISCCP
+  
+  ! Summary statistics from radar
+  TYPE COSP_VGRID
+    logical :: use_vgrid ! Logical flag that indicates change of grid
+    logical :: csat_vgrid ! Flag for Cloudsat grid
+    integer :: Npoints   ! Number of sampled points
+    integer :: Ncolumns  ! Number of subgrid columns
+    integer :: Nlevels   ! Number of model levels
+    integer :: Nlvgrid   ! Number of levels of new grid
+    ! Array with dimensions (Nlvgrid)
+    real, dimension(:), pointer :: z,zl,zu ! Height and lower and upper boundaries of new levels
+    ! Array with dimensions (Nlevels)
+    real, dimension(:), pointer :: mz,mzl,mzu ! Height and lower and upper boundaries of model levels
+  END TYPE COSP_VGRID
+  
+  ! Output data from lidar code
+  TYPE COSP_SGLIDAR
+    ! Dimensions
+    integer :: Npoints   ! Number of gridpoints
+    integer :: Ncolumns  ! Number of columns
+    integer :: Nlevels   ! Number of levels
+    integer :: Nhydro    ! Number of hydrometeors    
+    integer :: Nrefl     ! Number of parasol reflectances
+    ! Arrays with dimensions (Npoints,Nlevels)
+    real,dimension(:,:),pointer :: beta_mol   ! Molecular backscatter
+    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
+    real,dimension(:,:,:),pointer :: beta_tot   ! Total backscattered signal
+    real,dimension(:,:,:),pointer :: tau_tot    ! Optical thickness integrated from top to level z
+    ! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
+    real,dimension(:,:,:),pointer :: refl       ! parasol reflectances
+  END TYPE COSP_SGLIDAR
+  
+  ! Output data from radar code
+  TYPE COSP_SGRADAR
+    ! Dimensions
+    integer :: Npoints   ! Number of gridpoints
+    integer :: Ncolumns  ! Number of columns
+    integer :: Nlevels   ! Number of levels
+    integer :: Nhydro    ! Number of hydrometeors
+    ! output vertical levels: spaceborne radar -> from TOA to SURFACE
+    ! Arrays with dimensions (Npoints,Nlevels)
+    real,dimension(:,:),pointer :: att_gas ! 2-way attenuation by gases [dBZ]
+    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
+    real,dimension(:,:,:),pointer :: Ze_tot ! Effective reflectivity factor [dBZ]
+ 
+  END TYPE COSP_SGRADAR
+
+  
+  ! Summary statistics from radar
+  TYPE COSP_RADARSTATS
+    integer :: Npoints  ! Number of sampled points
+    integer :: Ncolumns ! Number of subgrid columns
+    integer :: Nlevels  ! Number of model levels
+    integer :: Nhydro   ! Number of hydrometeors
+    ! Array with dimensions (Npoints,dBZe_bins,Nlevels)
+    real, dimension(:,:,:), pointer :: cfad_ze ! Ze CFAD
+    ! Array with dimensions (Npoints)
+    real,dimension(:),pointer :: radar_lidar_tcc ! Radar&lidar total cloud amount, grid-box scale
+    ! Arrays with dimensions (Npoints,Nlevels)
+    real, dimension(:,:),pointer :: lidar_only_freq_cloud
+  END TYPE COSP_RADARSTATS
+
+  ! Summary statistics from lidar
+  TYPE COSP_LIDARSTATS
+    integer :: Npoints  ! Number of sampled points
+    integer :: Ncolumns ! Number of subgrid columns
+    integer :: Nlevels  ! Number of model levels
+    integer :: Nhydro   ! Number of hydrometeors
+    integer :: Nrefl    ! Number of parasol reflectances
+    
+    ! Arrays with dimensions (SR_BINS)
+    real, dimension(:),pointer :: srbval ! SR bins in cfad_sr
+    ! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
+    real, dimension(:,:,:),pointer :: cfad_sr   ! CFAD of scattering ratio
+    ! Arrays with dimensions (Npoints,Nlevels)
+    real, dimension(:,:),pointer :: lidarcld    ! 3D "lidar" cloud fraction 
+    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
+    real, dimension(:,:),pointer :: cldlayer      ! low, mid, high-level lidar cloud cover
+    ! Arrays with dimensions (Npoints,PARASOL_NREFL)
+    real, dimension(:,:),pointer :: parasolrefl   ! mean parasol reflectance
+
+  END TYPE COSP_LIDARSTATS
+
+    
+  ! Input data for simulator. Subgrid scale.
+  ! Input data from SURFACE to TOA
+  TYPE COSP_SUBGRID
+    ! Dimensions
+    integer :: Npoints   ! Number of gridpoints
+    integer :: Ncolumns  ! Number of columns
+    integer :: Nlevels   ! Number of levels
+    integer :: Nhydro    ! Number of hydrometeors
+    
+    real,dimension(:,:,:),pointer :: prec_frac  ! Subgrid precip array. Dimensions (Npoints,Ncolumns,Nlevels)
+    real,dimension(:,:,:),pointer :: frac_out  ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
+  END TYPE COSP_SUBGRID
+
+  ! Input data for simulator at Subgrid scale.
+  ! Used on a reduced number of points
+  TYPE COSP_SGHYDRO
+    ! Dimensions
+    integer :: Npoints   ! Number of gridpoints
+    integer :: Ncolumns  ! Number of columns
+    integer :: Nlevels   ! Number of levels
+    integer :: Nhydro    ! Number of hydrometeors
+    real,dimension(:,:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor 
+                                                ! (Npoints,Ncolumns,Nlevels,Nhydro) [kg/kg]
+    real,dimension(:,:,:,:),pointer :: Reff     ! Effective Radius of each hydrometeor
+                                                ! (Reff==0 means use default size)   
+                                                ! (Npoints,Ncolumns,Nlevels,Nhydro) [m]
+  END TYPE COSP_SGHYDRO
+  
+  ! Input data for simulator. Gridbox scale.
+  TYPE COSP_GRIDBOX
+    ! Scalars and dimensions
+    integer :: Npoints   ! Number of gridpoints
+    integer :: Nlevels   ! Number of levels
+    integer :: Ncolumns  ! Number of columns
+    integer :: Nhydro    ! Number of hydrometeors
+    integer :: Nprmts_max_hydro    ! Max number of parameters for hydrometeor size distributions
+    integer :: Naero    ! Number of aerosol species
+    integer :: Nprmts_max_aero    ! Max number of parameters for aerosol size distributions
+    integer :: Npoints_it   ! Max number of gridpoints to be processed in one iteration
+    
+    ! Time [days]
+    double precision :: time
+    
+    ! Radar ancillary info
+    real :: radar_freq, & ! Radar frequency [GHz]
+            k2 ! |K|^2, -1=use frequency dependent default
+    integer :: surface_radar, & ! surface=1, spaceborne=0
+	       use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0
+	       use_gas_abs, & ! include gaseous absorption? yes=1,no=0
+	       do_ray, & ! calculate/output Rayleigh refl=1, not=0
+	       melt_lay ! melting layer model off=0, on=1
+ 
+    ! structures used by radar simulator that need to be set only ONCE per radar configuration (e.g. freq, pointing direction) ... added by roj Feb 2008
+    type(class_param) ::  hp	! structure used by radar simulator to store Ze and N scaling constants and other information
+    type(mie)::  mt		! structure used by radar simulator to store mie LUT information
+    integer :: nsizes 		! number of discrete drop sizes (um) used to represent the distribution
+    real*8, dimension(:), pointer :: D ! array of discrete drop sizes (um) used to represent the distribution
+    real*8, dimension(:), pointer :: mt_ttl, mt_tti ! array of temperatures used with Ze_scaling (also build into mie LUT)
+    
+    ! Lidar
+    integer :: lidar_ice_type !ice particle shape hypothesis in lidar calculations 
+                              !(ice_type=0 for spheres, ice_type=1 for non spherical particles)
+    
+    ! Radar
+    logical ::  use_precipitation_fluxes  ! True if precipitation fluxes are input to the algorithm 
+    logical ::  use_reff  ! True if Reff is to be used by radar 
+    
+    ! Geolocation (Npoints)
+    real,dimension(:),pointer :: longitude ! longitude [degrees East]
+    real,dimension(:),pointer :: latitude  ! latitude [deg North]
+    ! Gridbox information (Npoints,Nlevels)
+    real,dimension(:,:),pointer :: zlev ! Height of model levels [m]
+    real,dimension(:,:),pointer :: zlev_half ! Height at half model levels [m] (Bottom of model layer)
+    real,dimension(:,:),pointer :: dlev ! Depth of model levels  [m]
+    real,dimension(:,:),pointer :: p  ! Pressure at full model levels [Pa]
+    real,dimension(:,:),pointer :: ph ! Pressure at half model levels [Pa]
+    real,dimension(:,:),pointer :: T ! Temperature at model levels [K]
+    real,dimension(:,:),pointer :: q  ! Relative humidity to water (%)
+    real,dimension(:,:),pointer :: sh ! Specific humidity to water [kg/kg]
+    real,dimension(:,:),pointer :: dtau_s ! mean 0.67 micron optical depth of stratiform
+                                          !  clouds in each model level
+                                          !  NOTE:  this the cloud optical depth of only the
+                                          !  cloudy part of the grid box, it is not weighted
+                                          !  with the 0 cloud optical depth of the clear
+                                          !         part of the grid box
+    real,dimension(:,:),pointer :: dtau_c !  mean 0.67 micron optical depth of convective
+                                          !  clouds in each model level.  Same note applies as in dtau_s.
+    real,dimension(:,:),pointer :: dem_s  !  10.5 micron longwave emissivity of stratiform
+                                          !  clouds in each model level.  Same note applies as in dtau_s.
+    real,dimension(:,:),pointer :: dem_c  !  10.5 micron longwave emissivity of convective
+                                          !  clouds in each model level.  Same note applies as in dtau_s.
+    real,dimension(:,:),pointer :: mr_ozone !  Ozone mass mixing ratio [kg/kg]
+
+    ! Point information (Npoints)
+    real,dimension(:),pointer :: land !Landmask [0 - Ocean, 1 - Land]
+    real,dimension(:),pointer :: psfc !Surface pressure [Pa]
+    real,dimension(:),pointer :: sunlit ! (npoints) 1 for day points, 0 for nightime
+    real,dimension(:),pointer :: skt  ! Skin temperature (K)
+    real,dimension(:),pointer :: sfc_height  ! Surface height [m]
+    real,dimension(:),pointer :: u_wind  ! eastward wind [m s-1]
+    real,dimension(:),pointer :: v_wind  ! northward wind [m s-1]
+
+    ! TOTAL and CONV cloud fraction for SCOPS
+    real,dimension(:,:),pointer :: tca ! Total cloud fraction
+    real,dimension(:,:),pointer :: cca ! Convective cloud fraction
+    ! Precipitation fluxes on model levels
+    real,dimension(:,:),pointer :: rain_ls ! large-scale precipitation flux of rain [kg/m2.s]
+    real,dimension(:,:),pointer :: rain_cv ! convective precipitation flux of rain [kg/m2.s]
+    real,dimension(:,:),pointer :: snow_ls ! large-scale precipitation flux of snow [kg/m2.s]
+    real,dimension(:,:),pointer :: snow_cv ! convective precipitation flux of snow [kg/m2.s]
+    real,dimension(:,:),pointer :: grpl_ls ! large-scale precipitation flux of graupel [kg/m2.s]
+    ! Hydrometeors concentration and distribution parameters
+!     real,dimension(:,:,:),pointer :: fr_hydro ! Fraction of the gridbox occupied by each hydrometeor (Npoints,Nlevels,Nhydro)
+    real,dimension(:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor (Npoints,Nlevels,Nhydro) [kg/kg]
+    real,dimension(:,:),pointer   :: dist_prmts_hydro !Distributional parameters for hydrometeors (Nprmts_max_hydro,Nhydro)
+    ! Effective radius [m]. (Npoints,Nlevels,Nhydro)
+    real,dimension(:,:,:),pointer :: Reff
+    ! Aerosols concentration and distribution parameters
+    real,dimension(:,:,:),pointer :: conc_aero ! Aerosol concentration for each species (Npoints,Nlevels,Naero)
+    integer,dimension(:),pointer :: dist_type_aero ! Particle size distribution type for each aerosol species (Naero)
+    real,dimension(:,:,:,:),pointer :: dist_prmts_aero ! Distributional parameters for aerosols 
+                                                       ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
+    ! ISCCP simulator inputs
+    integer :: isccp_top_height !  1 = adjust top height using both a computed
+                                !  infrared brightness temperature and the visible
+                                !  optical depth to adjust cloud top pressure. Note
+                                !  that this calculation is most appropriate to compare
+                                !  to ISCCP data during sunlit hours.
+                                !  2 = do not adjust top height, that is cloud top
+                                !  pressure is the actual cloud top pressure
+                                !  in the model
+                                !  3 = adjust top height using only the computed
+                                !  infrared brightness temperature. Note that this
+                                !  calculation is most appropriate to compare to ISCCP
+                                !  IR only algortihm (i.e. you can compare to nighttime
+                                !  ISCCP data with this option)
+    integer :: isccp_top_height_direction ! direction for finding atmosphere pressure level
+                                 ! with interpolated temperature equal to the radiance
+                                 ! determined cloud-top temperature
+                                 ! 1 = find the *lowest* altitude (highest pressure) level
+                                 ! with interpolated temperature equal to the radiance
+                                 ! determined cloud-top temperature
+                                 ! 2 = find the *highest* altitude (lowest pressure) level
+                                 ! with interpolated temperature equal to the radiance 
+                                 ! determined cloud-top temperature
+                                 ! ONLY APPLICABLE IF top_height EQUALS 1 or 3
+                                 ! 1 = default setting, and matches all versions of 
+                                 ! ISCCP simulator with versions numbers 3.5.1 and lower
+                                 ! 2 = experimental setting  
+    integer :: isccp_overlap !  overlap type (1=max, 2=rand, 3=max/rand)
+    real :: isccp_emsfc_lw      ! 10.5 micron emissivity of surface (fraction)
+  
+    ! RTTOV inputs/options
+    integer :: plat      ! satellite platform
+    integer :: sat       ! satellite
+    integer :: inst      ! instrument
+    integer :: Nchan     ! Number of channels to be computed
+    integer, dimension(:), pointer :: Ichan   ! Channel numbers
+    real,    dimension(:), pointer :: Surfem  ! Surface emissivity
+    real    :: ZenAng ! Satellite Zenith Angles
+    real :: co2,ch4,n2o,co ! Mixing ratios of trace gases
+
+  END TYPE COSP_GRIDBOX
+ 
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_RTTOV -------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x)
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Nchan ! Number of channels
+    type(cosp_rttov),intent(out) :: x
+    
+    ! Dimensions
+    x%Npoints  = Npoints
+    x%Nchan    = Nchan
+      
+    ! --- Allocate arrays ---
+    allocate(x%tbs(Npoints, Nchan))
+    ! --- Initialise to zero ---
+    x%tbs     = 0.0
+  END SUBROUTINE CONSTRUCT_COSP_RTTOV
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_RTTOV ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_RTTOV(x)
+    type(cosp_rttov),intent(inout) :: x
+    
+    ! --- Deallocate arrays ---
+    deallocate(x%tbs)
+  END SUBROUTINE FREE_COSP_RTTOV
+  
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_MISR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_MISR(cfg,Npoints,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints   ! Number of gridpoints
+    type(cosp_misr),intent(out) :: x
+    ! Local variables
+    integer :: i,j,k
+    
+   
+    ! Allocate minumum storage if simulator not used
+    if (cfg%Lmisr_sim) then
+      i = Npoints
+      j = 7
+      k = MISR_N_CTH
+    else
+      i = 1
+      j = 1
+      k = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints = i
+    x%Ntau    = j
+    x%Nlevels = k
+    
+    ! allocate space for MISR simulator outputs ...
+    allocate(x%fq_MISR(i,j,k), x%MISR_meanztop(i),x%MISR_cldarea(i), x%MISR_dist_model_layertops(i,k))
+    x%fq_MISR = 0.0
+    x%MISR_meanztop = 0.0
+    x%MISR_cldarea = 0.0
+    x%MISR_dist_model_layertops = 0.0
+    
+  END SUBROUTINE CONSTRUCT_COSP_MISR
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_MISR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_MISR(x)
+    type(cosp_misr),intent(inout) :: x
+    deallocate(x%fq_MISR, x%MISR_meanztop,x%MISR_cldarea, x%MISR_dist_model_layertops)
+    
+  END SUBROUTINE FREE_COSP_MISR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_ISCCP ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_ISCCP(cfg,Npoints,Ncolumns,Nlevels,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Ncolumns ! Number of subgrid columns
+    integer,intent(in) :: Nlevels  ! Number of model levels
+    type(cosp_isccp),intent(out) :: x
+    ! Local variables
+    integer :: i,j,k
+    
+    ! Allocate minumum storage if simulator not used
+    if (cfg%Lisccp_sim) then
+      i = Npoints
+      j = Ncolumns
+      k = Nlevels
+    else
+      i = 1
+      j = 1
+      k = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints  = i
+    x%Ncolumns = j
+    x%Nlevels  = k
+    
+    ! --- Allocate arrays ---
+    allocate(x%fq_isccp(i,7,7), x%totalcldarea(i), &
+         x%meanptop(i), x%meantaucld(i), &
+         x%meantb(i), x%meantbclr(i), &
+         x%boxtau(i,j), x%boxptop(i,j), &
+         x%meanalbedocld(i))
+    ! --- Initialise to zero ---
+    x%fq_isccp     = 0.0
+    x%totalcldarea = 0.0
+    x%meanptop     = 0.0
+    x%meantaucld   = 0.0
+    x%meantb       = 0.0
+    x%meantbclr    = 0.0
+    x%boxtau       = 0.0
+    x%boxptop      = 0.0
+    x%meanalbedocld= 0.0
+  END SUBROUTINE CONSTRUCT_COSP_ISCCP
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_ISCCP -----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_ISCCP(x)
+    type(cosp_isccp),intent(inout) :: x
+    
+    deallocate(x%fq_isccp, x%totalcldarea, &
+         x%meanptop, x%meantaucld, x%meantb, x%meantbclr, &
+         x%boxtau, x%boxptop, x%meanalbedocld)
+  END SUBROUTINE FREE_COSP_ISCCP
+  
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_VGRID ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_VGRID(gbx,Nlvgrid,use_vgrid,cloudsat,x)
+    type(cosp_gridbox),intent(in) :: gbx ! Gridbox information
+    integer,intent(in) :: Nlvgrid  ! Number of new levels    
+    logical,intent(in) :: use_vgrid! Logical flag that controls the output on a different grid
+    logical,intent(in) :: cloudsat ! TRUE if a CloudSat like grid (480m) is requested
+    type(cosp_vgrid),intent(out) :: x
+    
+    ! Local variables
+    integer :: i
+    real :: zstep
+    
+    x%use_vgrid  = use_vgrid
+    x%csat_vgrid = cloudsat
+    
+    ! Dimensions
+    x%Npoints  = gbx%Npoints
+    x%Ncolumns = gbx%Ncolumns
+    x%Nlevels  = gbx%Nlevels
+    
+    ! --- Allocate arrays ---
+    if (use_vgrid) then
+      x%Nlvgrid = Nlvgrid
+    else 
+      x%Nlvgrid = gbx%Nlevels
+    endif
+    allocate(x%z(x%Nlvgrid),x%zl(x%Nlvgrid),x%zu(x%Nlvgrid))
+    allocate(x%mz(x%Nlevels),x%mzl(x%Nlevels),x%mzu(x%Nlevels))
+    
+    ! --- Model vertical levels ---
+    ! Use height levels of first model gridbox
+    x%mz  = gbx%zlev(1,:)
+    x%mzl = gbx%zlev_half(1,:)
+    x%mzu(1:x%Nlevels-1) = gbx%zlev_half(1,2:x%Nlevels)
+    x%mzu(x%Nlevels) = gbx%zlev(1,x%Nlevels) + (gbx%zlev(1,x%Nlevels) - x%mzl(x%Nlevels))
+    
+    if (use_vgrid) then
+      ! --- Initialise to zero ---
+      x%z  = 0.0
+      x%zl = 0.0
+      x%zu = 0.0
+      if (cloudsat) then ! --- CloudSat grid requested ---
+         zstep = 480.0
+      else
+         ! Other grid requested. Constant vertical spacing with top at 20 km
+         zstep = 20000.0/x%Nlvgrid
+      endif
+      do i=1,x%Nlvgrid
+         x%zl(i) = (i-1)*zstep
+         x%zu(i) = i*zstep
+      enddo
+      x%z = (x%zl + x%zu)/2.0
+    else
+      x%z  = x%mz
+      x%zl = x%mzl
+      x%zu = x%mzu
+    endif
+    
+  END SUBROUTINE CONSTRUCT_COSP_VGRID
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------ SUBROUTINE FREE_COSP_VGRID ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_VGRID(x)
+    type(cosp_vgrid),intent(inout) :: x
+
+    deallocate(x%z, x%zl, x%zu, x%mz, x%mzl, x%mzu)
+  END SUBROUTINE FREE_COSP_VGRID
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_SGLIDAR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_SGLIDAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Ncolumns ! Number of subgrid columns
+    integer,intent(in) :: Nlevels  ! Number of model levels
+    integer,intent(in) :: Nhydro   ! Number of hydrometeors
+    integer,intent(in) :: Nrefl    ! Number of parasol reflectances ! parasol
+    type(cosp_sglidar),intent(out) :: x
+    ! Local variables
+    integer :: i,j,k,l,m
+    
+    ! Allocate minumum storage if simulator not used
+    if (cfg%Llidar_sim) then
+      i = Npoints
+      j = Ncolumns
+      k = Nlevels
+      l = Nhydro
+      m = Nrefl
+    else
+      i = 1
+      j = 1
+      k = 1
+      l = 1
+      m = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints  = i
+    x%Ncolumns = j
+    x%Nlevels  = k
+    x%Nhydro   = l
+    x%Nrefl    = m
+    
+    ! --- Allocate arrays ---
+    allocate(x%beta_mol(i,k), x%beta_tot(i,j,k), &
+             x%tau_tot(i,j,k),x%refl(i,j,m))
+    ! --- Initialise to zero ---
+    x%beta_mol   = 0.0
+    x%beta_tot   = 0.0
+    x%tau_tot    = 0.0
+    x%refl       = 0.0 ! parasol
+  END SUBROUTINE CONSTRUCT_COSP_SGLIDAR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------ SUBROUTINE FREE_COSP_SGLIDAR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_SGLIDAR(x)
+    type(cosp_sglidar),intent(inout) :: x
+
+    deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl)
+  END SUBROUTINE FREE_COSP_SGLIDAR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_SGRADAR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_SGRADAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Ncolumns ! Number of subgrid columns
+    integer,intent(in) :: Nlevels  ! Number of model levels
+    integer,intent(in) :: Nhydro   ! Number of hydrometeors
+    type(cosp_sgradar),intent(out) :: x
+    ! Local variables
+    integer :: i,j,k,l
+    
+    if (cfg%Lradar_sim) then
+      i = Npoints
+      j = Ncolumns
+      k = Nlevels
+      l = Nhydro
+    else ! Allocate minumum storage if simulator not used
+      i = 1
+      j = 1
+      k = 1
+      l = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints  = i
+    x%Ncolumns = j
+    x%Nlevels  = k
+    x%Nhydro   = l
+    
+    ! --- Allocate arrays ---
+    allocate(x%att_gas(i,k), x%Ze_tot(i,j,k))
+    ! --- Initialise to zero ---
+    x%att_gas   = 0.0
+    x%Ze_tot    = 0.0
+    ! The following line give a compilation error on the Met Office NEC
+!     call zero_real(x%Z_hydro, x%att_hydro)
+!     f90: error(666): cosp_types.f90, line nnn:
+!                                        Actual argument corresponding to dummy
+!                                        argument of ELEMENTAL subroutine
+!                                        "zero_real" with INTENET(OUT) attribute
+!                                        is not array.
+  END SUBROUTINE CONSTRUCT_COSP_SGRADAR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------ SUBROUTINE FREE_COSP_SGRADAR ----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_SGRADAR(x)
+    type(cosp_sgradar),intent(inout) :: x
+
+    deallocate(x%att_gas, x%Ze_tot)
+  END SUBROUTINE FREE_COSP_SGRADAR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------- SUBROUTINE CONSTRUCT_COSP_RADARSTATS ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_RADARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Ncolumns ! Number of subgrid columns
+    integer,intent(in) :: Nlevels  ! Number of model levels
+    integer,intent(in) :: Nhydro   ! Number of hydrometeors
+    type(cosp_radarstats),intent(out) :: x    
+    ! Local variables
+    integer :: i,j,k,l
+    
+    ! Allocate minumum storage if simulator not used
+    if (cfg%Lradar_sim) then
+      i = Npoints
+      j = Ncolumns
+      k = Nlevels
+      l = Nhydro
+    else
+      i = 1
+      j = 1
+      k = 1
+      l = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints  = i
+    x%Ncolumns = j
+    x%Nlevels  = k
+    x%Nhydro   = l
+    
+    ! --- Allocate arrays ---
+    allocate(x%cfad_ze(i,DBZE_BINS,k),x%lidar_only_freq_cloud(i,k))
+    allocate(x%radar_lidar_tcc(i))
+    ! --- Initialise to zero ---
+    x%cfad_ze = 0.0
+    x%lidar_only_freq_cloud = 0.0
+    x%radar_lidar_tcc = 0.0
+  END SUBROUTINE CONSTRUCT_COSP_RADARSTATS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------ SUBROUTINE FREE_COSP_RADARSTATS -------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_RADARSTATS(x)
+    type(cosp_radarstats),intent(inout) :: x
+
+    deallocate(x%cfad_ze,x%lidar_only_freq_cloud,x%radar_lidar_tcc)
+  END SUBROUTINE FREE_COSP_RADARSTATS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------- SUBROUTINE CONSTRUCT_COSP_LIDARSTATS ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_LIDARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
+    type(cosp_config),intent(in) :: cfg ! Configuration options
+    integer,intent(in) :: Npoints  ! Number of sampled points
+    integer,intent(in) :: Ncolumns ! Number of subgrid columns
+    integer,intent(in) :: Nlevels  ! Number of model levels
+    integer,intent(in) :: Nhydro   ! Number of hydrometeors
+    integer,intent(in) :: Nrefl    ! Number of parasol reflectance
+    type(cosp_lidarstats),intent(out) :: x
+    ! Local variables
+    integer :: i,j,k,l,m
+    
+    ! Allocate minumum storage if simulator not used
+    if (cfg%Llidar_sim) then
+      i = Npoints
+      j = Ncolumns
+      k = Nlevels
+      l = Nhydro
+      m = Nrefl
+    else
+      i = 1
+      j = 1
+      k = 1
+      l = 1
+      m = 1
+    endif
+    
+    ! Dimensions
+    x%Npoints  = i
+    x%Ncolumns = j
+    x%Nlevels  = k
+    x%Nhydro   = l
+    x%Nrefl    = m
+    
+    ! --- Allocate arrays ---
+    allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), & 
+             x%lidarcld(i,k), x%cldlayer(i,LIDAR_NCAT), x%parasolrefl(i,m))
+    ! --- Initialise to zero ---
+    x%srbval    = 0.0
+    x%cfad_sr   = 0.0
+    x%lidarcld  = 0.0
+    x%cldlayer  = 0.0
+    x%parasolrefl  = 0.0
+  END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------ SUBROUTINE FREE_COSP_LIDARSTATS -------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_LIDARSTATS(x)
+    type(cosp_lidarstats),intent(inout) :: x
+
+    deallocate(x%srbval, x%cfad_sr, x%lidarcld, x%cldlayer, x%parasolrefl)
+  END SUBROUTINE FREE_COSP_LIDARSTATS
+ 
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_SUBGRID ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_SUBGRID(Npoints,Ncolumns,Nlevels,y)
+    integer,intent(in) :: Npoints, & ! Number of gridpoints
+                                        Ncolumns, & ! Number of columns
+                                        Nlevels   ! Number of levels
+    type(cosp_subgrid),intent(out) :: y
+    
+    ! Dimensions
+    y%Npoints  = Npoints
+    y%Ncolumns = Ncolumns
+    y%Nlevels  = Nlevels
+
+    ! --- Allocate arrays ---
+    allocate(y%frac_out(Npoints,Ncolumns,Nlevels))
+    if (Ncolumns > 1) then
+      allocate(y%prec_frac(Npoints,Ncolumns,Nlevels))
+    else ! CRM mode, not needed
+      allocate(y%prec_frac(1,1,1))
+    endif
+    ! --- Initialise to zero ---
+    y%prec_frac = 0.0
+    y%frac_out  = 0.0
+    ! The following line gives a compilation error on the Met Office NEC
+!     call zero_real(y%mr_hydro)
+!     f90: error(666): cosp_types.f90, line nnn:
+!                                        Actual argument corresponding to dummy
+!                                        argument of ELEMENTAL subroutine
+!                                        "zero_real" with INTENET(OUT) attribute
+!                                        is not array.
+
+  END SUBROUTINE CONSTRUCT_COSP_SUBGRID
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_SUBGRID -----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_SUBGRID(y)
+    type(cosp_subgrid),intent(inout) :: y
+    
+    ! --- Deallocate arrays ---
+    deallocate(y%prec_frac, y%frac_out)
+        
+  END SUBROUTINE FREE_COSP_SUBGRID
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_SGHYDRO -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_SGHYDRO(Npoints,Ncolumns,Nlevels,Nhydro,y)
+    integer,intent(in) :: Npoints, & ! Number of gridpoints
+                                        Ncolumns, & ! Number of columns
+                                        Nhydro, & ! Number of hydrometeors
+                                        Nlevels   ! Number of levels
+    type(cosp_sghydro),intent(out) :: y
+    
+    ! Dimensions
+    y%Npoints  = Npoints
+    y%Ncolumns = Ncolumns
+    y%Nlevels  = Nlevels
+    y%Nhydro   = Nhydro
+
+    ! --- Allocate arrays ---
+    allocate(y%mr_hydro(Npoints,Ncolumns,Nlevels,Nhydro), &
+             y%Reff(Npoints,Ncolumns,Nlevels,Nhydro))
+    ! --- Initialise to zero ---
+    y%mr_hydro = 0.0
+    y%Reff     = 0.0
+
+  END SUBROUTINE CONSTRUCT_COSP_SGHYDRO
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_SGHYDRO -----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_SGHYDRO(y)
+    type(cosp_sghydro),intent(inout) :: y
+    
+    ! --- Deallocate arrays ---
+    deallocate(y%mr_hydro, y%Reff)
+        
+  END SUBROUTINE FREE_COSP_SGHYDRO
+ 
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE CONSTRUCT_COSP_GRIDBOX ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time,radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
+                                   Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, & 
+                                   lidar_ice_type,isccp_top_height,isccp_top_height_direction,isccp_overlap,isccp_emsfc_lw, &
+                                   use_precipitation_fluxes,use_reff, &
+                                   ! RTTOV inputs
+                                   Plat,Sat,Inst,Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,&
+                                   y)
+    double precision,intent(in) :: time ! Time since start of run [days] 
+    real,intent(in)    :: radar_freq, & ! Radar frequency [GHz]
+                          k2            ! |K|^2, -1=use frequency dependent default
+    integer,intent(in) :: &
+        surface_radar, &  ! surface=1,spaceborne=0
+        use_mie_tables, & ! use a precomputed lookup table? yes=1,no=0,2=use first column everywhere
+        use_gas_abs, &    ! include gaseous absorption? yes=1,no=0
+        do_ray, &         ! calculate/output Rayleigh refl=1, not=0
+        melt_lay          ! melting layer model off=0, on=1
+    integer,intent(in) :: Npoints   ! Number of gridpoints
+    integer,intent(in) :: Nlevels   ! Number of levels
+    integer,intent(in) :: Ncolumns  ! Number of columns
+    integer,intent(in) :: Nhydro    ! Number of hydrometeors
+    integer,intent(in) :: Nprmts_max_hydro    ! Max number of parameters for hydrometeor size distributions
+    integer,intent(in) :: Naero    ! Number of aerosol species
+    integer,intent(in) :: Nprmts_max_aero    ! Max number of parameters for aerosol size distributions
+    integer,intent(in) :: Npoints_it   ! Number of gridpoints processed in one iteration
+    integer,intent(in) :: lidar_ice_type ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical)
+    integer,intent(in) :: isccp_top_height
+    integer,intent(in) :: isccp_top_height_direction
+    integer,intent(in) :: isccp_overlap
+    real,intent(in)    :: isccp_emsfc_lw
+    logical,intent(in) :: use_precipitation_fluxes,use_reff
+    integer,intent(in) :: Plat
+    integer,intent(in) :: Sat
+    integer,intent(in) :: Inst
+    integer,intent(in) :: Nchan
+    integer,intent(in) :: Ichan(Nchan)
+    real,intent(in)    :: SurfEm(Nchan)
+    real,intent(in)    :: ZenAng
+    real,intent(in)    :: co2,ch4,n2o,co
+    type(cosp_gridbox),intent(out) :: y
+
+        
+    ! local variables
+    integer i, cnt_ice, cnt_liq
+    character*200 :: mie_table_name ! Mie table name  
+    real*8  :: delt, deltp
+ 
+    ! Dimensions and scalars
+    y%radar_freq       = radar_freq
+    y%surface_radar    = surface_radar
+    y%use_mie_tables   = use_mie_tables
+    y%use_gas_abs      = use_gas_abs
+    y%do_ray           = do_ray
+    y%melt_lay         = melt_lay
+    y%k2               = k2
+    y%Npoints          = Npoints
+    y%Nlevels          = Nlevels
+    y%Ncolumns         = Ncolumns
+    y%Nhydro           = Nhydro
+    y%Nprmts_max_hydro = Nprmts_max_hydro
+    y%Naero            = Naero
+    y%Nprmts_max_aero  = Nprmts_max_aero
+    y%Npoints_it       = Npoints_it
+    y%lidar_ice_type   = lidar_ice_type
+    y%isccp_top_height = isccp_top_height
+    y%isccp_top_height_direction = isccp_top_height_direction
+    y%isccp_overlap    = isccp_overlap
+    y%isccp_emsfc_lw   = isccp_emsfc_lw
+    y%use_precipitation_fluxes = use_precipitation_fluxes
+    y%use_reff = use_reff
+    
+    y%time = time
+    
+    ! RTTOV parameters
+    y%Plat   = Plat
+    y%Sat    = Sat
+    y%Inst   = Inst
+    y%Nchan  = Nchan
+    y%ZenAng = ZenAng
+    y%co2    = co2
+    y%ch4    = ch4
+    y%n2o    = n2o
+    y%co     = co
+
+    ! --- Allocate arrays ---
+    ! Gridbox information (Npoints,Nlevels)
+    allocate(y%zlev(Npoints,Nlevels), y%zlev_half(Npoints,Nlevels), y%dlev(Npoints,Nlevels), &
+             y%p(Npoints,Nlevels), y%ph(Npoints,Nlevels), y%T(Npoints,Nlevels), &
+             y%q(Npoints,Nlevels), y%sh(Npoints,Nlevels), &
+             y%dtau_s(Npoints,Nlevels), y%dtau_c(Npoints,Nlevels), &
+             y%dem_s(Npoints,Nlevels), y%dem_c(Npoints,Nlevels), &
+             y%tca(Npoints,Nlevels), y%cca(Npoints,Nlevels), &
+             y%rain_ls(Npoints,Nlevels), y%rain_cv(Npoints,Nlevels), y%grpl_ls(Npoints,Nlevels), &
+             y%snow_ls(Npoints,Nlevels), y%snow_cv(Npoints,Nlevels),y%mr_ozone(Npoints,Nlevels))
+             
+             
+    ! Surface information and geolocation (Npoints)
+    allocate(y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), &
+             y%sunlit(Npoints),y%skt(Npoints),y%sfc_height(Npoints),y%u_wind(Npoints),y%v_wind(Npoints))
+    ! Hydrometeors concentration and distribution parameters
+    allocate(y%mr_hydro(Npoints,Nlevels,Nhydro), &
+             y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro), &
+             y%Reff(Npoints,Nlevels,Nhydro))
+    ! Aerosols concentration and distribution parameters
+    allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), &
+             y%dist_prmts_aero(Npoints,Nlevels,Nprmts_max_aero,Naero))
+    
+    ! RTTOV channels and sfc. emissivity
+    allocate(y%ichan(Nchan),y%surfem(Nchan))
+    
+    ! RTTOV parameters
+    y%ichan   =  ichan
+    y%surfem  =  surfem
+    
+    ! --- Initialise to zero ---
+    y%zlev      = 0.0
+    y%zlev_half = 0.0
+    y%dlev      = 0.0
+    y%p         = 0.0
+    y%ph        = 0.0
+    y%T         = 0.0
+    y%q         = 0.0
+    y%sh        = 0.0
+    y%dtau_s    = 0.0
+    y%dtau_c    = 0.0
+    y%dem_s     = 0.0
+    y%dem_c     = 0.0
+    y%tca       = 0.0
+    y%cca       = 0.0
+    y%rain_ls   = 0.0
+    y%rain_cv   = 0.0
+    y%grpl_ls   = 0.0
+    y%snow_ls   = 0.0
+    y%snow_cv   = 0.0
+    y%Reff      = 0.0
+    y%mr_ozone  = 0.0
+    y%u_wind    = 0.0
+    y%v_wind    = 0.0
+
+    
+    ! (Npoints)
+!     call zero_real(y%psfc, y%land)
+    y%longitude = 0.0
+    y%latitude = 0.0
+    y%psfc = 0.0
+    y%land = 0.0
+    y%sunlit = 0.0
+    y%skt = 0.0
+    y%sfc_height = 0.0
+    ! (Npoints,Nlevels,Nhydro)
+!     y%fr_hydro = 0.0
+    y%mr_hydro = 0.0
+    ! Others
+    y%dist_prmts_hydro = 0.0 ! (Nprmts_max_hydro,Nhydro)
+    y%conc_aero        = 0.0 ! (Npoints,Nlevels,Naero)
+    y%dist_type_aero   = 0   ! (Naero)
+    y%dist_prmts_aero  = 0.0 ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
+
+    y%hp%p1 = 0.0
+    y%hp%p2 = 0.0
+    y%hp%p3 = 0.0
+    y%hp%dmin = 0.0
+    y%hp%dmax = 0.0
+    y%hp%apm = 0.0
+    y%hp%bpm = 0.0
+    y%hp%rho = 0.0
+    y%hp%dtype = 0
+    y%hp%col = 0
+    y%hp%cp = 0
+    y%hp%phase = 0
+    y%hp%scaled = .false.
+    y%hp%z_flag = .false.
+    y%hp%Ze_scaled = 0.0
+    y%hp%Zr_scaled = 0.0
+    y%hp%kr_scaled = 0.0
+    y%hp%fc = 0.0
+    y%hp%rho_eff = 0.0
+    y%hp%ifc = 0
+    y%hp%idd = 0
+    y%mt%freq = 0.0
+    y%mt%tt = 0.0
+    y%mt%f = 0.0
+    y%mt%D = 0.0
+    y%mt%qext = 0.0
+    y%mt%qbsca = 0.0
+    y%mt%phase = 0
+    
+    
+    ! --- Initialize the distributional parameters for hydrometeors
+    y%dist_prmts_hydro( 1,:) = HCLASS_TYPE(:)
+    y%dist_prmts_hydro( 2,:) = HCLASS_COL(:)
+    y%dist_prmts_hydro( 3,:) = HCLASS_PHASE(:)
+    y%dist_prmts_hydro( 4,:) = HCLASS_CP(:)
+    y%dist_prmts_hydro( 5,:) = HCLASS_DMIN(:)
+    y%dist_prmts_hydro( 6,:) = HCLASS_DMAX(:)
+    y%dist_prmts_hydro( 7,:) = HCLASS_APM(:)
+    y%dist_prmts_hydro( 8,:) = HCLASS_BPM(:)
+    y%dist_prmts_hydro( 9,:) = HCLASS_RHO(:)
+    y%dist_prmts_hydro(10,:) = HCLASS_P1(:)
+    y%dist_prmts_hydro(11,:) = HCLASS_P2(:)
+    y%dist_prmts_hydro(12,:) = HCLASS_P3(:)
+
+    ! the following code added by roj to initialize structures used by radar simulator, Feb 2008
+    call load_hydrometeor_classes(y%Nprmts_max_hydro,y%dist_prmts_hydro(:,:),y%hp,y%Nhydro)
+
+    ! load mie tables ?
+    if (y%use_mie_tables == 1) then
+
+        ! ----- Mie tables ----
+  	    mie_table_name='mie_table.dat'
+        call load_mie_table(mie_table_name,y%mt)
+	
+	    !   :: D specified by table ... not must match that used when mie LUT generated!
+    	y%nsizes = mt_nd
+    	allocate(y%D(y%nsizes))
+    	y%D = y%mt%D
+
+    else
+	   ! otherwise we still need to initialize temperature arrays for Ze scaling (which is only done when not using mie table)
+	   
+	   cnt_ice=19
+	   cnt_liq=20
+       if (.not.(allocated(mt_ttl).and.allocated(mt_tti))) then
+          allocate(mt_ttl(cnt_liq),mt_tti(cnt_ice))  ! note needed as this is global array ... 
+                                                     ! which should be changed in the future
+       endif
+		  
+	   do i=1,cnt_ice
+		  mt_tti(i)=(i-1)*5-90
+	   enddo
+    
+	   do i=1,cnt_liq
+		  mt_ttl(i)=(i-1)*5 - 60
+	   enddo 
+    
+	   allocate(y%mt_ttl(cnt_liq),y%mt_tti(cnt_ice))
+
+       y%mt_ttl = mt_ttl
+       y%mt_tti = mt_tti
+
+! !------ OLD code in v0.1 ---------------------------
+!        allocate(mt_ttl(2),mt_tti(2))
+!        allocate(y%mt_ttl(2),y%mt_tti(2))
+!        mt_ttl = 0.0
+!        mt_tti = 0.0
+!        y%mt_ttl = mt_ttl
+!        y%mt_tti = mt_tti
+! !---------------------------------------------------
+       
+       ! :: D created on a log-linear scale
+       y%nsizes = nd
+       delt = (log(dmax)-log(dmin))/(y%nsizes-1)
+       deltp = exp(delt)
+       allocate(y%D(y%nsizes))
+       y%D(1) = dmin
+       do i=2,y%nsizes
+          y%D(i) = y%D(i-1)*deltp
+       enddo   
+   
+    endif
+
+
+END SUBROUTINE CONSTRUCT_COSP_GRIDBOX
+
+  
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE FREE_COSP_GRIDBOX -----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal)
+    type(cosp_gridbox),intent(inout) :: y
+    logical,intent(in),optional :: dglobal
+
+    ! --- Free arrays ---
+    deallocate(y%D,y%mt_ttl,y%mt_tti)	! added by roj Feb 2008
+    if (.not.present(dglobal)) deallocate(mt_ttl,mt_tti)
+    
+!     deallocate(y%hp%p1,y%hp%p2,y%hp%p3,y%hp%dmin,y%hp%dmax,y%hp%apm,y%hp%bpm,y%hp%rho, &
+!               y%hp%dtype,y%hp%col,y%hp%cp,y%hp%phase,y%hp%scaled, &
+!               y%hp%z_flag,y%hp%Ze_scaled,y%hp%Zr_scaled,y%hp%kr_scaled, &
+!               y%hp%fc, y%hp%rho_eff, y%hp%ifc, y%hp%idd)
+!     deallocate(y%mt%freq, y%mt%tt, y%mt%f, y%mt%D, y%mt%qext, y%mt%qbsca, y%mt%phase)
+    
+    deallocate(y%zlev, y%zlev_half, y%dlev, y%p, y%ph, y%T, y%q, &
+               y%sh, y%dtau_s, y%dtau_c, y%dem_s, y%dem_c, &
+               y%longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, &
+               y%mr_hydro, y%dist_prmts_hydro, &
+               y%conc_aero, y%dist_type_aero, y%dist_prmts_aero, &
+               y%rain_ls, y%rain_cv, y%snow_ls, y%snow_cv, y%grpl_ls, &
+               y%sunlit, y%skt, y%sfc_height, y%Reff,y%ichan,y%surfem, &
+               y%mr_ozone,y%u_wind,y%v_wind)
+ 
+  END SUBROUTINE FREE_COSP_GRIDBOX
+  
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_GRIDBOX_CPHP ----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_GRIDBOX_CPHP(x,y)
+    type(cosp_gridbox),intent(in) :: x
+    type(cosp_gridbox),intent(inout) :: y
+    
+    integer :: i,j,k,sz(3)
+    double precision :: tny
+    
+    tny = tiny(tny)
+    y%hp%p1      = x%hp%p1
+    y%hp%p2      = x%hp%p2
+    y%hp%p3      = x%hp%p3
+    y%hp%dmin    = x%hp%dmin
+    y%hp%dmax    = x%hp%dmax
+    y%hp%apm     = x%hp%apm
+    y%hp%bpm     = x%hp%bpm
+    y%hp%rho     = x%hp%rho
+    y%hp%dtype   = x%hp%dtype
+    y%hp%col     = x%hp%col
+    y%hp%cp      = x%hp%cp
+    y%hp%phase   = x%hp%phase
+
+    y%hp%fc      = x%hp%fc
+    y%hp%rho_eff = x%hp%rho_eff
+    y%hp%ifc     = x%hp%ifc
+    y%hp%idd     = x%hp%idd
+    sz = shape(x%hp%z_flag)
+    do k=1,sz(3)
+      do j=1,sz(2)
+        do i=1,sz(1)
+           if (x%hp%scaled(i,k))   y%hp%scaled(i,k)      = .true.
+           if (x%hp%z_flag(i,j,k)) y%hp%z_flag(i,j,k)    = .true.
+           if (abs(x%hp%Ze_scaled(i,j,k)) > tny) y%hp%Ze_scaled(i,j,k) = x%hp%Ze_scaled(i,j,k)
+           if (abs(x%hp%Zr_scaled(i,j,k)) > tny) y%hp%Zr_scaled(i,j,k) = x%hp%Zr_scaled(i,j,k)
+           if (abs(x%hp%kr_scaled(i,j,k)) > tny) y%hp%kr_scaled(i,j,k) = x%hp%kr_scaled(i,j,k)
+        enddo
+      enddo
+    enddo
+    
+END SUBROUTINE COSP_GRIDBOX_CPHP
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_GRIDBOX_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_GRIDBOX_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_gridbox),intent(in) :: x
+    type(cosp_gridbox),intent(inout) :: y
+    
+    integer :: i,j,k,sz(3)
+    
+    ! --- Copy arrays without Npoints as dimension ---
+    y%dist_prmts_hydro = x%dist_prmts_hydro
+    y%dist_type_aero   = x%dist_type_aero
+    y%D                = x%D
+    y%mt_ttl           = x%mt_ttl
+    y%mt_tti           = x%mt_tti
+    
+    
+!     call cosp_gridbox_cphp(x,y)    
+    
+    ! 1D
+    y%longitude(iy(1):iy(2))  = x%longitude(ix(1):ix(2))
+    y%latitude(iy(1):iy(2))   = x%latitude(ix(1):ix(2))
+    y%psfc(iy(1):iy(2))       = x%psfc(ix(1):ix(2))
+    y%land(iy(1):iy(2))       = x%land(ix(1):ix(2))
+    y%sunlit(iy(1):iy(2))     = x%sunlit(ix(1):ix(2))
+    y%skt(iy(1):iy(2))        = x%skt(ix(1):ix(2))
+    y%sfc_height(iy(1):iy(2)) = x%sfc_height(ix(1):ix(2))
+    y%u_wind(iy(1):iy(2))     = x%u_wind(ix(1):ix(2))
+    y%v_wind(iy(1):iy(2))     = x%v_wind(ix(1):ix(2))
+    ! 2D
+    y%zlev(iy(1):iy(2),:)      = x%zlev(ix(1):ix(2),:)
+    y%zlev_half(iy(1):iy(2),:) = x%zlev_half(ix(1):ix(2),:)
+    y%dlev(iy(1):iy(2),:)      = x%dlev(ix(1):ix(2),:)
+    y%p(iy(1):iy(2),:)         = x%p(ix(1):ix(2),:)
+    y%ph(iy(1):iy(2),:)        = x%ph(ix(1):ix(2),:)
+    y%T(iy(1):iy(2),:)         = x%T(ix(1):ix(2),:)
+    y%q(iy(1):iy(2),:)         = x%q(ix(1):ix(2),:)
+    y%sh(iy(1):iy(2),:)        = x%sh(ix(1):ix(2),:)
+    y%dtau_s(iy(1):iy(2),:)    = x%dtau_s(ix(1):ix(2),:)
+    y%dtau_c(iy(1):iy(2),:)    = x%dtau_c(ix(1):ix(2),:)
+    y%dem_s(iy(1):iy(2),:)     = x%dem_s(ix(1):ix(2),:)
+    y%dem_c(iy(1):iy(2),:)     = x%dem_c(ix(1):ix(2),:)
+    y%tca(iy(1):iy(2),:)       = x%tca(ix(1):ix(2),:)
+    y%cca(iy(1):iy(2),:)       = x%cca(ix(1):ix(2),:)
+    y%rain_ls(iy(1):iy(2),:)   = x%rain_ls(ix(1):ix(2),:)
+    y%rain_cv(iy(1):iy(2),:)   = x%rain_cv(ix(1):ix(2),:)
+    y%grpl_ls(iy(1):iy(2),:)   = x%grpl_ls(ix(1):ix(2),:)
+    y%snow_ls(iy(1):iy(2),:)   = x%snow_ls(ix(1):ix(2),:)
+    y%snow_cv(iy(1):iy(2),:)   = x%snow_cv(ix(1):ix(2),:)
+    y%mr_ozone(iy(1):iy(2),:)  = x%mr_ozone(ix(1):ix(2),:)
+    ! 3D
+    y%Reff(iy(1):iy(2),:,:)      = x%Reff(ix(1):ix(2),:,:)
+    y%conc_aero(iy(1):iy(2),:,:) = x%conc_aero(ix(1):ix(2),:,:)
+    y%mr_hydro(iy(1):iy(2),:,:)  = x%mr_hydro(ix(1):ix(2),:,:)
+    ! 4D
+    y%dist_prmts_aero(iy(1):iy(2),:,:,:) = x%dist_prmts_aero(ix(1):ix(2),:,:,:)
+
+END SUBROUTINE COSP_GRIDBOX_CPSECTION
+ 
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_SUBGRID_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_SUBGRID_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_subgrid),intent(in) :: x
+    type(cosp_subgrid),intent(inout) :: y
+    
+    y%prec_frac(iy(1):iy(2),:,:)  = x%prec_frac(ix(1):ix(2),:,:)
+    y%frac_out(iy(1):iy(2),:,:)   = x%frac_out(ix(1):ix(2),:,:)
+END SUBROUTINE COSP_SUBGRID_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_SGRADAR_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_SGRADAR_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_sgradar),intent(in) :: x
+    type(cosp_sgradar),intent(inout) :: y
+    
+    y%att_gas(iy(1):iy(2),:)  = x%att_gas(ix(1):ix(2),:)
+    y%Ze_tot(iy(1):iy(2),:,:) = x%Ze_tot(ix(1):ix(2),:,:)
+END SUBROUTINE COSP_SGRADAR_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_SGLIDAR_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_SGLIDAR_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_sglidar),intent(in) :: x
+    type(cosp_sglidar),intent(inout) :: y
+    
+    y%beta_mol(iy(1):iy(2),:)       = x%beta_mol(ix(1):ix(2),:)
+    y%beta_tot(iy(1):iy(2),:,:)     = x%beta_tot(ix(1):ix(2),:,:)
+    y%tau_tot(iy(1):iy(2),:,:)      = x%tau_tot(ix(1):ix(2),:,:)
+    y%refl(iy(1):iy(2),:,:)         = x%refl(ix(1):ix(2),:,:)
+END SUBROUTINE COSP_SGLIDAR_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_ISCCP_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_ISCCP_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_isccp),intent(in) :: x
+    type(cosp_isccp),intent(inout) :: y
+            
+    y%fq_isccp(iy(1):iy(2),:,:)  = x%fq_isccp(ix(1):ix(2),:,:)
+    y%totalcldarea(iy(1):iy(2))  = x%totalcldarea(ix(1):ix(2))
+    y%meantb(iy(1):iy(2))        = x%meantb(ix(1):ix(2))
+    y%meantbclr(iy(1):iy(2))     = x%meantbclr(ix(1):ix(2))
+    y%meanptop(iy(1):iy(2))      = x%meanptop(ix(1):ix(2))
+    y%meantaucld(iy(1):iy(2))    = x%meantaucld(ix(1):ix(2))
+    y%meanalbedocld(iy(1):iy(2)) = x%meanalbedocld(ix(1):ix(2))
+    y%boxtau(iy(1):iy(2),:)      = x%boxtau(ix(1):ix(2),:)
+    y%boxptop(iy(1):iy(2),:)     = x%boxptop(ix(1):ix(2),:)
+END SUBROUTINE COSP_ISCCP_CPSECTION
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_MISR_CPSECTION -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_MISR_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_misr),intent(in) :: x
+    type(cosp_misr),intent(inout) :: y
+            
+    y%fq_MISR(iy(1):iy(2),:,:)                 = x%fq_MISR(ix(1):ix(2),:,:)
+    y%MISR_meanztop(iy(1):iy(2))               = x%MISR_meanztop(ix(1):ix(2))
+    y%MISR_cldarea(iy(1):iy(2))                = x%MISR_cldarea(ix(1):ix(2))
+    y%MISR_dist_model_layertops(iy(1):iy(2),:) = x%MISR_dist_model_layertops(ix(1):ix(2),:)
+END SUBROUTINE COSP_MISR_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_RTTOV_CPSECTION -------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_RTTOV_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_rttov),intent(in) :: x
+    type(cosp_rttov),intent(inout) :: y
+            
+    y%tbs(iy(1):iy(2),:) = x%tbs(ix(1):ix(2),:)
+END SUBROUTINE COSP_RTTOV_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_RADARSTATS_CPSECTION --------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_RADARSTATS_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_radarstats),intent(in) :: x
+    type(cosp_radarstats),intent(inout) :: y
+            
+    y%cfad_ze(iy(1):iy(2),:,:)             = x%cfad_ze(ix(1):ix(2),:,:)
+    y%radar_lidar_tcc(iy(1):iy(2))         = x%radar_lidar_tcc(ix(1):ix(2))
+    y%lidar_only_freq_cloud(iy(1):iy(2),:) = x%lidar_only_freq_cloud(ix(1):ix(2),:)
+END SUBROUTINE COSP_RADARSTATS_CPSECTION
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_LIDARSTATS_CPSECTION --------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_LIDARSTATS_CPSECTION(ix,iy,x,y)
+    integer,intent(in),dimension(2) :: ix,iy
+    type(cosp_lidarstats),intent(in) :: x
+    type(cosp_lidarstats),intent(inout) :: y
+            
+    y%srbval                     = x%srbval
+    y%cfad_sr(iy(1):iy(2),:,:)   = x%cfad_sr(ix(1):ix(2),:,:)
+    y%lidarcld(iy(1):iy(2),:)    = x%lidarcld(ix(1):ix(2),:)
+    y%cldlayer(iy(1):iy(2),:)    = x%cldlayer(ix(1):ix(2),:)
+    y%parasolrefl(iy(1):iy(2),:) = x%parasolrefl(ix(1):ix(2),:)
+END SUBROUTINE COSP_LIDARSTATS_CPSECTION
+
+END MODULE MOD_COSP_TYPES
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_utils.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_utils.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/cosp_utils.F90	(revision 1262)
@@ -0,0 +1,294 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its contributors may be used 
+!       to endorse or promote products derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+!
+
+MODULE MOD_COSP_UTILS
+  USE MOD_COSP_CONSTANTS
+  IMPLICIT NONE
+
+  INTERFACE Z_TO_DBZ
+    MODULE PROCEDURE Z_TO_DBZ_2D,Z_TO_DBZ_3D,Z_TO_DBZ_4D
+  END INTERFACE
+
+  INTERFACE COSP_CHECK_INPUT
+    MODULE PROCEDURE COSP_CHECK_INPUT_1D,COSP_CHECK_INPUT_2D,COSP_CHECK_INPUT_3D
+  END INTERFACE
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE ZERO_INT -------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ELEMENTAL SUBROUTINE ZERO_INT(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
+
+  integer,intent(inout) :: x
+  integer,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                    y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                    y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
+  x = 0
+  if (present(y01)) y01 = 0
+  if (present(y02)) y02 = 0
+  if (present(y03)) y03 = 0
+  if (present(y04)) y04 = 0
+  if (present(y05)) y05 = 0
+  if (present(y06)) y06 = 0
+  if (present(y07)) y07 = 0
+  if (present(y08)) y08 = 0
+  if (present(y09)) y09 = 0
+  if (present(y10)) y10 = 0
+  if (present(y11)) y11 = 0
+  if (present(y12)) y12 = 0
+  if (present(y13)) y13 = 0
+  if (present(y14)) y14 = 0
+  if (present(y15)) y15 = 0
+  if (present(y16)) y16 = 0
+  if (present(y17)) y17 = 0
+  if (present(y18)) y18 = 0
+  if (present(y19)) y19 = 0
+  if (present(y20)) y20 = 0
+  if (present(y21)) y21 = 0
+  if (present(y22)) y22 = 0
+  if (present(y23)) y23 = 0
+  if (present(y24)) y24 = 0
+  if (present(y25)) y25 = 0
+  if (present(y26)) y26 = 0
+  if (present(y27)) y27 = 0
+  if (present(y28)) y28 = 0
+  if (present(y29)) y29 = 0
+  if (present(y30)) y30 = 0
+END SUBROUTINE  ZERO_INT
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE ZERO_REAL ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ELEMENTAL SUBROUTINE ZERO_REAL(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
+
+  real,intent(inout) :: x
+  real,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
+  x = 0.0
+  if (present(y01)) y01 = 0.0
+  if (present(y02)) y02 = 0.0
+  if (present(y03)) y03 = 0.0
+  if (present(y04)) y04 = 0.0
+  if (present(y05)) y05 = 0.0
+  if (present(y06)) y06 = 0.0
+  if (present(y07)) y07 = 0.0
+  if (present(y08)) y08 = 0.0
+  if (present(y09)) y09 = 0.0
+  if (present(y10)) y10 = 0.0
+  if (present(y11)) y11 = 0.0
+  if (present(y12)) y12 = 0.0
+  if (present(y13)) y13 = 0.0
+  if (present(y14)) y14 = 0.0
+  if (present(y15)) y15 = 0.0
+  if (present(y16)) y16 = 0.0
+  if (present(y17)) y17 = 0.0
+  if (present(y18)) y18 = 0.0
+  if (present(y19)) y19 = 0.0
+  if (present(y20)) y20 = 0.0
+  if (present(y21)) y21 = 0.0
+  if (present(y22)) y22 = 0.0
+  if (present(y23)) y23 = 0.0
+  if (present(y24)) y24 = 0.0
+  if (present(y25)) y25 = 0.0
+  if (present(y26)) y26 = 0.0
+  if (present(y27)) y27 = 0.0
+  if (present(y28)) y28 = 0.0
+  if (present(y29)) y29 = 0.0
+  if (present(y30)) y30 = 0.0
+END SUBROUTINE  ZERO_REAL
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_2D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_2D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_2D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_3D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_3D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_3D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_4D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_4D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:,:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_4D
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_1D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_1D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_1D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_1D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_2D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_2D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:,:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_2D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_2D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_3D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_3D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:,:,:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_3D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_3D
+
+
+END MODULE MOD_COSP_UTILS
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/dsd.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/dsd.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/dsd.F90	(revision 1262)
@@ -0,0 +1,359 @@
+  subroutine dsd(Q,Re,D,N,nsizes,dtype,rho_a,tc, &
+             dmin,dmax,apm,bpm,rho_c,p1,p2,p3,fc,scaled)
+  use array_lib
+  use math_lib 
+  implicit none
+
+! Purpose:
+!   Create a discrete drop size distribution
+!   Part of QuickBeam v1.03 by John Haynes
+!   http://reef.atmos.colostate.edu/haynes/radarsim
+!
+! Inputs:
+!   [Q]        hydrometeor mixing ratio (g/kg)
+!   [Re]       Optional Effective Radius (microns).  0 = use default.
+!   [D]        discrete drop sizes (um)
+!   [nsizes]   number of elements of [D]
+!   [dtype]    distribution type
+!   [rho_a]    ambient air density (kg m^-3)
+!   [tc]       temperature (C)
+!   [dmin]     minimum size cutoff (um)
+!   [dmax]     maximum size cutoff (um)
+!   [rho_c]    alternate constant density (kg m^-3)
+!   [p1],[p2],[p3]  distribution parameters
+!
+! Input/Output:
+!   [fc]       scaling factor for the distribution
+!   [scaled]   has this hydrometeor type been scaled?
+!   [apm]      a parameter for mass (kg m^[-bpm])
+!   [bmp]      b params for mass
+!
+! Outputs:
+!   [N]        discrete concentrations (cm^-3 um^-1)
+!              or, for monodisperse, a constant (1/cm^3)
+!
+! Requires:
+!   function infind
+!
+! Created:
+!   11/28/05  John Haynes (haynes@atmos.colostate.edu)
+! Modified:
+!   01/31/06  Port from IDL to Fortran 90
+!   07/07/06  Rewritten for variable DSD's
+!   10/02/06  Rewritten using scaling factors (Roger Marchand and JMH)
+ 
+! ----- INPUTS -----  
+  
+  integer*4, intent(in) :: nsizes
+  integer, intent(in) :: dtype
+  real*8, intent(in) :: Q,D(nsizes),rho_a,tc,dmin,dmax, &
+    rho_c,p1,p2,p3
+    
+! ----- INPUT/OUTPUT -----
+
+  real*8, intent(inout) :: fc(nsizes),apm,bpm,Re
+  logical, intent(inout) :: scaled  
+    
+! ----- OUTPUTS -----
+
+  real*8, intent(out) :: N(nsizes)
+  
+! ----- INTERNAL -----
+  
+  real*8 :: &
+  N0,D0,vu,np,dm,ld, &			! gamma, exponential variables
+  dmin_mm,dmax_mm,ahp,bhp, &		! power law variables
+  rg,log_sigma_g, &			! lognormal variables
+  rho_e					! particle density (kg m^-3)
+  
+  real*8 :: tmp1, tmp2
+  real*8 :: pi,rc
+
+  integer k,lidx,uidx
+
+  pi = acos(-1.0)
+  
+! // if density is constant, store equivalent values for apm and bpm
+  if ((rho_c > 0) .and. (apm < 0)) then
+    apm = (pi/6)*rho_c
+    bpm = 3.
+  endif
+  
+  select case(dtype)
+  
+! ---------------------------------------------------------!
+! // modified gamma                                        !
+! ---------------------------------------------------------!
+! :: N0 = total number concentration (m^-3)
+! :: np = fixed number concentration (kg^-1)
+! :: D0 = characteristic diameter (um)
+! :: dm = mean diameter (um)
+! :: vu = distribution width parameter
+
+  case(1)  
+    if (abs(p1+1) < 1E-8) then
+
+!     // D0, vu are given  
+      vu = p3 
+      
+      if(Re.le.0) then 
+      	dm = p2
+	D0 = gamma(vu)/gamma(vu+1)*dm
+      else
+	D0 = 2.0*Re*gamma(vu+2)/gamma(vu+3)
+      endif
+     
+      if (scaled .eqv. .false.) then
+      
+        fc = ( &
+             ((D*1E-6)**(vu-1)*exp(-1*D/D0)) / &
+             (apm*((D0*1E-6)**(vu+bpm))*gamma(vu+bpm)) &
+	     ) * 1E-12
+	scaled = .true.
+
+      endif	   
+
+      N = fc*rho_a*(Q*1E-3)
+    
+    elseif (abs(p2+1) < 1E-8) then
+
+!     // N0, vu are given    
+      np = p1
+      vu = p3 
+      tmp1 = (Q*1E-3)**(1./bpm)
+      
+      if (scaled .eqv. .false.) then
+
+        fc = (D*1E-6 / (gamma(vu)/(apm*np*gamma(vu+bpm)))** &
+             (1./bpm))**vu
+	     
+        scaled = .true.
+
+      endif
+
+      N = ( &
+          (rho_a*np*fc*(D*1E-6)**(-1.))/(gamma(vu)*tmp1**vu) * &
+          exp(-1.*fc**(1./vu)/tmp1) &
+ 	  ) * 1E-12
+
+    else
+
+!     // vu isn't given
+      print *, 'Error: Must specify a value for vu'
+      stop
+    
+    endif
+    
+! ---------------------------------------------------------!
+! // exponential                                           !
+! ---------------------------------------------------------!
+! :: N0 = intercept parameter (m^-4)
+! :: ld = slope parameter (um)
+
+  case(2)
+    if (abs(p1+1) > 1E-8) then
+
+!     // N0 has been specified, determine ld
+      N0 = p1
+
+      if(Re>0) then
+
+	! if Re is set and No is set than the distribution is fully defined.
+	! so we assume Re and No have already been chosen consistant with  
+	! the water content, Q.
+
+	! print *,'using Re pass ...'
+
+	ld = 1.5/Re   ! units 1/um
+
+	N = ( &
+          	N0*exp(-1*ld*D) &
+        ) * 1E-12
+    
+      else
+
+      	tmp1 = 1./(1.+bpm)
+      
+      	if (scaled .eqv. .false.) then
+        	fc = ((apm*gamma(1.+bpm)*N0)**tmp1)*(D*1E-6)
+		scaled = .true.
+
+      	endif
+     
+      	N = ( &
+        	N0*exp(-1.*fc*(1./(rho_a*Q*1E-3))**tmp1) &
+	) * 1E-12
+
+      endif	
+
+    elseif (abs(p2+1) > 1E-8) then
+
+!     // ld has been specified, determine N0
+      ld = p2
+
+      if (scaled .eqv. .false.) then
+
+        fc = (ld*1E6)**(1.+bpm)/(apm*gamma(1+bpm))* &
+             exp(-1.*(ld*1E6)*(D*1E-6))*1E-12
+        scaled = .true.
+
+      endif
+
+      N = fc*rho_a*(Q*1E-3)
+
+    else
+
+!     // ld will be determined from temperature, then N0 follows
+      ld = 1220*10.**(-0.0245*tc)*1E-6
+      N0 = ((ld*1E6)**(1+bpm)*Q*1E-3*rho_a)/(apm*gamma(1+bpm))
+    
+      N = ( &
+          N0*exp(-1*ld*D) &
+          ) * 1E-12
+    
+    endif
+  
+! ---------------------------------------------------------!
+! // power law                                             !
+! ---------------------------------------------------------!
+! :: ahp = Ar parameter (m^-4 mm^-bhp)
+! :: bhp = br parameter
+! :: dmin_mm = lower bound (mm)
+! :: dmax_mm = upper bound (mm)
+
+  case(3)
+
+!   :: br parameter
+    if (abs(p1+2) < 1E-8) then
+!     :: if p1=-2, bhp is parameterized according to Ryan (2000),
+!     :: applicatable to cirrus clouds
+      if (tc < -30) then
+        bhp = -1.75+0.09*((tc+273)-243.16)
+      elseif ((tc >= -30) .and. (tc < -9)) then
+        bhp = -3.25-0.06*((tc+273)-265.66)
+      else
+        bhp = -2.15
+      endif
+    elseif (abs(p1+3) < 1E-8) then      
+!     :: if p1=-3, bhp is parameterized according to Ryan (2000),
+!     :: applicable to frontal clouds
+      if (tc < -35) then
+        bhp = -1.75+0.09*((tc+273)-243.16)
+      elseif ((tc >= -35) .and. (tc < -17.5)) then
+        bhp = -2.65+0.09*((tc+273)-255.66)
+      elseif ((tc >= -17.5) .and. (tc < -9)) then
+        bhp = -3.25-0.06*((tc+273)-265.66)
+      else
+        bhp = -2.15
+      endif    
+    else
+!     :: otherwise the specified value is used
+      bhp = p1
+    endif
+
+!   :: Ar parameter
+    dmin_mm = dmin*1E-3
+    dmax_mm = dmax*1E-3
+
+!   :: commented lines are original method with constant density
+      ! rc = 500.		! (kg/m^3)
+      ! tmp1 = 6*rho_a*(bhp+4)
+      ! tmp2 = pi*rc*(dmax_mm**(bhp+4))*(1-(dmin_mm/dmax_mm)**(bhp+4))
+      ! ahp = (Q*1E-3)*1E12*tmp1/tmp2
+
+!   :: new method is more consistent with the rest of the distributions
+!   :: and allows density to vary with particle size
+      tmp1 = rho_a*(Q*1E-3)*(bhp+bpm+1)
+      tmp2 = apm*(dmax_mm**bhp*dmax**(bpm+1)-dmin_mm**bhp*dmin**(bpm+1))
+      ahp = tmp1/tmp2 * 1E24
+      ! ahp = tmp1/tmp2 
+ 
+      lidx = infind(D,dmin)
+      uidx = infind(D,dmax)    
+      do k=lidx,uidx
+ 
+    	N(k) = ( &
+        ahp*(D(k)*1E-3)**bhp &
+	) * 1E-12    
+
+      enddo
+
+	! print *,'test=',ahp,bhp,ahp/(rho_a*Q),D(100),N(100),bpm,dmin_mm,dmax_mm
+
+! ---------------------------------------------------------!
+! // monodisperse                                          !
+! ---------------------------------------------------------!
+! :: D0 = particle diameter (um)
+
+  case(4)
+  
+    if (scaled .eqv. .false.) then
+    
+      D0 = p1
+      rho_e = (6/pi)*apm*(D0*1E-6)**(bpm-3)
+      fc(1) = (6./(pi*D0**3*rho_e))*1E12
+      scaled = .true.
+      
+    endif
+    
+    N(1) = fc(1)*rho_a*(Q*1E-3)
+    
+! ---------------------------------------------------------!
+! // lognormal                                             !
+! ---------------------------------------------------------!
+! :: N0 = total number concentration (m^-3)
+! :: np = fixed number concentration (kg^-1)
+! :: rg = mean radius (um)
+! :: log_sigma_g = ln(geometric standard deviation)
+
+  case(5)
+    if (abs(p1+1) < 1E-8) then
+
+!     // rg, log_sigma_g are given
+      log_sigma_g = p3
+      tmp2 = (bpm*log_sigma_g)**2.
+      if(Re.le.0) then 
+      	rg = p2
+      else
+	rg =Re*exp(-2.5*(log_sigma_g**2))
+      endif
+ 
+      if (scaled .eqv. .false.) then
+            
+        fc = 0.5 * ( &
+	     (1./((2.*rg*1E-6)**(bpm)*apm*(2.*pi)**(0.5) * &
+	     log_sigma_g*D*0.5*1E-6)) * &
+	     exp(-0.5*((log(0.5*D/rg)/log_sigma_g)**2.+tmp2)) &
+	     ) * 1E-12
+	scaled = .true.
+	     
+      endif
+	        
+      N = fc*rho_a*(Q*1E-3)
+      
+    elseif (abs(p2+1) < 1E-8) then
+
+!     // N0, log_sigma_g are given    
+      Np = p1
+      log_sigma_g = p3
+      N0 = np*rho_a
+      tmp1 = (rho_a*(Q*1E-3))/(2.**bpm*apm*N0)
+      tmp2 = exp(0.5*bpm**2.*(log_sigma_g))**2.      
+      rg = ((tmp1/tmp2)**(1/bpm))*1E6
+      
+      N = 0.5*( &
+        N0 / ((2.*pi)**(0.5)*log_sigma_g*D*0.5*1E-6) * &
+	exp((-0.5*(log(0.5*D/rg)/log_sigma_g)**2.)) &
+	) * 1E-12      
+      
+    else
+
+!     // vu isn't given
+      print *, 'Error: Must specify a value for sigma_g'
+      stop
+    
+    endif
+    
+  end select
+  
+  end subroutine dsd
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/format_input.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/format_input.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/format_input.F90	(revision 1262)
@@ -0,0 +1,132 @@
+! FORMAT_INPUT: Procedures to prepare data for input to the simulator
+! Compiled/Modified:
+!   08/28/2006  John Haynes (haynes@atmos.colostate.edu)
+!
+! irreg_to_grid (subroutine)
+! order_data (subroutine)
+
+  module format_input
+
+  contains
+
+! ----------------------------------------------------------------------------
+! SUBROUTINE IRREG_TO_GRID
+! ----------------------------------------------------------------------------
+  subroutine irreg_to_grid(hgt_matrix,t_matrix,p_matrix,rh_matrix, &
+    env_hgt_matrix,env_t_matrix,env_p_matrix,env_rh_matrix)
+  use array_lib
+  implicit none
+
+! Purpose:
+!   Linearly interpolate sounding-level data to the hydrometeor-level
+!   resolution
+!
+! Inputs:
+!   [hgt_matrix]       hydrometeor-level heights
+!   [env_hgt_matrix]   sounding-level heights
+!   [env_t_matrix]     sounding-level temperatures
+!   [env_p_matrix]     sounding-level pressures
+!   [env_rh_matrix]    sounding-level relative humidities
+!
+! Outputs:
+!   [t_matrix]         hydrometeor-level temperatures
+!   [p_matrix]         hydrometeor-level pressures
+!   [rh_matrix]        hydrometeor-level relative humidities
+!
+! Created:
+!   08/28/2006  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----
+  real*8, dimension(:,:), intent(in) :: &
+    hgt_matrix,env_hgt_matrix,env_t_matrix,env_p_matrix,env_rh_matrix
+
+! ----- OUTPUTS -----
+  real*8, dimension(:,:), intent(out) :: &
+    t_matrix,p_matrix,rh_matrix
+
+! ----- INTERNAL -----
+  integer :: nprof, i
+  integer,parameter :: KR8 = selected_real_kind(15,300)
+
+  nprof = size(hgt_matrix,1)
+  do i=1,nprof
+    call lin_interpolate(env_t_matrix(i,:),env_hgt_matrix(i,:), &
+      t_matrix(i,:),hgt_matrix(i,:),1000._KR8)
+    call lin_interpolate(env_p_matrix(i,:),env_hgt_matrix(i,:), &
+      p_matrix(i,:),hgt_matrix(i,:),1000._KR8)
+    call lin_interpolate(env_rh_matrix(i,:),env_hgt_matrix(i,:), &
+      rh_matrix(i,:),hgt_matrix(i,:),1000._KR8)
+  enddo
+
+  end subroutine irreg_to_grid
+
+! ----------------------------------------------------------------------------
+! SUBROUTINE ORDER_DATA
+! ----------------------------------------------------------------------------
+  subroutine order_data(hgt_matrix,hm_matrix,p_matrix,t_matrix, &
+    rh_matrix,sfc_radar,hgt_reversed)
+  implicit none
+
+! Purpose:
+!   Ensure that input data is in top-down order/bottom-up order,
+!   for space-based/surface based radars, respectively
+!
+! Inputs:
+!   [hgt_matrix]   heights
+!   [hm_matrix]    mixing ratios
+!   [t_matrix]     temperatures
+!   [p_matrix]     pressures
+!   [rh_matrix]    relative humidities
+!   [sfc_radar]    1=surface radar, 0=spaceborne
+!
+! Outputs:
+!   [hgt_matrix],[hm_matrix],[p_matrix,[t_matrix],[rh_matrix] in proper
+!   order for input to the radar simulator routine
+!   [hgt_reversed]   T=heights were reordered,F=heights were not reordered
+!
+! Note:
+!   The order for all profiles is assumed to the same as the first profile.
+!
+! Created:
+!   08/28/2006  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----
+  integer, intent(in) :: sfc_radar
+
+! ----- OUTPUTS -----
+  real*8, dimension(:,:), intent(inout) :: &
+    hgt_matrix,p_matrix,t_matrix,rh_matrix
+  real*8, dimension(:,:,:), intent(inout) :: &
+    hm_matrix
+  logical, intent(out) :: hgt_reversed
+
+! ----- INTERNAL -----
+  integer :: ngate
+  logical :: hgt_descending
+  
+
+  ngate = size(hgt_matrix,2)
+  hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate)
+      
+! :: surface: heights must be ascending
+! :: space-based: heights must be descending
+  if ( &
+     (sfc_radar == 1 .and. hgt_descending) .or.  &
+     (sfc_radar == 0 .and. (.not. hgt_descending)) &
+     ) &
+  then
+
+    hgt_matrix(:,:) = hgt_matrix(:,ngate:1:-1)
+    hm_matrix(:,:,:) = hm_matrix(:,:,ngate:1:-1)
+    p_matrix(:,:) = p_matrix(:,ngate:1:-1)
+    t_matrix(:,:) = t_matrix(:,ngate:1:-1)
+    rh_matrix(:,:) = rh_matrix(:,ngate:1:-1) 
+
+    hgt_reversed = .true.
+  else
+    hgt_reversed = .false.
+  endif
+
+  end subroutine order_data
+
+  end module format_input
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/gases.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/gases.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/gases.F90	(revision 1262)
@@ -0,0 +1,182 @@
+  function gases(PRES_mb,T,RH,f)
+  implicit none
+  
+! Purpose:
+!   Compute 2-way gaseous attenuation through a volume in microwave
+!
+! Inputs:
+!   [PRES_mb]   pressure (mb) (hPa)
+!   [T]         temperature (K)
+!   [RH]        relative humidity (%)
+!   [f]         frequency (GHz), < 300 GHz
+!
+! Returns:
+!   2-way gaseous attenuation (dB/km)
+!
+! Reference:
+!   Uses method of Liebe (1985)
+!
+! Created:
+!   12/09/05  John Haynes (haynes@atmos.colostate.edu)
+! Modified:
+!   01/31/06  Port from IDL to Fortran 90
+
+  integer, parameter :: &
+  nbands_o2 = 48 ,&
+  nbands_h2o = 30
+  real*8, intent(in) :: PRES_mb, T, RH, f
+  real*8 :: gases, th, e, p, sumo, gm0, a0, ap, term1, term2, term3, &
+            bf, be, term4, npp
+  real*8, dimension(nbands_o2) :: v0, a1, a2, a3, a4, a5, a6
+  real*8, dimension(nbands_h2o) :: v1, b1, b2, b3
+  integer :: i
+  
+! // table1 parameters  v0, a1, a2, a3, a4, a5, a6  
+  data v0/49.4523790,49.9622570,50.4742380,50.9877480,51.5033500, &
+  52.0214090,52.5423930,53.0669060,53.5957480,54.1299999,54.6711570, &
+  55.2213650,55.7838000,56.2647770,56.3378700,56.9681000,57.6124810, &
+  58.3238740,58.4465890,59.1642040,59.5909820,60.3060570,60.4347750, &
+  61.1505580,61.8001520,62.4112120,62.4862530,62.9979740,63.5685150, &
+  64.1277640,64.6789000,65.2240670,65.7647690,66.3020880,66.8368270, &
+  67.3695950,67.9008620,68.4310010,68.9603060,69.4890210,70.0173420, &
+  118.7503410,368.4983500,424.7631200,487.2493700,715.3931500, &
+  773.8387300, 834.1453300/
+  data a1/0.0000001,0.0000003,0.0000009,0.0000025,0.0000061,0.0000141, &
+  0.0000310,0.0000641,0.0001247,0.0002280,0.0003918,0.0006316,0.0009535, &
+  0.0005489,0.0013440,0.0017630,0.0000213,0.0000239,0.0000146,0.0000240, &
+  0.0000211,0.0000212,0.0000246,0.0000250,0.0000230,0.0000193,0.0000152, &
+  0.0000150,0.0000109,0.0007335,0.0004635,0.0002748,0.0001530,0.0000801, &
+  0.0000395,0.0000183,0.0000080,0.0000033,0.0000013,0.0000005,0.0000002, &
+  0.0000094,0.0000679,0.0006380,0.0002350,0.0000996,0.0006710,0.0001800/
+  data a2/11.8300000,10.7200000,9.6900000,8.8900000,7.7400000,6.8400000, &
+  6.0000000,5.2200000,4.4800000,3.8100000,3.1900000,2.6200000,2.1150000, &
+  0.0100000,1.6550000,1.2550000,0.9100000,0.6210000,0.0790000,0.3860000, &
+  0.2070000,0.2070000,0.3860000,0.6210000,0.9100000,1.2550000,0.0780000, &
+  1.6600000,2.1100000,2.6200000,3.1900000,3.8100000,4.4800000,5.2200000, &
+  6.0000000,6.8400000,7.7400000,8.6900000,9.6900000,10.7200000,11.8300000, &
+  0.0000000,0.0200000,0.0110000,0.0110000,0.0890000,0.0790000,0.0790000/
+  data a3/0.0083000,0.0085000,0.0086000,0.0087000,0.0089000,0.0092000, &
+  0.0094000,0.0097000,0.0100000,0.0102000,0.0105000,0.0107900,0.0111000, &
+  0.0164600,0.0114400,0.0118100,0.0122100,0.0126600,0.0144900,0.0131900, &
+  0.0136000,0.0138200,0.0129700,0.0124800,0.0120700,0.0117100,0.0146800, &
+  0.0113900,0.0110800,0.0107800,0.0105000,0.0102000,0.0100000,0.0097000, &
+  0.0094000,0.0092000,0.0089000,0.0087000,0.0086000,0.0085000,0.0084000, &
+  0.0159200,0.0192000,0.0191600,0.0192000,0.0181000,0.0181000,0.0181000/
+  data a4/0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000,0.0000000, &
+  0.0000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000,0.6000000/
+  data a5/0.0056000,0.0056000,0.0056000,0.0055000,0.0056000,0.0055000, &
+  0.0057000,0.0053000,0.0054000,0.0048000,0.0048000,0.0041700,0.0037500, &
+  0.0077400,0.0029700,0.0021200,0.0009400,-0.0005500,0.0059700,-0.0024400, &
+  0.0034400,-0.0041300,0.0013200,-0.0003600,-0.0015900,-0.0026600, &
+  -0.0047700,-0.0033400,-0.0041700,-0.0044800,-0.0051000,-0.0051000, &
+  -0.0057000,-0.0055000,-0.0059000,-0.0056000,-0.0058000,-0.0057000, &
+  -0.0056000,-0.0056000,-0.0056000,-0.0004400,0.0000000,0.0000000, &
+  0.0000000,0.0000000,0.0000000,0.0000000/
+  data a6/1.7000000,1.7000000,1.7000000,1.7000000,1.8000000,1.8000000,&
+  1.8000000,1.9000000,1.8000000,2.0000000,1.9000000,2.1000000,2.1000000, &
+  0.9000000,2.3000000,2.5000000,3.7000000,-3.1000000,0.8000000,0.1000000, &
+  0.5000000,0.7000000,-1.0000000,5.8000000,2.9000000,2.3000000,0.9000000, &
+  2.2000000,2.0000000,2.0000000,1.8000000,1.9000000,1.8000000,1.8000000, &
+  1.7000000,1.8000000,1.7000000,1.7000000,1.7000000,1.7000000,1.7000000, &
+  0.9000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000,1.0000000/
+
+! // table2 parameters  v1, b1, b2, b3
+  data v1/22.2350800,67.8139600,119.9959400,183.3101170,321.2256440, &
+  325.1529190,336.1870000,380.1973720,390.1345080,437.3466670,439.1508120, &
+  443.0182950,448.0010750,470.8889740,474.6891270,488.4911330,503.5685320, &
+  504.4826920,556.9360020,620.7008070,658.0065000,752.0332270,841.0735950, &
+  859.8650000,899.4070000,902.5550000,906.2055240,916.1715820,970.3150220, &
+  987.9267640/
+  data b1/0.1090000,0.0011000,0.0007000,2.3000000,0.0464000,1.5400000, &
+  0.0010000,11.9000000,0.0044000,0.0637000,0.9210000,0.1940000,10.6000000, &
+  0.3300000,1.2800000,0.2530000,0.0374000,0.0125000,510.0000000,5.0900000, &
+  0.2740000,250.0000000,0.0130000,0.1330000,0.0550000,0.0380000,0.1830000, &
+  8.5600000,9.1600000,138.0000000/
+  data b2/2.1430000,8.7300000,8.3470000,0.6530000,6.1560000,1.5150000, &
+  9.8020000,1.0180000,7.3180000,5.0150000,3.5610000,5.0150000,1.3700000, &
+  3.5610000,2.3420000,2.8140000,6.6930000,6.6930000,0.1140000,2.1500000, &
+  7.7670000,0.3360000,8.1130000,7.9890000,7.8450000,8.3600000,5.0390000, &
+  1.3690000,1.8420000,0.1780000/
+  data b3/0.0278400,0.0276000,0.0270000,0.0283500,0.0214000,0.0270000, &
+  0.0265000,0.0276000,0.0190000,0.0137000,0.0164000,0.0144000,0.0238000, &
+  0.0182000,0.0198000,0.0249000,0.0115000,0.0119000,0.0300000,0.0223000, &
+  0.0300000,0.0286000,0.0141000,0.0286000,0.0286000,0.0264000,0.0234000, &
+  0.0253000,0.0240000,0.0286000/
+  
+! // conversions
+  th = 300./T		! unitless
+  e = (RH*th**5)/(41.45*10**(9.834*th-10))	! kPa
+  p = PRES_mb/10.-e	! kPa
+
+! // term1
+  sumo = 0.
+  do i=1,nbands_o2
+    sumo = sumo + fpp_o2(p,th,e,a3(i),a4(i),a5(i),a6(i),f,v0(i)) &
+           * s_o2(p,th,a1(i),a2(i))
+  enddo
+  term1 = sumo
+
+! // term2
+  gm0 = 5.6E-3*(p+1.1*e)*th**(0.8)
+  a0 = 3.07E-4
+  ap = 1.4*(1-1.2*f**(1.5)*1E-5)*1E-10
+  term2 = (2*a0*(gm0*(1+(f/gm0)**2)*(1+(f/60.)**2))**(-1) + ap*p*th**(2.5)) &
+          * f*p*th**2
+
+! // term3
+  sumo = 0.
+  do i=1,nbands_h2o
+    sumo = sumo + fpp_h2o(p,th,e,b3(i),f,v1(i)) &
+           * s_h2o(th,e,b1(i),b2(i))
+  enddo
+  term3 = sumo
+
+! // term4
+  bf = 1.4E-6
+  be = 5.41E-5
+  term4 = (bf*p+be*e*th**3)*f*e*th**(2.5)
+
+! // summation and result
+  npp = term1 + term2 + term3 + term4
+  gases = 0.182*f*npp
+
+! ----- SUB FUNCTIONS -----
+    
+  contains
+  
+  function fpp_o2(p,th,e,a3,a4,a5,a6,f,v0)
+  real*8 :: fpp_o2,p,th,e,a3,a4,a5,a6,f,v0
+  real*8 :: gm, delt, x, y
+  gm = a3*(p*th**(0.8-a4)+1.1*e*th)
+  delt = a5*p*th**(a6)
+  x = (v0-f)**2+gm**2
+  y = (v0+f)**2+gm**2
+  fpp_o2 = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x)))  
+  end function fpp_o2
+  
+  function fpp_h2o(p,th,e,b3,f,v0)
+  real*8 :: fpp_h2o,p,th,e,b3,f,v0
+  real*8 :: gm, delt, x, y
+  gm = b3*(p*th**(0.8)+4.8*e*th)
+  delt = 0.
+  x = (v0-f)**2+gm**2
+  y = (v0+f)**2+gm**2
+  fpp_h2o = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x)))
+  end function fpp_h2o
+  
+  function s_o2(p,th,a1,a2)
+  real*8 :: s_o2,p,th,a1,a2
+  s_o2 = a1*p*th**(3)*exp(a2*(1-th))
+  end function s_o2
+
+  function s_h2o(th,e,b1,b2)
+  real*8 :: s_h2o,th,e,b1,b2
+  s_h2o = b1*e*th**(3.5)*exp(b2*(1-th))
+  end function s_h2o
+  
+  end function gases
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/icarus.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/icarus.F	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/icarus.F	(revision 1262)
@@ -0,0 +1,1265 @@
+      SUBROUTINE ICARUS(
+     &     debug,
+     &     debugcol,
+     &     npoints,
+     &     sunlit,
+     &     nlev,
+     &     ncol,
+     &     pfull,
+     &     phalf,
+     &     qv,
+     &     cc,
+     &     conv,
+     &     dtau_s,
+     &     dtau_c,
+     &     top_height,
+     &     top_height_direction,
+     &     overlap,
+     &     frac_out,
+     &     skt,
+     &     emsfc_lw,
+     &     at,
+     &     dem_s,
+     &     dem_c,
+     &     fq_isccp,
+     &     totalcldarea,
+     &     meanptop,
+     &     meantaucld,
+     &     meanalbedocld,
+     &     meantb,
+     &     meantbclr,
+     &     boxtau,
+     &     boxptop
+     &)
+
+!$Id: icarus.f,v 4.0 2009/02/12 13:59:20 hadmw Exp $
+
+! *****************************COPYRIGHT****************************
+! (c) 2009, Lawrence Livermore National Security Limited Liability 
+! Corporation.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without 
+! modification, are permitted provided that the
+! following conditions are met:
+! 
+!     * Redistributions of source code must retain the above 
+!       copyright  notice, this list of conditions and the following 
+!       disclaimer.
+!     * Redistributions in binary form must reproduce the above 
+!       copyright notice, this list of conditions and the following 
+!       disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Lawrence Livermore National Security 
+!       Limited Liability Corporation nor the names of its 
+!       contributors may be used to endorse or promote products
+!       derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
+! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
+! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
+! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
+! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 
+! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 
+! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
+! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  
+! 
+! *****************************COPYRIGHT*******************************
+! *****************************COPYRIGHT*******************************
+! *****************************COPYRIGHT*******************************
+
+      implicit none
+
+!     NOTE:   the maximum number of levels and columns is set by
+!             the following parameter statement
+
+      INTEGER ncolprint
+      
+!     -----
+!     Input 
+!     -----
+
+      INTEGER npoints       !  number of model points in the horizontal
+      INTEGER nlev          !  number of model levels in column
+      INTEGER ncol          !  number of subcolumns
+
+      INTEGER sunlit(npoints) !  1 for day points, 0 for night time
+
+      REAL pfull(npoints,nlev)
+                       !  pressure of full model levels (Pascals)
+                  !  pfull(npoints,1) is top level of model
+                  !  pfull(npoints,nlev) is bot of model
+
+      REAL phalf(npoints,nlev+1)
+                  !  pressure of half model levels (Pascals)
+                  !  phalf(npoints,1) is top of model
+                  !  phalf(npoints,nlev+1) is the surface pressure
+
+      REAL qv(npoints,nlev)
+                  !  water vapor specific humidity (kg vapor/ kg air)
+                  !         on full model levels
+
+      REAL cc(npoints,nlev)   
+                  !  input cloud cover in each model level (fraction) 
+                  !  NOTE:  This is the HORIZONTAL area of each
+                  !         grid box covered by clouds
+
+      REAL conv(npoints,nlev) 
+                  !  input convective cloud cover in each model
+                  !   level (fraction) 
+                  !  NOTE:  This is the HORIZONTAL area of each
+                  !         grid box covered by convective clouds
+
+      REAL dtau_s(npoints,nlev) 
+                  !  mean 0.67 micron optical depth of stratiform
+                !  clouds in each model level
+                  !  NOTE:  this the cloud optical depth of only the
+                  !  cloudy part of the grid box, it is not weighted
+                  !  with the 0 cloud optical depth of the clear
+                  !         part of the grid box
+
+      REAL dtau_c(npoints,nlev) 
+                  !  mean 0.67 micron optical depth of convective
+                !  clouds in each
+                  !  model level.  Same note applies as in dtau_s.
+
+      INTEGER overlap                   !  overlap type
+                              !  1=max
+                              !  2=rand
+                              !  3=max/rand
+
+      INTEGER top_height                !  1 = adjust top height using both a computed
+                                        !  infrared brightness temperature and the visible
+                              !  optical depth to adjust cloud top pressure. Note
+                              !  that this calculation is most appropriate to compare
+                              !  to ISCCP data during sunlit hours.
+                                        !  2 = do not adjust top height, that is cloud top
+                                        !  pressure is the actual cloud top pressure
+                                        !  in the model
+                              !  3 = adjust top height using only the computed
+                              !  infrared brightness temperature. Note that this
+                              !  calculation is most appropriate to compare to ISCCP
+                              !  IR only algortihm (i.e. you can compare to nighttime
+                              !  ISCCP data with this option)
+
+      INTEGER top_height_direction ! direction for finding atmosphere pressure level
+                                 ! with interpolated temperature equal to the radiance
+				 ! determined cloud-top temperature
+				 !
+				 ! 1 = find the *lowest* altitude (highest pressure) level
+				 ! with interpolated temperature equal to the radiance
+				 ! determined cloud-top temperature
+				 !
+				 ! 2 = find the *highest* altitude (lowest pressure) level
+				 ! with interpolated temperature equal to the radiance 
+				 ! determined cloud-top temperature
+				 ! 
+				 ! ONLY APPLICABLE IF top_height EQUALS 1 or 3
+				 !				 !
+				 ! 1 = old setting: matches all versions of 
+				 ! ISCCP simulator with versions numbers 3.5.1 and lower
+				 !
+				 ! 2 = default setting: for version numbers 4.0 and higher
+!
+!     The following input variables are used only if top_height = 1 or top_height = 3
+!
+      REAL skt(npoints)                 !  skin Temperature (K)
+      REAL emsfc_lw                     !  10.5 micron emissivity of surface (fraction)                                            
+      REAL at(npoints,nlev)                   !  temperature in each model level (K)
+      REAL dem_s(npoints,nlev)                !  10.5 micron longwave emissivity of stratiform
+                              !  clouds in each
+                                        !  model level.  Same note applies as in dtau_s.
+      REAL dem_c(npoints,nlev)                  !  10.5 micron longwave emissivity of convective
+                              !  clouds in each
+                                        !  model level.  Same note applies as in dtau_s.
+
+      REAL frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into
+                              ! Equivalent of BOX in original version, but
+                              ! indexed by column then row, rather than
+                              ! by row then column
+
+
+
+!     ------
+!     Output
+!     ------
+
+      REAL fq_isccp(npoints,7,7)        !  the fraction of the model grid box covered by
+                                        !  each of the 49 ISCCP D level cloud types
+
+      REAL totalcldarea(npoints)        !  the fraction of model grid box columns
+                                        !  with cloud somewhere in them.  NOTE: This diagnostic
+					! does not count model clouds with tau < isccp_taumin
+                              ! Thus this diagnostic does not equal the sum over all entries of fq_isccp.
+			      ! However, this diagnostic does equal the sum over entries of fq_isccp with
+			      ! itau = 2:7 (omitting itau = 1)
+      
+      
+      ! The following three means are averages only over the cloudy areas with tau > isccp_taumin.  
+      ! If no clouds with tau > isccp_taumin are in grid box all three quantities should equal zero.      
+                              
+      REAL meanptop(npoints)            !  mean cloud top pressure (mb) - linear averaging
+                                        !  in cloud top pressure.
+                              
+      REAL meantaucld(npoints)          !  mean optical thickness 
+                                        !  linear averaging in albedo performed.
+      
+      real meanalbedocld(npoints)        ! mean cloud albedo
+                                        ! linear averaging in albedo performed
+					
+      real meantb(npoints)              ! mean all-sky 10.5 micron brightness temperature
+      
+      real meantbclr(npoints)           ! mean clear-sky 10.5 micron brightness temperature
+      
+      REAL boxtau(npoints,ncol)         !  optical thickness in each column
+      
+      REAL boxptop(npoints,ncol)        !  cloud top pressure (mb) in each column
+                              
+                                                                                          
+!
+!     ------
+!     Working variables added when program updated to mimic Mark Webb's PV-Wave code
+!     ------
+
+      REAL dem(npoints,ncol),bb(npoints)     !  working variables for 10.5 micron longwave 
+                              !  emissivity in part of
+                              !  gridbox under consideration
+
+      REAL ptrop(npoints)
+      REAL attrop(npoints)
+      REAL attropmin (npoints)
+      REAL atmax(npoints)
+      REAL atmin(npoints)
+      REAL btcmin(npoints)
+      REAL transmax(npoints)
+
+      INTEGER i,j,ilev,ibox,itrop(npoints)
+      INTEGER ipres(npoints)
+      INTEGER itau(npoints),ilev2
+      INTEGER acc(nlev,ncol)
+      INTEGER match(npoints,nlev-1)
+      INTEGER nmatch(npoints)
+      INTEGER levmatch(npoints,ncol)
+      
+      !variables needed for water vapor continuum absorption
+      real fluxtop_clrsky(npoints),trans_layers_above_clrsky(npoints)
+      real taumin(npoints)
+      real dem_wv(npoints,nlev), wtmair, wtmh20, Navo, grav, pstd, t0
+      real press(npoints), dpress(npoints), atmden(npoints)
+      real rvh20(npoints), wk(npoints), rhoave(npoints)
+      real rh20s(npoints), rfrgn(npoints)
+      real tmpexp(npoints),tauwv(npoints)
+      
+      character*1 cchar(6),cchar_realtops(6)
+      integer icycle
+      REAL tau(npoints,ncol)
+      LOGICAL box_cloudy(npoints,ncol)
+      REAL tb(npoints,ncol)
+      REAL ptop(npoints,ncol)
+      REAL emcld(npoints,ncol)
+      REAL fluxtop(npoints,ncol)
+      REAL trans_layers_above(npoints,ncol)
+      real isccp_taumin,fluxtopinit(npoints),tauir(npoints)
+      REAL albedocld(npoints,ncol)
+      real boxarea
+      integer debug       ! set to non-zero value to print out inputs
+                    ! with step debug
+      integer debugcol    ! set to non-zero value to print out column
+                    ! decomposition with step debugcol
+      integer rangevec(npoints),rangeerror
+
+      integer index1(npoints),num1,jj,k1,k2
+      real rec2p13,tauchk,logp,logp1,logp2,atd
+      real output_missing_value
+
+      character*10 ftn09
+      
+      DATA isccp_taumin / 0.3 /
+      DATA output_missing_value / -1.E+30 /
+      DATA cchar / ' ','-','1','+','I','+'/
+      DATA cchar_realtops / ' ',' ','1','1','I','I'/
+
+!     ------ End duplicate definitions common to wrapper routine
+
+      tauchk = -1.*log(0.9999999)
+      rec2p13=1./2.13
+
+      ncolprint=0
+
+      if ( debug.ne.0 ) then
+          j=1
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write(6,'(a10)') 'debug='
+          write(6,'(8I10)') debug
+          write(6,'(a10)') 'debugcol='
+          write(6,'(8I10)') debugcol
+          write(6,'(a10)') 'npoints='
+          write(6,'(8I10)') npoints
+          write(6,'(a10)') 'nlev='
+          write(6,'(8I10)') nlev
+          write(6,'(a10)') 'ncol='
+          write(6,'(8I10)') ncol
+          write(6,'(a11)') 'top_height='
+          write(6,'(8I10)') top_height
+	  write(6,'(a21)') 'top_height_direction='
+          write(6,'(8I10)') top_height_direction
+          write(6,'(a10)') 'overlap='
+          write(6,'(8I10)') overlap
+          write(6,'(a10)') 'emsfc_lw='
+          write(6,'(8f10.2)') emsfc_lw
+        do j=1,npoints,debug
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write(6,'(a10)') 'sunlit='
+          write(6,'(8I10)') sunlit(j)
+          write(6,'(a10)') 'pfull='
+          write(6,'(8f10.2)') (pfull(j,i),i=1,nlev)
+          write(6,'(a10)') 'phalf='
+          write(6,'(8f10.2)') (phalf(j,i),i=1,nlev+1)
+          write(6,'(a10)') 'qv='
+          write(6,'(8f10.3)') (qv(j,i),i=1,nlev)
+          write(6,'(a10)') 'cc='
+          write(6,'(8f10.3)') (cc(j,i),i=1,nlev)
+          write(6,'(a10)') 'conv='
+          write(6,'(8f10.2)') (conv(j,i),i=1,nlev)
+          write(6,'(a10)') 'dtau_s='
+          write(6,'(8g12.5)') (dtau_s(j,i),i=1,nlev)
+          write(6,'(a10)') 'dtau_c='
+          write(6,'(8f10.2)') (dtau_c(j,i),i=1,nlev)
+          write(6,'(a10)') 'skt='
+          write(6,'(8f10.2)') skt(j)
+          write(6,'(a10)') 'at='
+          write(6,'(8f10.2)') (at(j,i),i=1,nlev)
+          write(6,'(a10)') 'dem_s='
+          write(6,'(8f10.3)') (dem_s(j,i),i=1,nlev)
+          write(6,'(a10)') 'dem_c='
+          write(6,'(8f10.3)') (dem_c(j,i),i=1,nlev)
+        enddo
+      endif
+
+!     ---------------------------------------------------!
+
+      if (ncolprint.ne.0) then
+      do j=1,npoints,1000
+        write(6,'(a10)') 'j='
+        write(6,'(8I10)') j
+      enddo
+      endif
+
+      if (top_height .eq. 1 .or. top_height .eq. 3) then 
+
+      do j=1,npoints 
+          ptrop(j)=5000.
+          atmin(j) = 400.
+          attropmin(j) = 400.
+          atmax(j) = 0.
+          attrop(j) = 120.
+          itrop(j) = 1
+      enddo 
+
+      do 12 ilev=1,nlev
+        do j=1,npoints 
+         if (pfull(j,ilev) .lt. 40000. .and.
+     &          pfull(j,ilev) .gt.  5000. .and.
+     &          at(j,ilev) .lt. attropmin(j)) then
+                ptrop(j) = pfull(j,ilev)
+                attropmin(j) = at(j,ilev)
+                attrop(j) = attropmin(j)
+                itrop(j)=ilev
+           end if
+           if (at(j,ilev) .gt. atmax(j)) atmax(j)=at(j,ilev)
+           if (at(j,ilev) .lt. atmin(j)) atmin(j)=at(j,ilev)
+        enddo
+12    continue
+
+      end if
+
+
+      if (top_height .eq. 1 .or. top_height .eq. 3) then
+          do j=1,npoints
+              meantb(j) = 0.
+	      meantbclr(j) = 0. 
+          end do
+      else
+          do j=1,npoints
+              meantb(j) = output_missing_value
+       	      meantbclr(j) = output_missing_value
+          end do
+      end if
+      
+!     -----------------------------------------------------!
+
+!     ---------------------------------------------------!
+
+      do ilev=1,nlev
+        do j=1,npoints
+
+          rangevec(j)=0
+
+          if (cc(j,ilev) .lt. 0. .or. cc(j,ilev) .gt. 1.) then
+!           error = cloud fraction less than zero
+!           error = cloud fraction greater than 1
+            rangevec(j)=rangevec(j)+1
+          endif
+
+          if (conv(j,ilev) .lt. 0. .or. conv(j,ilev) .gt. 1.) then
+!           ' error = convective cloud fraction less than zero'
+!           ' error = convective cloud fraction greater than 1'
+            rangevec(j)=rangevec(j)+2
+          endif
+
+          if (dtau_s(j,ilev) .lt. 0.) then
+!           ' error = stratiform cloud opt. depth less than zero'
+            rangevec(j)=rangevec(j)+4
+          endif
+
+          if (dtau_c(j,ilev) .lt. 0.) then
+!           ' error = convective cloud opt. depth less than zero'
+            rangevec(j)=rangevec(j)+8
+          endif
+
+          if (dem_s(j,ilev) .lt. 0. .or. dem_s(j,ilev) .gt. 1.) then
+!             ' error = stratiform cloud emissivity less than zero'
+!             ' error = stratiform cloud emissivity greater than 1'
+            rangevec(j)=rangevec(j)+16
+          endif
+
+          if (dem_c(j,ilev) .lt. 0. .or. dem_c(j,ilev) .gt. 1.) then
+!             ' error = convective cloud emissivity less than zero'
+!             ' error = convective cloud emissivity greater than 1'
+              rangevec(j)=rangevec(j)+32
+          endif
+        enddo
+
+        rangeerror=0
+        do j=1,npoints
+            rangeerror=rangeerror+rangevec(j)
+        enddo
+
+        if (rangeerror.ne.0) then 
+              write (6,*) 'Input variable out of range'
+              write (6,*) 'rangevec:'
+              write (6,*) rangevec
+              call flush(6)
+              STOP
+        endif
+      enddo
+
+!
+!     ---------------------------------------------------!
+
+      
+!
+!     ---------------------------------------------------!
+!     COMPUTE CLOUD OPTICAL DEPTH FOR EACH COLUMN and
+!     put into vector tau
+ 
+      !initialize tau and albedocld to zero
+      do 15 ibox=1,ncol
+        do j=1,npoints 
+            tau(j,ibox)=0.
+          albedocld(j,ibox)=0.
+          boxtau(j,ibox)=output_missing_value
+          boxptop(j,ibox)=output_missing_value
+          box_cloudy(j,ibox)=.false.
+        enddo
+15    continue
+
+      !compute total cloud optical depth for each column     
+      do ilev=1,nlev
+            !increment tau for each of the boxes
+            do ibox=1,ncol
+              do j=1,npoints 
+                 if (frac_out(j,ibox,ilev).eq.1) then
+                        tau(j,ibox)=tau(j,ibox)
+     &                     + dtau_s(j,ilev)
+                 endif
+                 if (frac_out(j,ibox,ilev).eq.2) then
+                        tau(j,ibox)=tau(j,ibox)
+     &                     + dtau_c(j,ilev)
+                 end if
+              enddo
+            enddo ! ibox
+      enddo ! ilev
+          if (ncolprint.ne.0) then
+
+              do j=1,npoints ,1000
+                write(6,'(a10)') 'j='
+                write(6,'(8I10)') j
+                write(6,'(i2,1X,8(f7.2,1X))') 
+     &          ilev,
+     &          (tau(j,ibox),ibox=1,ncolprint)
+              enddo
+          endif 
+!
+!     ---------------------------------------------------!
+
+
+
+!     
+!     ---------------------------------------------------!
+!     COMPUTE INFRARED BRIGHTNESS TEMPERUATRES
+!     AND CLOUD TOP TEMPERATURE SATELLITE SHOULD SEE
+!
+!     again this is only done if top_height = 1 or 3
+!
+!     fluxtop is the 10.5 micron radiance at the top of the
+!              atmosphere
+!     trans_layers_above is the total transmissivity in the layers
+!             above the current layer
+!     fluxtop_clrsky(j) and trans_layers_above_clrsky(j) are the clear
+!             sky versions of these quantities.
+
+      if (top_height .eq. 1 .or. top_height .eq. 3) then
+
+
+        !----------------------------------------------------------------------
+        !    
+        !             DO CLEAR SKY RADIANCE CALCULATION FIRST
+        !
+        !compute water vapor continuum emissivity
+        !this treatment follows Schwarkzopf and Ramasamy
+        !JGR 1999,vol 104, pages 9467-9499.
+        !the emissivity is calculated at a wavenumber of 955 cm-1, 
+        !or 10.47 microns 
+        wtmair = 28.9644
+        wtmh20 = 18.01534
+        Navo = 6.023E+23
+        grav = 9.806650E+02
+        pstd = 1.013250E+06
+        t0 = 296.
+        if (ncolprint .ne. 0) 
+     &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
+        do 125 ilev=1,nlev
+          do j=1,npoints 
+               !press and dpress are dyne/cm2 = Pascals *10
+               press(j) = pfull(j,ilev)*10.
+               dpress(j) = (phalf(j,ilev+1)-phalf(j,ilev))*10
+               !atmden = g/cm2 = kg/m2 / 10 
+               atmden(j) = dpress(j)/grav
+               rvh20(j) = qv(j,ilev)*wtmair/wtmh20
+               wk(j) = rvh20(j)*Navo*atmden(j)/wtmair
+               rhoave(j) = (press(j)/pstd)*(t0/at(j,ilev))
+               rh20s(j) = rvh20(j)*rhoave(j)
+               rfrgn(j) = rhoave(j)-rh20s(j)
+               tmpexp(j) = exp(-0.02*(at(j,ilev)-t0))
+               tauwv(j) = wk(j)*1.e-20*( 
+     &           (0.0224697*rh20s(j)*tmpexp(j)) + 
+     &                (3.41817e-7*rfrgn(j)) )*0.98
+               dem_wv(j,ilev) = 1. - exp( -1. * tauwv(j))
+          enddo
+               if (ncolprint .ne. 0) then
+               do j=1,npoints ,1000
+               write(6,'(a10)') 'j='
+               write(6,'(8I10)') j
+               write(6,'(i2,1X,3(f8.3,3X))') ilev,
+     &           qv(j,ilev)*(phalf(j,ilev+1)-phalf(j,ilev))/(grav/100.),
+     &           tauwv(j),dem_wv(j,ilev)
+               enddo
+             endif
+125     continue
+
+        !initialize variables
+        do j=1,npoints 
+          fluxtop_clrsky(j) = 0.
+          trans_layers_above_clrsky(j)=1.
+        enddo
+
+        do ilev=1,nlev
+          do j=1,npoints 
+ 
+            ! Black body emission at temperature of the layer
+
+              bb(j)=1 / ( exp(1307.27/at(j,ilev)) - 1. )
+              !bb(j)= 5.67e-8*at(j,ilev)**4
+
+              ! increase TOA flux by flux emitted from layer
+              ! times total transmittance in layers above
+
+                fluxtop_clrsky(j) = fluxtop_clrsky(j) 
+     &            + dem_wv(j,ilev)*bb(j)*trans_layers_above_clrsky(j) 
+            
+                ! update trans_layers_above with transmissivity
+              ! from this layer for next time around loop
+
+                trans_layers_above_clrsky(j)=
+     &            trans_layers_above_clrsky(j)*(1.-dem_wv(j,ilev))
+                   
+
+          enddo   
+            if (ncolprint.ne.0) then
+             do j=1,npoints ,1000
+              write(6,'(a10)') 'j='
+              write(6,'(8I10)') j
+              write (6,'(a)') 'ilev:'
+              write (6,'(I2)') ilev
+    
+              write (6,'(a)') 
+     &        'emiss_layer,100.*bb(j),100.*f,total_trans:'
+              write (6,'(4(f7.2,1X))') dem_wv(j,ilev),100.*bb(j),
+     &             100.*fluxtop_clrsky(j),trans_layers_above_clrsky(j)
+             enddo   
+            endif
+
+        enddo   !loop over level
+        
+        do j=1,npoints 
+          !add in surface emission
+          bb(j)=1/( exp(1307.27/skt(j)) - 1. )
+          !bb(j)=5.67e-8*skt(j)**4
+
+          fluxtop_clrsky(j) = fluxtop_clrsky(j) + emsfc_lw * bb(j) 
+     &     * trans_layers_above_clrsky(j)
+     
+          !clear sky brightness temperature
+          meantbclr(j) = 1307.27/(log(1.+(1./fluxtop_clrsky(j))))
+	  
+        enddo
+
+        if (ncolprint.ne.0) then
+        do j=1,npoints ,1000
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write (6,'(a)') 'id:'
+          write (6,'(a)') 'surface'
+
+          write (6,'(a)') 'emsfc,100.*bb(j),100.*f,total_trans:'
+          write (6,'(5(f7.2,1X))') emsfc_lw,100.*bb(j),
+     &      100.*fluxtop_clrsky(j),
+     &       trans_layers_above_clrsky(j), meantbclr(j)
+        enddo
+      endif
+    
+
+        !
+        !           END OF CLEAR SKY CALCULATION
+        !
+        !----------------------------------------------------------------
+
+
+
+        if (ncolprint.ne.0) then
+
+        do j=1,npoints ,1000
+            write(6,'(a10)') 'j='
+            write(6,'(8I10)') j
+            write (6,'(a)') 'ts:'
+            write (6,'(8f7.2)') (skt(j),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'ta_rev:'
+            write (6,'(8f7.2)') 
+     &       ((at(j,ilev2),ibox=1,ncolprint),ilev2=1,nlev)
+
+        enddo
+        endif 
+        !loop over columns 
+        do ibox=1,ncol
+          do j=1,npoints
+            fluxtop(j,ibox)=0.
+            trans_layers_above(j,ibox)=1.
+          enddo
+        enddo
+
+        do ilev=1,nlev
+              do j=1,npoints 
+                ! Black body emission at temperature of the layer
+
+              bb(j)=1 / ( exp(1307.27/at(j,ilev)) - 1. )
+              !bb(j)= 5.67e-8*at(j,ilev)**4
+              enddo
+
+            do ibox=1,ncol
+              do j=1,npoints 
+
+              ! emissivity for point in this layer
+                if (frac_out(j,ibox,ilev).eq.1) then
+                dem(j,ibox)= 1. - 
+     &             ( (1. - dem_wv(j,ilev)) * (1. -  dem_s(j,ilev)) )
+                else if (frac_out(j,ibox,ilev).eq.2) then
+                dem(j,ibox)= 1. - 
+     &             ( (1. - dem_wv(j,ilev)) * (1. -  dem_c(j,ilev)) )
+                else
+                dem(j,ibox)=  dem_wv(j,ilev)
+                end if
+                
+
+                ! increase TOA flux by flux emitted from layer
+              ! times total transmittance in layers above
+
+                fluxtop(j,ibox) = fluxtop(j,ibox) 
+     &            + dem(j,ibox) * bb(j)
+     &            * trans_layers_above(j,ibox) 
+            
+                ! update trans_layers_above with transmissivity
+              ! from this layer for next time around loop
+
+                trans_layers_above(j,ibox)=
+     &            trans_layers_above(j,ibox)*(1.-dem(j,ibox))
+
+              enddo ! j
+            enddo ! ibox
+
+            if (ncolprint.ne.0) then
+              do j=1,npoints,1000
+              write (6,'(a)') 'ilev:'
+              write (6,'(I2)') ilev
+    
+              write(6,'(a10)') 'j='
+              write(6,'(8I10)') j
+              write (6,'(a)') 'emiss_layer:'
+              write (6,'(8f7.2)') (dem(j,ibox),ibox=1,ncolprint)
+        
+              write (6,'(a)') '100.*bb(j):'
+              write (6,'(8f7.2)') (100.*bb(j),ibox=1,ncolprint)
+        
+              write (6,'(a)') '100.*f:'
+              write (6,'(8f7.2)') 
+     &         (100.*fluxtop(j,ibox),ibox=1,ncolprint)
+        
+              write (6,'(a)') 'total_trans:'
+              write (6,'(8f7.2)') 
+     &          (trans_layers_above(j,ibox),ibox=1,ncolprint)
+            enddo
+          endif
+
+        enddo ! ilev
+
+
+          do j=1,npoints 
+            !add in surface emission
+            bb(j)=1/( exp(1307.27/skt(j)) - 1. )
+            !bb(j)=5.67e-8*skt(j)**4
+          end do
+
+        do ibox=1,ncol
+          do j=1,npoints 
+
+            !add in surface emission
+
+            fluxtop(j,ibox) = fluxtop(j,ibox) 
+     &         + emsfc_lw * bb(j) 
+     &         * trans_layers_above(j,ibox) 
+            
+          end do
+        end do
+
+        !calculate mean infrared brightness temperature
+        do ibox=1,ncol
+          do j=1,npoints 
+            meantb(j) = meantb(j)+1307.27/(log(1.+(1./fluxtop(j,ibox))))
+	  end do
+        end do
+	  do j=1, npoints
+	    meantb(j) = meantb(j) / real(ncol)
+	  end do        
+
+        if (ncolprint.ne.0) then
+
+          do j=1,npoints ,1000
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write (6,'(a)') 'id:'
+          write (6,'(a)') 'surface'
+
+          write (6,'(a)') 'emiss_layer:'
+          write (6,'(8f7.2)') (dem(1,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') '100.*bb(j):'
+          write (6,'(8f7.2)') (100.*bb(j),ibox=1,ncolprint)
+    
+          write (6,'(a)') '100.*f:'
+          write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
+          
+	  write (6,'(a)') 'meantb(j):'
+          write (6,'(8f7.2)') (meantb(j),ibox=1,ncolprint)
+      
+          end do
+      endif
+    
+        !now that you have the top of atmosphere radiance account
+        !for ISCCP procedures to determine cloud top temperature
+
+        !account for partially transmitting cloud recompute flux 
+        !ISCCP would see assuming a single layer cloud
+        !note choice here of 2.13, as it is primarily ice
+        !clouds which have partial emissivity and need the 
+        !adjustment performed in this section
+        !
+      !If it turns out that the cloud brightness temperature
+      !is greater than 260K, then the liquid cloud conversion
+        !factor of 2.56 is used.
+      !
+        !Note that this is discussed on pages 85-87 of 
+        !the ISCCP D level documentation (Rossow et al. 1996)
+           
+          do j=1,npoints  
+            !compute minimum brightness temperature and optical depth
+            btcmin(j) = 1. /  ( exp(1307.27/(attrop(j)-5.)) - 1. ) 
+          enddo 
+        do ibox=1,ncol
+          do j=1,npoints  
+            transmax(j) = (fluxtop(j,ibox)-btcmin(j))
+     &                /(fluxtop_clrsky(j)-btcmin(j))
+          !note that the initial setting of tauir(j) is needed so that
+          !tauir(j) has a realistic value should the next if block be
+          !bypassed
+            tauir(j) = tau(j,ibox) * rec2p13
+            taumin(j) = -1. * log(max(min(transmax(j),0.9999999),0.001))
+
+          enddo 
+
+          if (top_height .eq. 1) then
+            do j=1,npoints  
+              if (transmax(j) .gt. 0.001 .and. 
+     &          transmax(j) .le. 0.9999999) then
+                fluxtopinit(j) = fluxtop(j,ibox)
+              tauir(j) = tau(j,ibox) *rec2p13
+              endif
+            enddo
+            do icycle=1,2
+              do j=1,npoints  
+                if (tau(j,ibox) .gt. (tauchk            )) then 
+                if (transmax(j) .gt. 0.001 .and. 
+     &            transmax(j) .le. 0.9999999) then
+                  emcld(j,ibox) = 1. - exp(-1. * tauir(j)  )
+                  fluxtop(j,ibox) = fluxtopinit(j) -   
+     &              ((1.-emcld(j,ibox))*fluxtop_clrsky(j))
+                  fluxtop(j,ibox)=max(1.E-06,
+     &              (fluxtop(j,ibox)/emcld(j,ibox)))
+                  tb(j,ibox)= 1307.27
+     &              / (log(1. + (1./fluxtop(j,ibox))))
+                  if (tb(j,ibox) .gt. 260.) then
+                  tauir(j) = tau(j,ibox) / 2.56
+                  end if                   
+                end if
+                end if
+              enddo
+            enddo
+                
+          endif
+        
+          do j=1,npoints
+            if (tau(j,ibox) .gt. (tauchk            )) then 
+                !cloudy box 
+		!NOTE: tb is the cloud-top temperature not infrared brightness temperature 
+		!at this point in the code
+                tb(j,ibox)= 1307.27/ (log(1. + (1./fluxtop(j,ibox))))
+                if (top_height.eq.1.and.tauir(j).lt.taumin(j)) then
+                         tb(j,ibox) = attrop(j) - 5. 
+                   tau(j,ibox) = 2.13*taumin(j)
+                end if
+            else
+                !clear sky brightness temperature
+                tb(j,ibox) = meantbclr(j)
+            end if
+          enddo ! j
+        enddo ! ibox
+
+        if (ncolprint.ne.0) then
+
+          do j=1,npoints,1000
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+
+          write (6,'(a)') 'attrop:'
+          write (6,'(8f7.2)') (attrop(j))
+    
+          write (6,'(a)') 'btcmin:'
+          write (6,'(8f7.2)') (btcmin(j))
+    
+          write (6,'(a)') 'fluxtop_clrsky*100:'
+          write (6,'(8f7.2)') 
+     &      (100.*fluxtop_clrsky(j))
+
+          write (6,'(a)') '100.*f_adj:'
+          write (6,'(8f7.2)') (100.*fluxtop(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'transmax:'
+          write (6,'(8f7.2)') (transmax(ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'tau:'
+          write (6,'(8f7.2)') (tau(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'emcld:'
+          write (6,'(8f7.2)') (emcld(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'total_trans:'
+          write (6,'(8f7.2)') 
+     &        (trans_layers_above(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'total_emiss:'
+          write (6,'(8f7.2)') 
+     &        (1.0-trans_layers_above(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'total_trans:'
+          write (6,'(8f7.2)') 
+     &        (trans_layers_above(j,ibox),ibox=1,ncolprint)
+    
+          write (6,'(a)') 'ppout:'
+          write (6,'(8f7.2)') (tb(j,ibox),ibox=1,ncolprint)
+          enddo ! j
+      endif
+
+      end if
+
+!     ---------------------------------------------------!
+
+!     
+!     ---------------------------------------------------!
+!     DETERMINE CLOUD TOP PRESSURE
+!
+!     again the 2 methods differ according to whether
+!     or not you use the physical cloud top pressure (top_height = 2)
+!     or the radiatively determined cloud top pressure (top_height = 1 or 3)
+!
+
+      !compute cloud top pressure
+      do 30 ibox=1,ncol
+        !segregate according to optical thickness
+        if (top_height .eq. 1 .or. top_height .eq. 3) then  
+          !find level whose temperature
+          !most closely matches brightness temperature
+          do j=1,npoints 
+            nmatch(j)=0
+          enddo
+          do 29 k1=1,nlev-1
+	    if (top_height_direction .eq. 2) then
+	      ilev = nlev - k1 
+	    else
+	      ilev = k1
+	    end if
+            !cdir nodep
+            do j=1,npoints 
+	     if (ilev .ge. itrop(j)) then
+              if ((at(j,ilev)   .ge. tb(j,ibox) .and. 
+     &          at(j,ilev+1) .le. tb(j,ibox)) .or.
+     &          (at(j,ilev) .le. tb(j,ibox) .and. 
+     &          at(j,ilev+1) .ge. tb(j,ibox))) then 
+                nmatch(j)=nmatch(j)+1
+		match(j,nmatch(j))=ilev
+              end if  
+	     end if                         
+            enddo
+29        continue
+
+          do j=1,npoints 
+            if (nmatch(j) .ge. 1) then
+              k1 = match(j,nmatch(j))
+	      k2 = k1 + 1
+              logp1 = log(pfull(j,k1))
+              logp2 = log(pfull(j,k2))
+	      atd = max(tauchk,abs(at(j,k2) - at(j,k1)))
+              logp=logp1+(logp2-logp1)*abs(tb(j,ibox)-at(j,k1))/atd
+              ptop(j,ibox) = exp(logp)
+	      if(abs(pfull(j,k1)-ptop(j,ibox)) .lt.
+     &            abs(pfull(j,k2)-ptop(j,ibox))) then
+                 levmatch(j,ibox)=k1
+              else
+                 levmatch(j,ibox)=k2
+              end if   
+            else
+              if (tb(j,ibox) .le. attrop(j)) then
+                ptop(j,ibox)=ptrop(j)
+                levmatch(j,ibox)=itrop(j)
+              end if
+              if (tb(j,ibox) .ge. atmax(j)) then
+                ptop(j,ibox)=pfull(j,nlev)
+                levmatch(j,ibox)=nlev
+              end if                                
+            end if
+          enddo ! j
+
+        else ! if (top_height .eq. 1 .or. top_height .eq. 3) 
+ 
+          do j=1,npoints     
+            ptop(j,ibox)=0.
+          enddo
+          do ilev=1,nlev
+            do j=1,npoints     
+              if ((ptop(j,ibox) .eq. 0. )
+     &           .and.(frac_out(j,ibox,ilev) .ne. 0)) then
+                ptop(j,ibox)=phalf(j,ilev)
+              levmatch(j,ibox)=ilev
+              end if
+            end do
+          end do
+        end if                            
+          
+        do j=1,npoints
+          if (tau(j,ibox) .le. (tauchk            )) then
+            ptop(j,ibox)=0.
+            levmatch(j,ibox)=0      
+          endif 
+        enddo
+
+30    continue
+              
+!
+!
+!     ---------------------------------------------------!
+
+
+!     
+!     ---------------------------------------------------!
+!     DETERMINE ISCCP CLOUD TYPE FREQUENCIES
+!
+!     Now that ptop and tau have been determined, 
+!     determine amount of each of the 49 ISCCP cloud
+!     types
+!
+!     Also compute grid box mean cloud top pressure and
+!     optical thickness.  The mean cloud top pressure and
+!     optical thickness are averages over the cloudy 
+!     area only. The mean cloud top pressure is a linear
+!     average of the cloud top pressures.  The mean cloud
+!     optical thickness is computed by converting optical
+!     thickness to an albedo, averaging in albedo units,
+!     then converting the average albedo back to a mean
+!     optical thickness.  
+!
+
+      !compute isccp frequencies
+
+      !reset frequencies
+      do 38 ilev=1,7
+      do 38 ilev2=1,7
+        do j=1,npoints ! 
+             if (sunlit(j).eq.1 .or. top_height .eq. 3) then 
+                fq_isccp(j,ilev,ilev2)= 0.
+	     else
+	        fq_isccp(j,ilev,ilev2)= output_missing_value
+	     end if
+        enddo
+38    continue
+
+      !reset variables need for averaging cloud properties
+      do j=1,npoints 
+        if (sunlit(j).eq.1 .or. top_height .eq. 3) then 
+             totalcldarea(j) = 0.
+             meanalbedocld(j) = 0.
+             meanptop(j) = 0.
+             meantaucld(j) = 0.
+	else
+             totalcldarea(j) = output_missing_value
+             meanalbedocld(j) = output_missing_value
+             meanptop(j) = output_missing_value
+             meantaucld(j) = output_missing_value
+	end if
+      enddo ! j
+
+      boxarea = 1./real(ncol)
+     
+      do 39 ibox=1,ncol
+        do j=1,npoints 
+
+          if (tau(j,ibox) .gt. (tauchk            )
+     &      .and. ptop(j,ibox) .gt. 0.) then
+              box_cloudy(j,ibox)=.true.
+          endif
+
+          if (box_cloudy(j,ibox)) then
+
+              if (sunlit(j).eq.1 .or. top_height .eq. 3) then
+
+                boxtau(j,ibox) = tau(j,ibox)
+
+		if (tau(j,ibox) .ge. isccp_taumin) then
+		   totalcldarea(j) = totalcldarea(j) + boxarea
+		
+                   !convert optical thickness to albedo
+                   albedocld(j,ibox)
+     &		   = (tau(j,ibox)**0.895)/((tau(j,ibox)**0.895)+6.82)
+         
+                   !contribute to averaging
+                   meanalbedocld(j) = meanalbedocld(j) 
+     &                                +albedocld(j,ibox)*boxarea
+
+                end if
+
+            endif
+
+          endif
+
+          if (sunlit(j).eq.1 .or. top_height .eq. 3) then 
+
+           if (box_cloudy(j,ibox)) then
+          
+              !convert ptop to millibars
+              ptop(j,ibox)=ptop(j,ibox) / 100.
+            
+              !save for output cloud top pressure and optical thickness
+              boxptop(j,ibox) = ptop(j,ibox)
+    
+              if (tau(j,ibox) .ge. isccp_taumin) then
+	      	meanptop(j) = meanptop(j) + ptop(j,ibox)*boxarea
+              end if		
+
+              !reset itau(j), ipres(j)
+              itau(j) = 0
+              ipres(j) = 0
+
+              !determine optical depth category
+              if (tau(j,ibox) .lt. isccp_taumin) then
+                  itau(j)=1
+              else if (tau(j,ibox) .ge. isccp_taumin
+     &                                    
+     &          .and. tau(j,ibox) .lt. 1.3) then
+                itau(j)=2
+              else if (tau(j,ibox) .ge. 1.3 
+     &          .and. tau(j,ibox) .lt. 3.6) then
+                itau(j)=3
+              else if (tau(j,ibox) .ge. 3.6 
+     &          .and. tau(j,ibox) .lt. 9.4) then
+                  itau(j)=4
+              else if (tau(j,ibox) .ge. 9.4 
+     &          .and. tau(j,ibox) .lt. 23.) then
+                  itau(j)=5
+              else if (tau(j,ibox) .ge. 23. 
+     &          .and. tau(j,ibox) .lt. 60.) then
+                  itau(j)=6
+              else if (tau(j,ibox) .ge. 60.) then
+                  itau(j)=7
+              end if
+
+              !determine cloud top pressure category
+              if (    ptop(j,ibox) .gt. 0.  
+     &          .and.ptop(j,ibox) .lt. 180.) then
+                  ipres(j)=1
+              else if(ptop(j,ibox) .ge. 180.
+     &          .and.ptop(j,ibox) .lt. 310.) then
+                  ipres(j)=2
+              else if(ptop(j,ibox) .ge. 310.
+     &          .and.ptop(j,ibox) .lt. 440.) then
+                  ipres(j)=3
+              else if(ptop(j,ibox) .ge. 440.
+     &          .and.ptop(j,ibox) .lt. 560.) then
+                  ipres(j)=4
+              else if(ptop(j,ibox) .ge. 560.
+     &          .and.ptop(j,ibox) .lt. 680.) then
+                  ipres(j)=5
+              else if(ptop(j,ibox) .ge. 680.
+     &          .and.ptop(j,ibox) .lt. 800.) then
+                  ipres(j)=6
+              else if(ptop(j,ibox) .ge. 800.) then
+                  ipres(j)=7
+              end if 
+
+              !update frequencies
+              if(ipres(j) .gt. 0.and.itau(j) .gt. 0) then
+              fq_isccp(j,itau(j),ipres(j))=
+     &          fq_isccp(j,itau(j),ipres(j))+ boxarea
+              end if
+
+            end if
+
+          end if
+                       
+        enddo ! j
+39    continue
+      
+      !compute mean cloud properties
+      do j=1,npoints 
+        if (totalcldarea(j) .gt. 0.) then
+	  ! code above guarantees that totalcldarea > 0 
+	  ! only if sunlit .eq. 1 .or. top_height = 3 
+	  ! and applies only to clouds with tau > isccp_taumin
+          meanptop(j) = meanptop(j) / totalcldarea(j)
+          meanalbedocld(j) = meanalbedocld(j) / totalcldarea(j)
+          meantaucld(j) = (6.82/((1./meanalbedocld(j))-1.))**(1./0.895)
+	else
+	  ! this code is necessary so that in the case that totalcldarea = 0.,
+	  ! that these variables, which are in-cloud averages, are set to missing
+	  ! note that totalcldarea will be 0. if all the clouds in the grid box have
+	  ! tau < isccp_taumin 
+	  meanptop(j) = output_missing_value
+          meanalbedocld(j) = output_missing_value
+          meantaucld(j) = output_missing_value
+        end if
+      enddo ! j
+!
+!     ---------------------------------------------------!
+
+!     ---------------------------------------------------!
+!     OPTIONAL PRINTOUT OF DATA TO CHECK PROGRAM
+!
+      if (debugcol.ne.0) then
+!     
+         do j=1,npoints,debugcol
+
+            !produce character output
+            do ilev=1,nlev
+              do ibox=1,ncol
+                   acc(ilev,ibox)=0
+              enddo
+            enddo
+
+            do ilev=1,nlev
+              do ibox=1,ncol
+                   acc(ilev,ibox)=frac_out(j,ibox,ilev)*2
+                   if (levmatch(j,ibox) .eq. ilev) 
+     &                 acc(ilev,ibox)=acc(ilev,ibox)+1
+              enddo
+            enddo
+
+             !print test
+
+          write(ftn09,11) j
+11        format('ftn09.',i4.4)
+          open(9, FILE=ftn09, FORM='FORMATTED')
+
+             write(9,'(a1)') ' '
+             write(9,'(10i5)')
+     &                  (ilev,ilev=5,nlev,5)
+             write(9,'(a1)') ' '
+             
+             do ibox=1,ncol
+               write(9,'(40(a1),1x,40(a1))')
+     &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev) 
+     &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev) 
+             end do
+             close(9)
+
+             if (ncolprint.ne.0) then
+               write(6,'(a1)') ' '
+                    write(6,'(a2,1X,5(a7,1X),a50)') 
+     &                  'ilev',
+     &                  'pfull','at',
+     &                  'cc*100','dem_s','dtau_s',
+     &                  'cchar'
+
+!               do 4012 ilev=1,nlev
+!                    write(6,'(60i2)') (box(i,ilev),i=1,ncolprint)
+!                   write(6,'(i2,1X,5(f7.2,1X),50(a1))') 
+!     &                  ilev,
+!     &                  pfull(j,ilev)/100.,at(j,ilev),
+!     &                  cc(j,ilev)*100.0,dem_s(j,ilev),dtau_s(j,ilev)
+!     &                  ,(cchar(acc(ilev,ibox)+1),ibox=1,ncolprint)
+!4012           continue
+               write (6,'(a)') 'skt(j):'
+               write (6,'(8f7.2)') skt(j)
+                                      
+               write (6,'(8I7)') (ibox,ibox=1,ncolprint)
+            
+               write (6,'(a)') 'tau:'
+               write (6,'(8f7.2)') (tau(j,ibox),ibox=1,ncolprint)
+    
+               write (6,'(a)') 'tb:'
+               write (6,'(8f7.2)') (tb(j,ibox),ibox=1,ncolprint)
+    
+               write (6,'(a)') 'ptop:'
+               write (6,'(8f7.2)') (ptop(j,ibox),ibox=1,ncolprint)
+             endif 
+    
+        enddo
+       
+      end if 
+
+      return
+      end 
+
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histdayCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histdayCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histdayCOSP.h	(revision 1262)
@@ -0,0 +1,192 @@
+! Abderrahmane Idelkadi Septebmre 2009
+! Sorties journalieres de COSP 
+! Pour l'instant sorties Lidar et ISCCP
+!
+! sorties par jour
+!
+        zstoday = ecrit_day
+        zout = freq_COSP
+!
+!       PRINT*, 'La frequence de sortie hf3d est de ', ecrit_hf
+!
+
+        idayref = day_ref
+        CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+
+        CALL histbeg_phy("histdayCOSP",itau_phy,zjulian,dtime,nhori,nid_day_cosp) 
+
+! Definition de l'axe vertical
+        CALL histvert(nid_day_cosp,"height","height","m",Nlevout,vgrid%z,nvert)
+        print*,'Ok height Nlevout, height =',Nlevout,vgrid%z
+        CALL histvert(nid_day_cosp,"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertm)
+        print*,'Ok height_mlev Nlevout, height_mlev =',Nlevout,vgrid%mz
+!        CALL histvert(nid_day_cosp,"presnivs","Vertical levels","mb",Nlevout,presnivs,nvert)
+
+        CALL histvert(nid_day_cosp,"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp)
+
+        CALL histvert(nid_day_cosp,"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp)
+
+        CALL histvert(nid_day_cosp,"column","column","count",Ncolumns,column_ax,nvertcol)
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+         CALL histdef(nid_day_cosp, "cllcalipso", &
+                     "Lidar Low-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+         endif
+         if (cfg%Lclhcalipso) then
+         CALL histdef(nid_day_cosp, "clhcalipso", &
+                     "Lidar High-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+         endif
+         if (cfg%Lclmcalipso) then
+         CALL histdef(nid_day_cosp, "clmcalipso", &
+                     "Lidar Mid-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+         endif
+         if (cfg%Lcltcalipso) then
+         CALL histdef(nid_day_cosp, "cltcalipso", &
+                     "Lidar Total Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+         endif
+         if (cfg%Lclcalipso) then
+         CALL histdef(nid_day_cosp, "clcalipso", &
+                     "Lidar Cloud Fraction (532 nm)", "1", &
+                     iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                     "ave(X)", zout,zstoday)
+         endif
+           if (cfg%Lcfad_lidarsr532) then
+              do ii=1,SR_BINS
+               CALL histdef(nid_day_cosp, "cfad_lidarsr532_"//chcol(ii), &
+                           "Lidar Scattering Ratio CFAD (532 nm)","1", &
+                           iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                           "ave(X)", zout,zstoday)   
+              enddo
+           endif
+           if (cfg%Lparasol_refl) then
+            CALL histdef(nid_day_cosp, "parasol_refl", &
+                        "PARASOL-like mono-directional reflectance","1", &
+                        iim,jj_nb,nhori, PARASOL_NREFL,1, PARASOL_NREFL, nvertp,32, &
+                        "ave(X)", zout,zstoday)   
+           endif
+           if (cfg%Latb532) then
+            do ii=1,Ncolumns
+             CALL histdef(nid_day_cosp, "atb532_"//chcol(ii), &
+                         "Lidar Attenuated Total Backscatter (532 nm)","1", &
+                         iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstoday)
+            enddo
+           endif
+           if (cfg%Lbeta_mol532) then
+            CALL histdef(nid_day_cosp, "beta_mol532", &
+                        "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", &
+                        iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstoday)
+           endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%Lcfad_dbze94) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+         if (cfg%Lclisccp2) then
+            do ii=1,7
+             CALL histdef(nid_day_cosp, "clisccp2_"//chcol(ii), &
+                         "Cloud Fraction as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,7,1,7,nvertisccp, 32, &
+                         "ave(X)", zout,zstoday)
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+            CALL histdef(nid_day_cosp, "boxtauisccp", &
+                         "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Lboxptopisccp) then
+            CALL histdef(nid_day_cosp, "boxptopisccp", &
+                         "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Ltclisccp) then
+           CALL histdef(nid_day_cosp, "tclisccp", &
+                     "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Lctpisccp) then
+            CALL histdef(nid_day_cosp, "ctpisccp", &
+                     "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Ltauisccp) then
+           CALL histdef(nid_day_cosp, "tauisccp", &
+                     "Optical Depth as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Lalbisccp) then
+           CALL histdef(nid_day_cosp, "albisccp", &
+                     "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstoday) 
+          endif
+          if (cfg%Lmeantbisccp) then
+            CALL histdef(nid_day_cosp, "meantbisccp", &
+             " Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstoday)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+           CALL histdef(nid_day_cosp, "meantbclrisccp", &
+            "Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstoday) 
+          endif
+        endif ! Isccp
+
+
+        CALL histend(nid_day_cosp)
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histhfCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histhfCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histhfCOSP.h	(revision 1262)
@@ -0,0 +1,192 @@
+! Abderrahmane Idelkadi Septebmre 2009
+! Sorties journalieres de COSP 
+! Pour l'instant sorties Lidar et ISCCP
+!
+! sorties par jour
+!
+        zstohf = ecrit_hf
+        zout = freq_COSP
+!
+!       PRINT*, 'La frequence de sortie hf3d est de ', ecrit_hf
+!
+
+        idayref = day_ref
+        CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+
+        CALL histbeg_phy("histhfCOSP",itau_phy,zjulian,dtime,nhori,nid_hf_cosp) 
+
+! Definition de l'axe vertical
+        CALL histvert(nid_hf_cosp,"height","height","m",Nlevout,vgrid%z,nvert)
+        print*,'Ok height Nlevout, height =',Nlevout,vgrid%z
+        CALL histvert(nid_hf_cosp,"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertm)
+        print*,'Ok height_mlev Nlevout height_mlev =',Nlevout,vgrid%mz
+!        CALL histvert(nid_hf_cosp,"presnivs","Vertical levels","mb",Nlevout,presnivs,nvert)
+
+        CALL histvert(nid_hf_cosp,"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp)
+
+        CALL histvert(nid_hf_cosp,"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp)
+
+        CALL histvert(nid_hf_cosp,"column","column","count",Ncolumns,column_ax,nvertcol)
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+         CALL histdef(nid_hf_cosp, "cllcalipso", &
+                     "Lidar Low-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+         endif
+         if (cfg%Lclhcalipso) then
+         CALL histdef(nid_hf_cosp, "clhcalipso", &
+                     "Lidar High-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+         endif
+         if (cfg%Lclmcalipso) then
+         CALL histdef(nid_hf_cosp, "clmcalipso", &
+                     "Lidar Mid-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+         endif
+         if (cfg%Lcltcalipso) then
+         CALL histdef(nid_hf_cosp, "cltcalipso", &
+                     "Lidar Total Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+         endif
+         if (cfg%Lclcalipso) then
+         CALL histdef(nid_hf_cosp, "clcalipso", &
+                     "Lidar Cloud Fraction (532 nm)", "1", &
+                     iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                     "ave(X)", zout,zstohf)
+         endif
+           if (cfg%Lcfad_lidarsr532) then
+              do ii=1,SR_BINS
+               CALL histdef(nid_hf_cosp, "cfad_lidarsr532_"//chcol(ii), &
+                           "Lidar Scattering Ratio CFAD (532 nm)","1", &
+                           iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                           "ave(X)", zout,zstohf)   
+              enddo
+           endif
+           if (cfg%Lparasol_refl) then
+            CALL histdef(nid_hf_cosp, "parasol_refl", &
+                        "PARASOL-like mono-directional reflectance","1", &
+                        iim,jj_nb,nhori, PARASOL_NREFL,1, PARASOL_NREFL, nvertp,32, &
+                        "ave(X)", zout,zstohf)   
+           endif
+           if (cfg%Latb532) then
+            do ii=1,Ncolumns
+             CALL histdef(nid_hf_cosp, "atb532_"//chcol(ii), &
+                         "Lidar Attenuated Total Backscatter (532 nm)","1", &
+                         iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstohf)
+            enddo
+           endif
+           if (cfg%Lbeta_mol532) then
+            CALL histdef(nid_hf_cosp, "beta_mol532", &
+                        "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", &
+                        iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstohf)
+           endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%Lcfad_dbze94) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+         if (cfg%Lclisccp2) then
+            do ii=1,7
+             CALL histdef(nid_hf_cosp, "clisccp2_"//chcol(ii), &
+                         "Cloud Fraction as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,7,1,7,nvertisccp, 32, &
+                         "ave(X)", zout,zstohf)
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+            CALL histdef(nid_hf_cosp, "boxtauisccp", &
+                         "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Lboxptopisccp) then
+            CALL histdef(nid_hf_cosp, "boxptopisccp", &
+                         "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Ltclisccp) then
+           CALL histdef(nid_hf_cosp, "tclisccp", &
+                     "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Lctpisccp) then
+            CALL histdef(nid_hf_cosp, "ctpisccp", &
+                     "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Ltauisccp) then
+           CALL histdef(nid_hf_cosp, "tauisccp", &
+                     "Optical Depth as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Lalbisccp) then
+           CALL histdef(nid_hf_cosp, "albisccp", &
+                     "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstohf) 
+          endif
+          if (cfg%Lmeantbisccp) then
+            CALL histdef(nid_hf_cosp, "meantbisccp", &
+             " Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstohf)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+           CALL histdef(nid_hf_cosp, "meantbclrisccp", &
+            "Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstohf) 
+          endif
+        endif ! Isccp
+
+
+        CALL histend(nid_hf_cosp)
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histmthCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histmthCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/ini_histmthCOSP.h	(revision 1262)
@@ -0,0 +1,190 @@
+! Abderrahmane Idelkadi Septebmre 2009
+! Sorties journalieres de COSP 
+! Pour l'instant sorties Lidar et ISCCP
+!
+! sorties par jour
+!
+        zstomth = ecrit_mth
+        zout = freq_COSP
+!
+!       PRINT*, 'La frequence de sortie hf3d est de ', ecrit_hf
+!
+
+        idayref = day_ref
+        CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
+
+        CALL histbeg_phy("histmthCOSP",itau_phy,zjulian,dtime,nhori,nid_mth_cosp) 
+
+! Definition de l'axe vertical
+        CALL histvert(nid_mth_cosp,"height","height","m",Nlevout,vgrid%z,nvert)
+        CALL histvert(nid_mth_cosp,"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertm)
+!        CALL histvert(nid_mth_cosp,"presnivs","Vertical levels","mb",Nlevout,presnivs,nvert)
+
+        CALL histvert(nid_mth_cosp,"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp)
+
+        CALL histvert(nid_mth_cosp,"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp)
+
+        CALL histvert(nid_mth_cosp,"column","column","count",Ncolumns,column_ax,nvertcol)
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+         CALL histdef(nid_mth_cosp, "cllcalipso", &
+                     "Lidar Low-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+         endif
+         if (cfg%Lclhcalipso) then
+         CALL histdef(nid_mth_cosp, "clhcalipso", &
+                     "Lidar High-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+         endif
+         if (cfg%Lclmcalipso) then
+         CALL histdef(nid_mth_cosp, "clmcalipso", &
+                     "Lidar Mid-level Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+         endif
+         if (cfg%Lcltcalipso) then
+         CALL histdef(nid_mth_cosp, "cltcalipso", &
+                     "Lidar Total Cloud Fraction", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+         endif
+         if (cfg%Lclcalipso) then
+         CALL histdef(nid_mth_cosp, "clcalipso", &
+                     "Lidar Cloud Fraction (532 nm)", "1", &
+                     iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                     "ave(X)", zout,zstomth)
+         endif
+           if (cfg%Lcfad_lidarsr532) then
+              do ii=1,SR_BINS
+               CALL histdef(nid_mth_cosp, "cfad_lidarsr532_"//chcol(ii), &
+                           "Lidar Scattering Ratio CFAD (532 nm)","1", &
+                           iim,jj_nb,nhori, Nlevout,1,Nlevout,nvert, 32, &
+                           "ave(X)", zout,zstomth)   
+              enddo
+           endif
+           if (cfg%Lparasol_refl) then
+            CALL histdef(nid_mth_cosp, "parasol_refl", &
+                        "PARASOL-like mono-directional reflectance","1", &
+                        iim,jj_nb,nhori, PARASOL_NREFL,1, PARASOL_NREFL, nvertp,32, &
+                        "ave(X)", zout,zstomth)   
+           endif
+           if (cfg%Latb532) then
+            do ii=1,Ncolumns
+             CALL histdef(nid_mth_cosp, "atb532_"//chcol(ii), &
+                         "Lidar Attenuated Total Backscatter (532 nm)","1", &
+                         iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstomth)
+            enddo
+           endif
+           if (cfg%Lbeta_mol532) then
+            CALL histdef(nid_mth_cosp, "beta_mol532", &
+                        "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", &
+                        iim,jj_nb,nhori, Nlevlmdz,1,Nlevlmdz,nvertm, 32, &
+                         "ave(X)", zout,zstomth)
+           endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%tttttttttttt) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+         if (cfg%Lclisccp2) then
+            do ii=1,7
+             CALL histdef(nid_mth_cosp, "clisccp2_"//chcol(ii), &
+                         "Cloud Fraction as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,7,1,7,nvertisccp, 32, &
+                         "ave(X)", zout,zstomth)
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+            CALL histdef(nid_mth_cosp, "boxtauisccp", &
+                         "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Lboxptopisccp) then
+            CALL histdef(nid_mth_cosp, "boxptopisccp", &
+                         "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", &
+                         iim,jj_nb,nhori,Ncolumns,1,Ncolumns,nvertcol, 32, &
+                         "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Ltclisccp) then
+           CALL histdef(nid_mth_cosp, "tclisccp", &
+                     "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Lctpisccp) then
+            CALL histdef(nid_mth_cosp, "ctpisccp", &
+                     "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Ltauisccp) then
+           CALL histdef(nid_mth_cosp, "tauisccp", &
+                     "Optical Depth as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Lalbisccp) then
+           CALL histdef(nid_mth_cosp, "albisccp", &
+                     "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", &
+                     iim, jj_nb,nhori,1,1,1,-99,32, &
+                     "ave(X)", zout,zstomth) 
+          endif
+          if (cfg%Lmeantbisccp) then
+            CALL histdef(nid_mth_cosp, "meantbisccp", &
+             " Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstomth)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+           CALL histdef(nid_mth_cosp, "meantbclrisccp", &
+            "Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator","K", &
+             iim, jj_nb,nhori,1,1,1,-99,32, &
+             "ave(X)", zout,zstomth) 
+          endif
+        endif ! Isccp
+
+
+        CALL histend(nid_mth_cosp)
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/lidar_simulator.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/lidar_simulator.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/lidar_simulator.F90	(revision 1262)
@@ -0,0 +1,553 @@
+! Copyright (c) 2009, Centre National de la Recherche Scientifique
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the LMD/IPSL/CNRS/UPMC nor the names of its
+!       contributors may be used to endorse or promote products derived from this software without 
+!       specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+      
+      SUBROUTINE lidar_simulator(npoints,nlev,npart,nrefl &
+                , undef &
+                , pres, presf, temp &
+                , q_lsliq, q_lsice, q_cvliq, q_cvice &
+                , ls_radliq, ls_radice, cv_radliq, cv_radice &
+                , frac_out, ice_type &
+                , pmol, pnorm, tautot, refl )
+!
+!---------------------------------------------------------------------------------
+! Purpose: To compute lidar signal from model-simulated profiles of cloud water
+!          and cloud fraction in each sub-column of each model gridbox.
+!
+! References: 
+! Chepfer H., S. Bony, D. Winker, M. Chiriaco, J.-L. Dufresne, G. Seze (2008),
+! Use of CALIPSO lidar observations to evaluate the cloudiness simulated by a 
+! climate model, Geophys. Res. Lett., 35, L15704, doi:10.1029/2008GL034207.
+!
+! Previous references:
+! Chiriaco et al, MWR, 2006; Chepfer et al., MWR, 2007
+!
+! Contacts: Helene Chepfer (chepfer@lmd.polytechnique.fr), Sandrine Bony (bony@lmd.jussieu.fr)
+!
+! May 2007: ActSim code of M. Chiriaco and H. Chepfer rewritten by S. Bony
+!
+! May 2008, H. Chepfer:
+! - Units of pressure inputs: Pa 
+! - Non Spherical particles : LS Ice NS coefficients, CONV Ice NS coefficients
+! - New input: ice_type (0=ice-spheres ; 1=ice-non-spherical)
+!
+! June 2008, A. Bodas-Salcedo:
+! - Ported to Fortran 90 and optimisation changes
+!
+! August 2008, J-L Dufresne:
+! - Optimisation changes (sum instructions suppressed)
+!
+! October 2008, S. Bony,  H. Chepfer and J-L. Dufresne :  
+! - Interface with COSP v2.0:
+!      cloud fraction removed from inputs
+!      in-cloud condensed water now in input (instead of grid-averaged value)
+!      depolarisation diagnostic removed
+!      parasol (polder) reflectances (for 5 different solar zenith angles) added
+!
+! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
+! - Modification of the integration of the lidar equation.
+! - change the cloud detection threshold
+!
+! April 2008, A. Bodas-Salcedo:
+! - Bug fix in computation of pmol and pnorm of upper layer
+!
+! April 2008, J-L. Dufresne
+! - Bug fix in computation of pmol and pnorm, thanks to Masaki Satoh: a factor 2 
+! was missing. This affects the ATB values but not the cloud fraction. 
+!
+!---------------------------------------------------------------------------------
+!
+! Inputs:
+!  npoints  : number of horizontal points
+!  nlev : number of vertical levels
+!  npart: numberb of cloud meteors (stratiform_liq, stratiform_ice, conv_liq, conv_ice). 
+!        Currently npart must be 4
+!  nrefl: number of solar zenith angles for parasol reflectances
+!  pres : pressure in the middle of atmospheric layers (full levels): Pa
+!  presf: pressure in the interface of atmospheric layers (half levels): Pa
+!     presf(..,1) : surface pressure ; presf(..,nlev+1)= TOA pressure
+!  temp : temperature of atmospheric layers: K
+!  q_lsliq: LS sub-column liquid water mixing ratio (kg/kg)
+!  q_lsice: LS sub-column ice water mixing ratio (kg/kg)
+!  q_cvliq: CONV sub-column liquid water mixing ratio (kg/kg)
+!  q_cvice: CONV sub-column ice water mixing ratio (kg/kg)
+!  ls_radliq: effective radius of LS liquid particles (meters)
+!  ls_radice: effective radius of LS ice particles (meters)
+!  cv_radliq: effective radius of CONV liquid particles (meters)
+!  cv_radice: effective radius of CONV ice particles (meters)
+!  frac_out : cloud cover in each sub-column of the gridbox (output from scops)
+!  ice_type : ice particle shape hypothesis (ice_type=0 for spheres, ice_type=1 
+!             for non spherical particles)
+!
+! Outputs:
+!  pmol : molecular attenuated backscatter lidar signal power (m^-1.sr^-1)
+!  pnorm: total attenuated backscatter lidar signal power (m^-1.sr^-1)
+!  tautot: optical thickess integrated from top to level z
+!  refl : parasol(polder) reflectance
+!
+! Version 1.0 (June 2007)
+! Version 1.1 (May 2008)
+! Version 1.2 (June 2008)
+! Version 2.0 (October 2008)
+! Version 2.1 (December 2008)
+!---------------------------------------------------------------------------------
+
+      IMPLICIT NONE
+      REAL :: SRsat
+      PARAMETER (SRsat = 0.01) ! threshold full attenuation 
+
+      LOGICAL ok_parasol
+      PARAMETER (ok_parasol=.true.)  ! set to .true. if you want to activate parasol reflectances
+
+      INTEGER i, k
+      
+      INTEGER INDX_LSLIQ,INDX_LSICE,INDX_CVLIQ,INDX_CVICE
+      PARAMETER (INDX_LSLIQ=1,INDX_LSICE=2,INDX_CVLIQ=3,INDX_CVICE=4)
+! inputs:
+      INTEGER npoints,nlev,npart,ice_type
+      INTEGER nrefl
+      real undef                 ! undefined value
+      REAL pres(npoints,nlev)    ! pressure full levels
+      REAL presf(npoints,nlev+1) ! pressure half levels
+      REAL temp(npoints,nlev)
+      REAL q_lsliq(npoints,nlev), q_lsice(npoints,nlev)
+      REAL q_cvliq(npoints,nlev), q_cvice(npoints,nlev)
+      REAL ls_radliq(npoints,nlev), ls_radice(npoints,nlev)
+      REAL cv_radliq(npoints,nlev), cv_radice(npoints,nlev)
+      REAL frac_out(npoints,nlev)
+
+! outputs (for each subcolumn):
+
+      REAL pmol(npoints,nlev)  ! molecular backscatter signal power (m^-1.sr^-1)
+      REAL pnorm(npoints,nlev) ! total lidar backscatter signal power (m^-1.sr^-1)
+      REAL tautot(npoints,nlev)! optical thickess integrated from top
+      REAL refl(npoints,nrefl)! parasol reflectance ! parasol
+
+! actsim variables:
+
+      REAL km, rdiffm, Qscat, Cmol
+      PARAMETER (Cmol = 6.2446e-32) ! depends on wavelength
+      PARAMETER (km = 1.38e-23)     ! Boltzmann constant (J/K)
+
+      PARAMETER (rdiffm = 0.7)      ! multiple scattering correction parameter
+      PARAMETER (Qscat = 2.0)       ! particle scattering efficiency at 532 nm
+
+      REAL rholiq, rhoice
+      PARAMETER (rholiq=1.0e+03)     ! liquid water (kg/m3)
+      PARAMETER (rhoice=0.5e+03)     ! ice (kg/m3)
+
+      REAL pi, rhopart(npart)
+      REAL polpart(npart,5)  ! polynomial coefficients derived for spherical and non spherical
+                             ! particules
+
+!   grid-box variables:
+      REAL rad_part(npoints,nlev,npart)
+      REAL rhoair(npoints,nlev), zheight(npoints,nlev+1)
+      REAL beta_mol(npoints,nlev), alpha_mol(npoints,nlev)
+      REAL kp_part(npoints,nlev,npart)
+
+!   sub-column variables:
+      REAL frac_sub(npoints,nlev)
+      REAL qpart(npoints,nlev,npart) ! mixing ratio particles in each subcolumn
+      REAL alpha_part(npoints,nlev,npart)
+      REAL tau_mol_lay(npoints)  ! temporary variable, moL. opt. thickness of layer k
+      REAL tau_mol(npoints,nlev) ! optical thickness between TOA and bottom of layer k
+      REAL tau_part(npoints,nlev,npart)
+      REAL betatot(npoints,nlev)
+      REAL tautot_lay(npoints)   ! temporary variable, total opt. thickness of layer k
+!     Optical thickness from TOA to surface for Parasol
+      REAL tautot_S_liq(npoints),tautot_S_ice(npoints)     ! for liq and ice clouds
+
+
+!------------------------------------------------------------
+!---- 1. Preliminary definitions and calculations :
+!------------------------------------------------------------
+
+      if ( npart .ne. 4 ) then
+        print *,'Error in lidar_simulator, npart should be 4, not',npart
+        stop
+      endif
+
+      pi = dacos(-1.D0)
+
+! Polynomial coefficients for spherical liq/ice particles derived from Mie theory.
+! Polynomial coefficients for non spherical particles derived from a composite of
+! Ray-tracing theory for large particles (e.g. Noel et al., Appl. Opt., 2001)
+! and FDTD theory for very small particles (Yang et al., JQSRT, 2003).
+
+! We repeat the same coefficients for LS and CONV cloud to make code more readable
+!*     LS Liquid water coefficients:
+         polpart(INDX_LSLIQ,1) =  2.6980e-8     
+         polpart(INDX_LSLIQ,2) = -3.7701e-6
+         polpart(INDX_LSLIQ,3) =  1.6594e-4
+         polpart(INDX_LSLIQ,4) = -0.0024
+         polpart(INDX_LSLIQ,5) =  0.0626
+!*     LS Ice coefficients: 
+      if (ice_type.eq.0) then     
+         polpart(INDX_LSICE,1) = -1.0176e-8   
+         polpart(INDX_LSICE,2) =  1.7615e-6
+         polpart(INDX_LSICE,3) = -1.0480e-4
+         polpart(INDX_LSICE,4) =  0.0019
+         polpart(INDX_LSICE,5) =  0.0460
+      endif
+!*     LS Ice NS coefficients: 
+      if (ice_type.eq.1) then 
+         polpart(INDX_LSICE,1) = 1.3615e-8  
+         polpart(INDX_LSICE,2) = -2.04206e-6 
+         polpart(INDX_LSICE,3) = 7.51799e-5
+         polpart(INDX_LSICE,4) = 0.00078213
+         polpart(INDX_LSICE,5) = 0.0182131
+      endif
+!*     CONV Liquid water coefficients:
+         polpart(INDX_CVLIQ,1) =  2.6980e-8     
+         polpart(INDX_CVLIQ,2) = -3.7701e-6
+         polpart(INDX_CVLIQ,3) =  1.6594e-4
+         polpart(INDX_CVLIQ,4) = -0.0024
+         polpart(INDX_CVLIQ,5) =  0.0626
+!*     CONV Ice coefficients: 
+      if (ice_type.eq.0) then 
+         polpart(INDX_CVICE,1) = -1.0176e-8   
+         polpart(INDX_CVICE,2) =  1.7615e-6
+         polpart(INDX_CVICE,3) = -1.0480e-4
+         polpart(INDX_CVICE,4) =  0.0019
+         polpart(INDX_CVICE,5) =  0.0460
+      endif
+      if (ice_type.eq.1) then
+         polpart(INDX_CVICE,1) = 1.3615e-8
+         polpart(INDX_CVICE,2) = -2.04206e-6
+         polpart(INDX_CVICE,3) = 7.51799e-5
+         polpart(INDX_CVICE,4) = 0.00078213
+         polpart(INDX_CVICE,5) = 0.0182131
+      endif
+
+! density:
+!*    clear-sky air:
+      rhoair = pres/(287.04*temp)
+
+!*    liquid/ice particules:
+      rhopart(INDX_LSLIQ) = rholiq
+      rhopart(INDX_LSICE) = rhoice
+      rhopart(INDX_CVLIQ) = rholiq
+      rhopart(INDX_CVICE) = rhoice
+
+! effective radius particles:
+      rad_part(:,:,INDX_LSLIQ) = ls_radliq(:,:)
+      rad_part(:,:,INDX_LSICE) = ls_radice(:,:)
+      rad_part(:,:,INDX_CVLIQ) = cv_radliq(:,:)
+      rad_part(:,:,INDX_CVICE) = cv_radice(:,:)
+      rad_part(:,:,:)=MAX(rad_part(:,:,:),0.)
+      rad_part(:,:,:)=MIN(rad_part(:,:,:),70.0e-6)
+      
+! altitude at half pressure levels:
+      zheight(:,1) = 0.0
+      do k = 2, nlev+1
+        zheight(:,k) = zheight(:,k-1) &
+                  -(presf(:,k)-presf(:,k-1))/(rhoair(:,k-1)*9.81)
+      enddo
+
+! cloud fraction (0 or 1) in each sub-column:
+! (if frac_out=1or2 -> frac_sub=1; if frac_out=0 -> frac_sub=0)
+      frac_sub = MIN( frac_out, 1.0 )
+
+!------------------------------------------------------------
+!---- 2. Molecular alpha and beta:
+!------------------------------------------------------------
+
+      beta_mol = pres/km/temp * Cmol
+      alpha_mol = 8.0*pi/3.0 * beta_mol
+
+!------------------------------------------------------------
+!---- 3. Particles alpha and beta:
+!------------------------------------------------------------
+
+! polynomes kp_lidar derived from Mie theory:
+      do i = 1, npart
+       where ( rad_part(:,:,i).gt.0.0)
+         kp_part(:,:,i) = &
+            polpart(i,1)*(rad_part(:,:,i)*1e6)**4 &
+          + polpart(i,2)*(rad_part(:,:,i)*1e6)**3 &
+          + polpart(i,3)*(rad_part(:,:,i)*1e6)**2 &
+          + polpart(i,4)*(rad_part(:,:,i)*1e6) &
+          + polpart(i,5)
+        elsewhere
+         kp_part(:,:,i) = 0.
+        endwhere
+      enddo
+      
+! mixing ratio particules in each subcolumn:
+          qpart(:,:,INDX_LSLIQ) = q_lsliq(:,:) ! oct08
+          qpart(:,:,INDX_LSICE) = q_lsice(:,:) ! oct08
+          qpart(:,:,INDX_CVLIQ) = q_cvliq(:,:) ! oct08
+          qpart(:,:,INDX_CVICE) = q_cvice(:,:) ! oct08
+
+! alpha of particles in each subcolumn:
+      do i = 1, npart
+        where ( rad_part(:,:,i).gt.0.0)
+          alpha_part(:,:,i) = 3.0/4.0 * Qscat &
+                 * rhoair(:,:) * qpart(:,:,i) &
+                 / (rhopart(i) * rad_part(:,:,i) )
+        elsewhere
+          alpha_part(:,:,i) = 0.
+        endwhere
+      enddo
+
+!------------------------------------------------------------
+!---- 4. Backscatter signal:
+!------------------------------------------------------------
+
+! optical thickness (molecular):
+!     opt. thick of each layer
+      tau_mol(:,1:nlev) = alpha_mol(:,1:nlev) &
+         & *(zheight(:,2:nlev+1)-zheight(:,1:nlev))
+!     opt. thick from TOA
+      DO k = nlev-1, 1, -1
+        tau_mol(:,k) = tau_mol(:,k) + tau_mol(:,k+1)
+      ENDDO
+
+! optical thickness (particles):
+
+      tau_part = rdiffm * alpha_part
+      DO i = 1, npart
+!       opt. thick of each layer
+        tau_part(:,:,i) = tau_part(:,:,i) &
+           & * (zheight(:,2:nlev+1)-zheight(:,1:nlev) )
+!       opt. thick from TOA
+        DO k = nlev-1, 1, -1 
+          tau_part(:,k,i) = tau_part(:,k,i) + tau_part(:,k+1,i)
+        ENDDO
+      ENDDO
+
+! molecular signal:
+!      Upper layer 
+       pmol(:,nlev) = beta_mol(:,nlev) / (2.*tau_mol(:,nlev)) &
+            & * (1.-exp(-2.0*tau_mol(:,nlev)))
+!      Other layers
+       DO k= nlev-1, 1, -1
+        tau_mol_lay(:) = tau_mol(:,k)-tau_mol(:,k+1) ! opt. thick. of layer k
+        WHERE (tau_mol_lay(:).GT.0.)
+          pmol(:,k) = beta_mol(:,k) * EXP(-2.0*tau_mol(:,k+1)) / (2.*tau_mol_lay(:)) &
+            & * (1.-exp(-2.0*tau_mol_lay(:)))
+        ELSEWHERE
+!         This must never happend, but just in case, to avoid div. by 0
+          pmol(:,k) = beta_mol(:,k) * EXP(-2.0*tau_mol(:,k+1))
+        END WHERE
+      END DO
+!
+! Total signal (molecular + particules):
+!
+! For performance reason on vector computers, the 2 following lines should not be used
+! and should be replace by the later one.
+!      betatot(:,:) = beta_mol(:,:) + sum(kp_part*alpha_part,dim=3)
+!      tautot(:,:)  = tau_mol(:,:)  + sum(tau_part,dim=3)
+      betatot(:,:) = beta_mol(:,:)
+      tautot(:,:)  = tau_mol(:,:)
+      DO i = 1, npart
+           betatot(:,:) = betatot(:,:) + kp_part(:,:,i)*alpha_part(:,:,i)
+           tautot(:,:) = tautot(:,:)  + tau_part(:,:,i)
+      ENDDO ! i
+!
+!     Upper layer 
+      pnorm(:,nlev) = betatot(:,nlev) / (2.*tautot(:,nlev)) &
+            & * (1.-exp(-2.0*tautot(:,nlev)))
+!     Other layers
+      DO k= nlev-1, 1, -1
+        tautot_lay(:) = tautot(:,k)-tautot(:,k+1) ! optical thickness of layer k
+        WHERE (tautot_lay(:).GT.0.)
+       pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) &
+!correc          pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) & ! correc Satoh
+!correc               &               / (2.0*tautot_lay(:)) &          ! correc Satoh
+               & * (1.-EXP(-2.0*tautot_lay(:)))
+        ELSEWHERE
+!         This must never happend, but just in case, to avoid div. by 0
+          pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1))
+        END WHERE
+      END DO
+
+!-------- End computation Lidar --------------------------
+
+!---------------------------------------------------------
+!  Parasol/Polder module
+!
+!  Purpose : Compute reflectance for one particular viewing direction
+!  and 5 solar zenith angles (calculation valid only over ocean)
+! ---------------------------------------------------------
+
+! initialization:
+    refl(:,:) = 0.0
+
+! activate parasol calculations:
+    if (ok_parasol) then
+
+!     Optical thickness from TOA to surface
+      tautot_S_liq = 0.
+      tautot_S_ice = 0.
+      tautot_S_liq(:) = tautot_S_liq(:) &
+         + tau_part(:,1,1) + tau_part(:,1,3)
+      tautot_S_ice(:) = tautot_S_ice(:) &
+         + tau_part(:,1,2) + tau_part(:,1,4)
+
+      call parasol(npoints,nrefl,undef  &
+                 ,tautot_S_liq,tautot_S_ice &
+                 ,refl)
+
+    endif ! ok_parasol
+
+  END SUBROUTINE lidar_simulator
+!
+!---------------------------------------------------------------------------------
+!
+  SUBROUTINE parasol(npoints,nrefl,undef  &
+                       ,tautot_S_liq,tautot_S_ice  &
+                       ,refl)
+!---------------------------------------------------------------------------------
+! Purpose: To compute Parasol reflectance signal from model-simulated profiles 
+!          of cloud water and cloud fraction in each sub-column of each model 
+!          gridbox.
+!
+!
+! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
+! - optimization for vectorization
+!
+! Version 2.0 (October 2008)
+! Version 2.1 (December 2008)
+!---------------------------------------------------------------------------------
+
+    IMPLICIT NONE
+
+! inputs
+    INTEGER npoints              ! Number of horizontal gridpoints
+    INTEGER nrefl                ! Number of angles for which the reflectance 
+                                 ! is computed. Can not be greater then ntetas
+    REAL undef                   ! Undefined value. Currently not used
+    REAL tautot_S_liq(npoints)   ! liquid water cloud optical thickness, 
+                                   ! integrated from TOA to surface
+    REAL tautot_S_ice(npoints)   ! same for ice water clouds only
+! outputs
+    REAL refl(npoints,nrefl)     ! Parasol reflectances
+!
+! Local variables
+    REAL tautot_S(npoints)       ! cloud optical thickness, from TOA to surface
+    REAL frac_taucol_liq(npoints), frac_taucol_ice(npoints)
+
+    REAL pi
+!   look up table variables:
+    INTEGER ny, it
+    INTEGER ntetas, nbtau        ! number of angle and of optical thickness
+                                   ! of the look-up table
+    PARAMETER (ntetas=5, nbtau=7)
+    REAL aa(ntetas,nbtau-1), ab(ntetas,nbtau-1)
+    REAL ba(ntetas,nbtau-1), bb(ntetas,nbtau-1)  
+    REAL tetas(ntetas),tau(nbtau)                        
+    REAL r_norm(ntetas)
+    REAL rlumA(ntetas,nbtau), rlumB(ntetas,nbtau)       
+    REAL rlumA_mod(npoints,5), rlumB_mod(npoints,5) 
+
+    DATA tau   /0., 1., 5., 10., 20., 50., 100./
+    DATA tetas /0., 20., 40., 60., 80./
+    
+! Look-up table for spherical liquid particles:
+    DATA (rlumA(1,ny),ny=1,nbtau) /0.03, 0.090886, 0.283965, &
+     0.480587, 0.695235, 0.908229, 1.0 /
+    DATA (rlumA(2,ny),ny=1,nbtau) /0.03, 0.072185, 0.252596, &
+      0.436401,  0.631352, 0.823924, 0.909013 /
+    DATA (rlumA(3,ny),ny=1,nbtau) /0.03, 0.058410, 0.224707, &
+      0.367451,  0.509180, 0.648152, 0.709554 /
+    DATA (rlumA(4,ny),ny=1,nbtau) /0.03, 0.052498, 0.175844, &
+      0.252916,  0.326551, 0.398581, 0.430405 /
+    DATA (rlumA(5,ny),ny=1,nbtau) /0.03, 0.034730, 0.064488, &
+      0.081667,  0.098215, 0.114411, 0.121567 /
+
+! Look-up table for ice particles:
+    DATA (rlumB(1,ny),ny=1,nbtau) /0.03, 0.092170, 0.311941, &
+       0.511298, 0.712079 , 0.898243 , 0.976646 /
+    DATA (rlumB(2,ny),ny=1,nbtau) /0.03, 0.087082, 0.304293, &
+       0.490879,  0.673565, 0.842026, 0.912966 /
+    DATA (rlumB(3,ny),ny=1,nbtau) /0.03, 0.083325, 0.285193, &
+      0.430266,  0.563747, 0.685773,  0.737154 /
+    DATA (rlumB(4,ny),ny=1,nbtau) /0.03, 0.084935, 0.233450, &
+      0.312280, 0.382376, 0.446371, 0.473317 /
+    DATA (rlumB(5,ny),ny=1,nbtau) /0.03, 0.054157, 0.089911, &
+      0.107854, 0.124127, 0.139004, 0.145269 /
+
+!--------------------------------------------------------------------------------
+! Lum_norm=f(tetaS,tau_cloud) derived from adding-doubling calculations
+!        valid ONLY ABOVE OCEAN (albedo_sfce=5%)
+!        valid only in one viewing direction (theta_v=30�, phi_s-phi_v=320�)
+!        based on adding-doubling radiative transfer computation
+!        for tau values (0 to 100) and for tetas values (0 to 80)
+!        for 2 scattering phase functions: liquid spherical, ice non spherical
+
+    IF ( nrefl.GT. ntetas ) THEN
+        PRINT *,'Error in lidar_simulator, nrefl should be less then ',ntetas,' not',nrefl
+        STOP
+    ENDIF
+
+    rlumA_mod=0
+    rlumB_mod=0
+!
+    pi = ACOS(-1.0)
+    r_norm(:)=1./ COS(pi/180.*tetas(:))
+!
+    tautot_S_liq(:)=MAX(tautot_S_liq(:),tau(1))
+    tautot_S_ice(:)=MAX(tautot_S_ice(:),tau(1))
+    tautot_S(:) = tautot_S_ice(:) + tautot_S_liq(:)
+!
+! relative fraction of the opt. thick due to liquid or ice clouds
+    WHERE (tautot_S(:) .GT. 0.)
+        frac_taucol_liq(:) = tautot_S_liq(:) / tautot_S(:)
+        frac_taucol_ice(:) = tautot_S_ice(:) / tautot_S(:)
+    ELSEWHERE
+        frac_taucol_liq(:) = 1.
+        frac_taucol_ice(:) = 0.
+    END WHERE
+    tautot_S(:)=MIN(tautot_S(:),tau(nbtau))
+!
+! Linear interpolation :
+
+    DO ny=1,nbtau-1
+! microphysics A (liquid clouds) 
+      aA(:,ny) = (rlumA(:,ny+1)-rlumA(:,ny))/(tau(ny+1)-tau(ny))
+      bA(:,ny) = rlumA(:,ny) - aA(:,ny)*tau(ny)
+! microphysics B (ice clouds)
+      aB(:,ny) = (rlumB(:,ny+1)-rlumB(:,ny))/(tau(ny+1)-tau(ny))
+      bB(:,ny) = rlumB(:,ny) - aB(:,ny)*tau(ny)
+    ENDDO
+!
+    DO it=1,ntetas
+      DO ny=1,nbtau-1
+        WHERE (tautot_S(:).GE.tau(ny).AND.tautot_S(:).LE.tau(ny+1))
+            rlumA_mod(:,it) = aA(it,ny)*tautot_S(:) + bA(it,ny)
+            rlumB_mod(:,it) = aB(it,ny)*tautot_S(:) + bB(it,ny)
+        END WHERE
+      END DO
+    END DO
+!
+    DO it=1,ntetas
+      refl(:,it) = frac_taucol_liq(:) * rlumA_mod(:,it) &
+         + frac_taucol_ice(:) * rlumB_mod(:,it)
+! normalized radiance -> reflectance: 
+      refl(:,it) = refl(:,it) * r_norm(it)
+    ENDDO
+
+    RETURN
+  END SUBROUTINE parasol
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/llnl_stats.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/llnl_stats.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/llnl_stats.F90	(revision 1262)
@@ -0,0 +1,132 @@
+! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list 
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation 
+!       nor the names of its contributors may be used to endorse or promote products derived from 
+!       this software without specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+MODULE MOD_LLNL_STATS
+  IMPLICIT NONE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- FUNCTION COSP_CFAD ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+FUNCTION COSP_CFAD(Npoints,Ncolumns,Nlevels,Nbins,x,xmin,xmax,bmin,bwidth)
+   ! Input arguments
+   integer,intent(in) :: Npoints,Ncolumns,Nlevels,Nbins
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: x
+   real,intent(in) :: xmin,xmax 
+   real,intent(in) :: bmin,bwidth
+   
+   real,dimension(Npoints,Nbins,Nlevels) :: cosp_cfad
+   ! Local variables
+   integer :: i, j, k
+   integer :: ibin
+   
+   !--- Input arguments
+   ! Npoints: Number of horizontal points
+   ! Ncolumns: Number of subcolumns
+   ! Nlevels: Number of levels
+   ! Nbins: Number of x axis bins
+   ! x: variable to process (Npoints,Ncolumns,Nlevels)
+   ! xmin: minimum value allowed for x
+   ! xmax: minimum value allowed for x
+   ! bmin: mimumum value of first bin
+   ! bwidth: bin width
+   !
+   ! Output: 2D histogram on each horizontal point (Npoints,Nbins,Nlevels)
+   
+   cosp_cfad = 0.0
+   ! bwidth intervals in the range [bmin,bmax=bmin+Nbins*hwidth]
+   ! Valid x values smaller than bmin and larger than bmax are set 
+   ! into the smallest bin and largest bin, respectively.
+   do j = 1, Nlevels, 1
+      do k = 1, Ncolumns, 1
+         do i = 1, Npoints, 1 
+            if ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then 
+               ibin = ceiling((x(i,k,j) - bmin)/bwidth)
+               if (ibin > Nbins) ibin = Nbins
+               if (ibin < 1)     ibin = 1
+               cosp_cfad(i,ibin,j) = cosp_cfad(i,ibin,j) + 1.0 
+            end if
+         enddo  !i
+      enddo  !k
+   enddo  !j
+   cosp_cfad = cosp_cfad / Ncolumns
+END FUNCTION COSP_CFAD
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_LIDAR_ONLY_CLOUD -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,beta_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc)
+   ! Input arguments
+   integer,intent(in) :: Npoints,Ncolumns,Nlevels
+   real,dimension(Npoints,Nlevels),intent(in) :: beta_mol   ! Molecular backscatter
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: beta_tot   ! Total backscattered signal
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: Ze_tot     ! Radar reflectivity
+   ! Output arguments
+   real,dimension(Npoints,Nlevels),intent(out) :: lidar_only_freq_cloud
+   real,dimension(Npoints),intent(out) :: tcc
+   
+   ! local variables
+   real :: sc_ratio
+   real :: s_cld, s_att
+!      parameter (S_cld = 3.0)  ! Previous thresold for cloud detection
+   parameter (S_cld = 5.0)  ! New (dec 2008) thresold for cloud detection
+   parameter (s_att = 0.01)
+   integer :: flag_sat !first saturated level encountered from top
+   integer :: flag_cld !cloudy column
+   integer :: pr,i,j
+   
+!    lidar_only_freq_cloud = 0.0
+!    tcc = 0.0
+   do pr=1,Npoints
+     do i=1,Ncolumns
+       flag_sat = 0
+       flag_cld = 0
+       do j=Nlevels,1,-1 !top->surf
+        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
+!         if ((pr == 1).and.(j==8)) print *, pr,i,j,sc_ratio,Ze_tot(pr,i,j)
+        if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
+        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
+         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
+!             if ((pr == 1).and.(j==8)) print *, 'L'
+            lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
+            flag_cld=1
+         endif
+        else  !radar sense cloud (z%Ze_tot(pr,i,j) .ge. -30.)
+!            if ((pr == 1).and.(j==8)) print *, 'R'
+           flag_cld=1
+        endif
+       enddo !levels
+       if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1.
+     enddo !columns
+!      if (tcc(pr) > Ncolumns) then
+!      print *, 'tcc(',pr,'): ', tcc(pr)
+!      tcc(pr) = Ncolumns
+!      endif
+   enddo !points
+   lidar_only_freq_cloud=lidar_only_freq_cloud/Ncolumns
+   tcc=tcc/Ncolumns
+
+END SUBROUTINE COSP_LIDAR_ONLY_CLOUD
+END MODULE MOD_LLNL_STATS
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/lmd_ipsl_stats.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/lmd_ipsl_stats.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/lmd_ipsl_stats.F90	(revision 1262)
@@ -0,0 +1,386 @@
+! Copyright (c) 2009, Centre National de la Recherche Scientifique
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the LMD/IPSL/CNRS/UPMC nor the names of its
+!       contributors may be used to endorse or promote products derived from this software without 
+!       specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+!------------------------------------------------------------------------------------
+! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
+!------------------------------------------------------------------------------------
+MODULE MOD_LMD_IPSL_STATS
+  USE MOD_LLNL_STATS
+  IMPLICIT NONE
+
+CONTAINS
+      SUBROUTINE diag_lidar(npoints,ncol,llm,max_bin,nrefl &
+                  ,pnorm,pmol,refl,land,pplay,undef,ok_lidar_cfad &
+                  ,cfad2,srbval &
+                  ,ncat,lidarcld,cldlayer,parasolrefl)
+!
+! -----------------------------------------------------------------------------------
+! Lidar outputs :
+! 
+! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction
+! from the lidar signals (ATB and molecular ATB) computed from model outputs
+!      +
+! Compute CFADs of lidar scattering ratio SR and of depolarization index
+! 
+! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
+!
+! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne : 
+! - change of the cloud detection threshold S_cld from 3 to 5, for better
+! with both day and night observations. The optical thinest clouds are missed.
+! - remove of the detection of the first fully attenuated layer encountered from above.
+! December 2008, A. Bodas-Salcedo:
+! - Dimensions of pmol reduced to (npoints,llm)
+!
+! Version 1.0 (June 2007)
+! Version 1.1 (May 2008)
+! Version 1.2 (June 2008)
+! Version 2.0 (October 2008)
+! Version 2.1 (December 2008)
+! c------------------------------------------------------------------------------------
+
+! c inputs :
+      integer npoints
+      integer ncol
+      integer llm
+      integer max_bin               ! nb of bins for SR CFADs
+      integer ncat                  ! nb of cloud layer types (low,mid,high,total)
+      integer nrefl                 ! nb of solar zenith angles for parasol reflectances
+
+      real undef                    ! undefined value
+      real pnorm(npoints,ncol,llm)  ! lidar ATB 
+      real pmol(npoints,llm)        ! molecular ATB
+      real land(npoints)            ! Landmask [0 - Ocean, 1 - Land]    
+      real pplay(npoints,llm)       ! pressure on model levels (Pa)
+      logical ok_lidar_cfad         ! true if lidar CFAD diagnostics need to be computed
+      real refl(npoints,ncol,nrefl) ! subgrid parasol reflectance ! parasol
+
+! c outputs :
+      real lidarcld(npoints,llm)     ! 3D "lidar" cloud fraction 
+      real cldlayer(npoints,ncat)    ! "lidar" cloud fraction (low, mid, high, total)
+      real cfad2(npoints,max_bin,llm) ! CFADs of SR  
+      real srbval(max_bin)           ! SR bins in CFADs  
+      real parasolrefl(npoints,nrefl)! grid-averaged parasol reflectance
+
+! c threshold for cloud detection :
+      real S_clr 
+      parameter (S_clr = 1.2) 
+      real S_cld
+!      parameter (S_cld = 3.0)  ! Previous thresold for cloud detection
+      parameter (S_cld = 5.0)  ! New (dec 2008) thresold for cloud detection
+      real S_att
+      parameter (S_att = 0.01)
+
+! c local variables :
+      integer ic,k
+      real x3d(npoints,ncol,llm)
+      real x3d_c(npoints,llm),pnorm_c(npoints,llm)
+      real xmax
+!
+! c -------------------------------------------------------
+! c 0- Initializations
+! c -------------------------------------------------------
+! Parasol reflectance algorithm is not valid over land. Write
+! a warning if there is no land. Landmask [0 - Ocean, 1 - Land] 
+      IF ( MAXVAL(land(:)) .EQ. 0.0) THEN
+          WRITE (*,*) 'WARNING. PARASOL reflectance is not valid over land' &
+             & ,' and there is only land'
+      END IF
+
+!  Should be modified in future version
+      xmax=undef-1.0
+
+! c -------------------------------------------------------
+! c 1- Lidar scattering ratio :
+! c -------------------------------------------------------
+!
+!       where ((pnorm.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 
+!          x3d = pnorm/pmol
+!       elsewhere
+!           x3d = undef
+!       end where
+! A.B-S: pmol reduced to 2D (npoints,llm) (Dec 08)
+      do ic = 1, ncol
+        pnorm_c = pnorm(:,ic,:)
+        where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 
+            x3d_c = pnorm_c/pmol
+        elsewhere
+            x3d_c = undef
+        end where
+        x3d(:,ic,:) = x3d_c
+      enddo
+
+! c -------------------------------------------------------
+! c 2- Diagnose cloud fractions (3D, low, middle, high, total)
+! c from subgrid-scale lidar scattering ratios :
+! c -------------------------------------------------------
+
+      CALL COSP_CLDFRAC(npoints,ncol,llm,ncat,  &
+              x3d,pplay, S_att,S_cld,undef,lidarcld, &
+              cldlayer)
+
+! c -------------------------------------------------------
+! c 3- CFADs 
+! c -------------------------------------------------------
+      if (ok_lidar_cfad) then
+!
+! c CFADs of subgrid-scale lidar scattering ratios :
+! c -------------------------------------------------------
+      CALL COSP_CFAD_SR(npoints,ncol,llm,max_bin, &
+                 x3d, &
+                 S_att,S_clr,xmax,cfad2,srbval)
+
+      endif   ! ok_lidar_cfad
+! c -------------------------------------------------------
+
+! c -------------------------------------------------------
+! c 4- Compute grid-box averaged Parasol reflectances
+! c -------------------------------------------------------
+
+      parasolrefl(:,:) = 0.0
+
+      do k = 1, nrefl
+       do ic = 1, ncol
+         parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
+       enddo
+      enddo
+
+      do k = 1, nrefl
+        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
+! if land=1 -> parasolrefl=undef
+! if land=0 -> parasolrefl=parasolrefl
+        parasolrefl(:,k) = parasolrefl(:,k) * MAX(1.0-land(:),0.0) &
+                           + (1.0 - MAX(1.0-land(:),0.0))*undef 
+      enddo
+
+      RETURN
+      END SUBROUTINE diag_lidar
+	  
+	  
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- FUNCTION COSP_CFAD_SR ------------------------
+! Author: Sandrine Bony (LMD/IPSL, CNRS, Paris)
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      SUBROUTINE COSP_CFAD_SR(Npoints,Ncolumns,Nlevels,Nbins, &
+                      x,S_att,S_clr,xmax,cfad,srbval)
+      IMPLICIT NONE
+
+!--- Input arguments
+! Npoints: Number of horizontal points
+! Ncolumns: Number of subcolumns
+! Nlevels: Number of levels
+! Nbins: Number of x axis bins
+! xmax: maximum value allowed for x
+! S_att: Threshold for full attenuation
+! S_clr: Threshold for clear-sky layer
+!
+!--- Input-Outout arguments
+! x: variable to process (Npoints,Ncolumns,Nlevels), mofified where saturation occurs
+!
+! -- Output arguments
+! srbval : values of the histogram bins
+! cfad: 2D histogram on each horizontal point
+
+! Input arguments
+      integer Npoints,Ncolumns,Nlevels,Nbins
+      real xmax,S_att,S_clr
+! Input-output arguments
+      real x(Npoints,Ncolumns,Nlevels)
+! Output :
+      real cfad(Npoints,Nbins,Nlevels)
+      real srbval(Nbins)
+! Local variables
+      integer i, j, k, ib
+
+! c -------------------------------------------------------
+! c 0- Initializations
+! c -------------------------------------------------------
+      if ( Nbins .lt. 6) return
+
+      srbval(1) =  S_att
+      srbval(2) =  S_clr
+      srbval(3) =  3.0
+      srbval(4) =  5.0
+      srbval(5) =  7.0
+      srbval(6) = 10.0
+      do i = 7, MIN(10,Nbins)
+       srbval(i) = srbval(i-1) + 5.0
+      enddo
+      DO i = 11, MIN(13,Nbins)
+       srbval(i) = srbval(i-1) + 10.0
+      enddo
+      srbval(MIN(14,Nbins)) = 80.0
+      srbval(Nbins) = xmax
+      cfad(:,:,:) = 0.0
+
+
+! c -------------------------------------------------------
+! c c- Compute CFAD
+! c -------------------------------------------------------
+
+        do j = Nlevels, 1, -1 
+          do k = 1, Ncolumns
+              where ( x(:,k,j).le.srbval(1) ) &
+                        cfad(:,1,j) = cfad(:,1,j) + 1.0
+          enddo  !k
+        enddo  !j
+
+      do ib = 2, Nbins
+        do j = Nlevels, 1, -1 
+          do k = 1, Ncolumns
+              where ( ( x(:,k,j).gt.srbval(ib-1) ) .and. ( x(:,k,j).le.srbval(ib) ) ) &
+                        cfad(:,ib,j) = cfad(:,ib,j) + 1.0
+          enddo  !k
+        enddo  !j
+      enddo  !ib
+
+      cfad(:,:,:) = cfad(:,:,:) / float(Ncolumns)
+
+! c -------------------------------------------------------
+      RETURN
+      END SUBROUTINE COSP_CFAD_SR
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- SUBROUTINE COSP_CLDFRAC -------------------
+! c Purpose: Cloud fraction diagnosed from lidar measurements 
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat, &
+                  x,pplay,S_att,S_cld,undef,lidarcld, &
+                  cldlayer)
+      IMPLICIT NONE
+! Input arguments
+      integer Npoints,Ncolumns,Nlevels,Ncat
+      real x(Npoints,Ncolumns,Nlevels)
+      real pplay(Npoints,Nlevels)
+      real S_att,S_cld
+      real undef
+! Output :
+      real lidarcld(Npoints,Nlevels) ! 3D cloud fraction
+      real cldlayer(Npoints,Ncat)    ! low, middle, high, total cloud fractions
+! Local variables
+      integer ip, k, iz, ic
+      real p1
+      real cldy(Npoints,Ncolumns,Nlevels)
+      real srok(Npoints,Ncolumns,Nlevels)
+      real cldlay(Npoints,Ncolumns,Ncat)
+      real nsublay(Npoints,Ncolumns,Ncat), nsublayer(Npoints,Ncat)
+      real nsub(Npoints,Nlevels)
+
+
+! ---------------------------------------------------------------
+! 1- initialization 
+! ---------------------------------------------------------------
+
+      if ( Ncat .ne. 4 ) then
+         print *,'Error in lmd_ipsl_stats.cosp_cldfrac, Ncat must be 4, not',Ncat
+         stop
+      endif
+
+      lidarcld = 0.0
+      nsub = 0.0
+      cldlay = 0.0
+      nsublay = 0.0
+
+! ---------------------------------------------------------------
+! 2- Cloud detection
+! ---------------------------------------------------------------
+
+      do k = 1, Nlevels
+
+! cloud detection at subgrid-scale:
+         where ( (x(:,:,k).gt.S_cld) .and. (x(:,:,k).ne. undef) )
+           cldy(:,:,k)=1.0
+         elsewhere
+           cldy(:,:,k)=0.0
+         endwhere
+
+! number of usefull sub-columns:
+         where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef)  ) 
+           srok(:,:,k)=1.0
+         elsewhere
+           srok(:,:,k)=0.0
+         endwhere
+
+      enddo ! k
+
+! ---------------------------------------------------------------
+! 3- grid-box 3D cloud fraction and layered cloud fractions (ISCCP pressure
+! categories) :
+! ---------------------------------------------------------------
+! Test abderr
+      do k = Nlevels, 1, -1
+       do ic = 1, Ncolumns
+        do ip = 1, Npoints
+          iz=1
+          p1 = pplay(ip,k)
+          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
+            iz=3
+          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
+            iz=2
+         endif
+
+         cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k))
+         cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))
+         lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k)
+
+         nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))
+         nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
+         nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k)
+
+        enddo
+       enddo
+      enddo
+
+! -- grid-box 3D cloud fraction
+
+      where ( nsub(:,:).gt.0.0 )
+         lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
+      elsewhere
+         lidarcld(:,:) = undef
+      endwhere
+
+! -- layered cloud fractions
+
+      cldlayer = 0.0
+      nsublayer = 0.0
+
+      do iz = 1, Ncat
+       do ic = 1, Ncolumns
+
+          cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz)    
+          nsublayer(:,iz)=nsublayer(:,iz) + nsublay(:,ic,iz) 
+
+       enddo
+      enddo
+      where ( nsublayer(:,:).gt.0.0 )
+         cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
+      elsewhere
+         cldlayer(:,:) = undef
+      endwhere
+
+      RETURN
+      END SUBROUTINE COSP_CLDFRAC
+! ---------------------------------------------------------------
+	  
+END MODULE MOD_LMD_IPSL_STATS
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/load_hydrometeor_classes.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/load_hydrometeor_classes.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/load_hydrometeor_classes.F90	(revision 1262)
@@ -0,0 +1,54 @@
+  subroutine load_hydrometeor_classes(Nprmts_max,dist_prmts_hydro,hp,nhclass)
+  use radar_simulator_types
+  implicit none
+  
+! Purpose:
+!   Loads the hydrometeor classes to be used in calculations
+!   Part of QuickBeam v1.03 by John Haynes
+!   http://reef.atmos.colostate.edu/haynes/radarsim
+!
+! Inputs:  
+!   [dist_prmts_hydro]   from data in hydrometeor class input 
+!
+! Outputs:
+!   [hp]            structure that define hydrometeor types
+!
+! Modified:
+!   08/23/2006  placed into subroutine form (Roger Marchand)
+   
+! ----- INPUT -----
+  integer, intent(in) :: nhclass,Nprmts_max
+  real,dimension(Nprmts_max,nhclass), intent(in) :: dist_prmts_hydro
+! ----- OUTPUTS -----  
+  type(class_param), intent(out) :: hp
+  
+! ----- INTERNAL -----  
+  integer :: i
+	
+    hp%rho(:) = -1
+
+    do i = 1,nhclass,1
+    hp%dtype(i) = dist_prmts_hydro(1,i)
+    hp%col(i) = dist_prmts_hydro(2,i)
+    hp%phase(i) = dist_prmts_hydro(3,i)
+    hp%cp(i) = dist_prmts_hydro(4,i)
+    hp%dmin(i) = dist_prmts_hydro(5,i)
+    hp%dmax(i) = dist_prmts_hydro(6,i)
+    hp%apm(i) = dist_prmts_hydro(7,i)
+    hp%bpm(i) = dist_prmts_hydro(8,i)
+    hp%rho(i) = dist_prmts_hydro(9,i)
+    hp%p1(i) = dist_prmts_hydro(10,i)
+    hp%p2(i) = dist_prmts_hydro(11,i)
+    hp%p3(i) = dist_prmts_hydro(12,i)
+    enddo
+        
+!   // setup scaling arrays
+    hp%fc = -999.
+    hp%scaled = .false.	
+    hp%z_flag = .false.
+    hp%rho_eff = -999.
+    hp%ifc = -9
+    hp%idd = -9
+   
+  
+  end subroutine load_hydrometeor_classes
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/load_mie_table.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/load_mie_table.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/load_mie_table.F90	(revision 1262)
@@ -0,0 +1,69 @@
+  subroutine load_mie_table(mie_table_name,mt)
+  use radar_simulator_types
+  implicit none
+  
+! Purpose:
+!   Loads the Mie table data
+!   Part of Quickbeam v1.03
+!   http://reef.atmos.colostate.edu/haynes/radarsim
+!
+! Inputs:  
+!   [mie_table_name]   Mie table input file
+!
+! Outputs:
+!   [mt]            structure of Mie table data
+!
+! Created from Quickbeam v1.02 08/24/2006 by Roger Marchand  
+
+! ----- INPUT -----
+  character*200, intent(in) :: mie_table_name
+
+! ----- OUTPUT -----
+  type(mie), intent(out) :: mt
+
+! ----- INTERNAL -----  
+  integer :: i
+
+  integer*4 :: dummy_in(4)
+	
+    open(51,file=mie_table_name,action='read')
+ 
+    read(51,*) dummy_in 
+
+	if(dummy_in(1).ne. mt_nfreq .or. &
+	   dummy_in(2).ne. mt_ntt .or. &
+	   dummy_in(3).ne. mt_nf .or. &
+	   dummy_in(4).ne. mt_nd) then
+
+		print *,'Mie file is of size :',dummy_in(:)
+		print *,'  expected a size of:',mt_nfreq, mt_ntt,mt_nf,mt_nf
+		print *,'  change paramters in radar_simulator_types.f90 ?? '
+		stop
+	endif
+
+    read(51,*) mt%freq
+    read(51,*) mt%tt
+    read(51,*) mt%f
+    read(51,*) mt%phase
+    read(51,*) mt%D
+    read(51,*) mt%qext
+    read(51,*) mt%qbsca
+    
+    close(51)
+
+! // create arrays of liquid/ice temperature
+  cnt_liq = 0
+  cnt_ice = 0
+  do i=1,mt_ntt
+    if (mt%phase(i) == 0) cnt_liq = cnt_liq + 1
+    if (mt%phase(i) == 1) cnt_ice = cnt_ice + 1
+  enddo
+  allocate(mt_ttl(cnt_liq),mt_tti(cnt_ice))
+  do i=1,cnt_liq
+    mt_ttl(i) = mt%tt(i)
+  enddo
+  do i=1,cnt_ice
+    mt_tti(i) = mt%tt(cnt_liq+i)
+  enddo
+
+  end subroutine load_mie_table
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/math_lib.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/math_lib.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/math_lib.F90	(revision 1262)
@@ -0,0 +1,395 @@
+! MATH_LIB: Mathematics procedures for F90
+! Compiled/Modified:
+!   07/01/06  John Haynes (haynes@atmos.colostate.edu)
+! 
+! gamma (function)
+! path_integral (function)
+! avint (subroutine)
+  
+  module math_lib
+  implicit none
+
+  contains
+
+! ----------------------------------------------------------------------------
+! function GAMMA
+! ----------------------------------------------------------------------------
+  function gamma(x)
+  implicit none
+!
+! Purpose:
+!   Returns the gamma function
+!
+! Input:
+!   [x]   value to compute gamma function of
+!
+! Returns:
+!   gamma(x)
+!
+! Coded:
+!   02/02/06  John Haynes (haynes@atmos.colostate.edu)
+!   (original code of unknown origin)
+
+! ----- INPUTS -----
+  real*8, intent(in) :: x
+  
+! ----- OUTPUTS -----
+  real*8 :: gamma
+
+! ----- INTERNAL -----  
+  real*8 :: pi,ga,z,r,gr
+  real*8 :: g(26)
+  integer :: k,m1,m
+       
+  pi = acos(-1.)	
+  if (x ==int(x)) then
+    if (x > 0.0) then
+      ga=1.0
+      m1=x-1
+      do k=2,m1
+        ga=ga*k
+      enddo
+    else
+      ga=1.0+300
+    endif
+  else
+    if (abs(x) > 1.0) then
+      z=abs(x)
+      m=int(z)
+      r=1.0
+      do k=1,m
+        r=r*(z-k)
+      enddo
+      z=z-m
+    else
+      z=x
+    endif
+    data g/1.0,0.5772156649015329, &
+           -0.6558780715202538, -0.420026350340952d-1, &
+           0.1665386113822915,-.421977345555443d-1, &
+           -.96219715278770d-2, .72189432466630d-2, &
+           -.11651675918591d-2, -.2152416741149d-3, &
+           .1280502823882d-3, -.201348547807d-4, &
+           -.12504934821d-5, .11330272320d-5, &
+           -.2056338417d-6, .61160950d-8, &
+           .50020075d-8, -.11812746d-8, &
+           .1043427d-9, .77823d-11, &
+          -.36968d-11, .51d-12, &
+          -.206d-13, -.54d-14, .14d-14, .1d-15/
+    gr=g(26)
+    do k=25,1,-1
+      gr=gr*z+g(k)
+    enddo 
+    ga=1.0/(gr*z)
+    if (abs(x) > 1.0) then
+      ga=ga*r
+      if (x < 0.0) ga=-pi/(x*ga*sin(pi*x))
+    endif
+  endif
+  gamma = ga
+  return
+  end function gamma
+  
+! ----------------------------------------------------------------------------
+! function PATH_INTEGRAL 
+! ----------------------------------------------------------------------------
+  function path_integral(f,s,i1,i2)
+  use m_mrgrnk
+  use array_lib
+  implicit none
+!
+! Purpose:
+!   evalues the integral (f ds) between f(index=i1) and f(index=i2)
+!   using the AVINT procedure
+!
+! Inputs:
+!   [f]    functional values
+!   [s]    abscissa values
+!   [i1]   index of lower limit
+!   [i2]   index of upper limit
+!
+! Returns:
+!   result of path integral
+!
+! Notes:
+!   [s] may be in forward or reverse numerical order
+!
+! Requires:
+!   mrgrnk package
+!
+! Created:
+!   02/02/06  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----  
+  real*8, intent(in), dimension(:) :: f,s  
+  integer, intent(in) :: i1, i2
+
+! ---- OUTPUTS -----
+  real*8 :: path_integral  
+  
+! ----- INTERNAL -----    
+  real*8 :: sumo, deltah, val
+  integer*4 :: nelm, j
+  integer*4, dimension(i2-i1+1) :: idx
+  real*8, dimension(i2-i1+1) :: f_rev, s_rev
+
+  nelm = i2-i1+1
+  if (nelm > 3) then
+    call mrgrnk(s(i1:i2),idx)
+    s_rev = s(idx)
+    f_rev = f(idx)
+    call avint(f_rev(i1:i2),s_rev(i1:i2),(i2-i1+1), &
+      s_rev(i1),s_rev(i2), val)
+    path_integral = val
+  else
+     sumo = 0.
+     do j=i1,i2
+       deltah = abs(s(i1+1)-s(i1))
+       sumo = sumo + f(j)*deltah
+    enddo
+    path_integral = sumo
+  endif 
+  ! print *, sumo
+
+  return
+  end function path_integral
+  
+! ----------------------------------------------------------------------------
+! subroutine AVINT
+! ----------------------------------------------------------------------------
+  subroutine avint ( ftab, xtab, ntab, a_in, b_in, result )
+  implicit none
+!
+! Purpose:
+!   estimate the integral of unevenly spaced data
+!
+! Inputs:
+!   [ftab]     functional values
+!   [xtab]     abscissa values
+!   [ntab]     number of elements of [ftab] and [xtab]
+!   [a]        lower limit of integration
+!   [b]        upper limit of integration
+!
+! Outputs:
+!   [result]   approximate value of integral
+!
+! Reference:
+!   From SLATEC libraries, in public domain
+!
+!***********************************************************************
+!
+!  AVINT estimates the integral of unevenly spaced data.
+!
+!  Discussion:
+!
+!    The method uses overlapping parabolas and smoothing.
+!
+!  Modified:
+!
+!    30 October 2000
+!    4 January 2008, A. Bodas-Salcedo. Error control for XTAB taken out of
+!                    loop to allow vectorization.
+!
+!  Reference:
+!
+!    Philip Davis and Philip Rabinowitz,
+!    Methods of Numerical Integration,
+!    Blaisdell Publishing, 1967.
+!
+!    P E Hennion,
+!    Algorithm 77,
+!    Interpolation, Differentiation and Integration,
+!    Communications of the Association for Computing Machinery,
+!    Volume 5, page 96, 1962.
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) FTAB(NTAB), the function values,
+!    FTAB(I) = F(XTAB(I)).
+!
+!    Input, real ( kind = 8 ) XTAB(NTAB), the abscissas at which the
+!    function values are given.  The XTAB's must be distinct
+!    and in ascending order.
+!
+!    Input, integer NTAB, the number of entries in FTAB and
+!    XTAB.  NTAB must be at least 3.
+!
+!    Input, real ( kind = 8 ) A, the lower limit of integration.  A should
+!    be, but need not be, near one endpoint of the interval
+!    (X(1), X(NTAB)).
+!
+!    Input, real ( kind = 8 ) B, the upper limit of integration.  B should
+!    be, but need not be, near one endpoint of the interval
+!    (X(1), X(NTAB)).
+!
+!    Output, real ( kind = 8 ) RESULT, the approximate value of the integral.
+
+  integer, intent(in) :: ntab
+
+  integer,parameter :: KR8 = selected_real_kind(15,300)
+  real ( kind = KR8 ), intent(in) :: a_in
+  real ( kind = KR8 ) a
+  real ( kind = KR8 ) atemp
+  real ( kind = KR8 ), intent(in) :: b_in
+  real ( kind = KR8 ) b
+  real ( kind = KR8 ) btemp
+  real ( kind = KR8 ) ca
+  real ( kind = KR8 ) cb
+  real ( kind = KR8 ) cc
+  real ( kind = KR8 ) ctemp
+  real ( kind = KR8 ), intent(in) :: ftab(ntab)
+  integer i
+  integer ihi
+  integer ilo
+  integer ind
+  real ( kind = KR8 ), intent(out) :: result
+  real ( kind = KR8 ) sum1
+  real ( kind = KR8 ) syl
+  real ( kind = KR8 ) term1
+  real ( kind = KR8 ) term2
+  real ( kind = KR8 ) term3
+  real ( kind = KR8 ) x1
+  real ( kind = KR8 ) x2
+  real ( kind = KR8 ) x3
+  real ( kind = KR8 ), intent(in) :: xtab(ntab)
+  logical lerror
+  
+  lerror = .false.
+  a = a_in
+  b = b_in  
+  
+  if ( ntab < 3 ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'AVINT - Fatal error!'
+    write ( *, '(a,i6)' ) '  NTAB is less than 3.  NTAB = ', ntab
+    stop
+  end if
+ 
+  do i = 2, ntab
+    if ( xtab(i) <= xtab(i-1) ) then
+       lerror = .true.
+       exit
+    end if
+  end do
+  
+  if (lerror) then
+      write ( *, '(a)' ) ' '
+      write ( *, '(a)' ) 'AVINT - Fatal error!'
+      write ( *, '(a)' ) '  XTAB(I) is not greater than XTAB(I-1).'
+      write ( *, '(a,i6)' ) '  Here, I = ', i
+      write ( *, '(a,g14.6)' ) '  XTAB(I-1) = ', xtab(i-1)
+      write ( *, '(a,g14.6)' ) '  XTAB(I) =   ', xtab(i)
+      stop  
+  end if
+ 
+  result = 0.0D+00
+ 
+  if ( a == b ) then
+    write ( *, '(a)' ) ' '
+    write ( *, '(a)' ) 'AVINT - Warning!'
+    write ( *, '(a)' ) '  A = B, integral=0.'
+    return
+  end if
+!
+!  If B < A, temporarily switch A and B, and store sign.
+!
+  if ( b < a ) then
+    syl = b
+    b = a
+    a = syl
+    ind = -1
+  else
+    syl = a
+    ind = 1
+  end if
+!
+!  Bracket A and B between XTAB(ILO) and XTAB(IHI).
+!
+  ilo = 1
+  ihi = ntab
+
+  do i = 1, ntab
+    if ( a <= xtab(i) ) then
+      exit
+    end if
+    ilo = ilo + 1
+  end do
+
+  ilo = max ( 2, ilo )
+  ilo = min ( ilo, ntab - 1 )
+
+  do i = 1, ntab
+    if ( xtab(i) <= b ) then
+      exit
+    end if
+    ihi = ihi - 1
+  end do
+  
+  ihi = min ( ihi, ntab - 1 )
+  ihi = max ( ilo, ihi - 1 )
+!
+!  Carry out approximate integration from XTAB(ILO) to XTAB(IHI).
+!
+  sum1 = 0.0D+00
+ 
+  do i = ilo, ihi
+ 
+    x1 = xtab(i-1)
+    x2 = xtab(i)
+    x3 = xtab(i+1)
+    
+    term1 = ftab(i-1) / ( ( x1 - x2 ) * ( x1 - x3 ) )
+    term2 = ftab(i)   / ( ( x2 - x1 ) * ( x2 - x3 ) )
+    term3 = ftab(i+1) / ( ( x3 - x1 ) * ( x3 - x2 ) )
+ 
+    atemp = term1 + term2 + term3
+
+    btemp = - ( x2 + x3 ) * term1 &
+            - ( x1 + x3 ) * term2 &
+            - ( x1 + x2 ) * term3
+
+    ctemp = x2 * x3 * term1 + x1 * x3 * term2 + x1 * x2 * term3
+ 
+    if ( i <= ilo ) then
+      ca = atemp
+      cb = btemp
+      cc = ctemp
+    else
+      ca = 0.5D+00 * ( atemp + ca )
+      cb = 0.5D+00 * ( btemp + cb )
+      cc = 0.5D+00 * ( ctemp + cc )
+    end if
+ 
+    sum1 = sum1 &
+          + ca * ( x2**3 - syl**3 ) / 3.0D+00 &
+          + cb * 0.5D+00 * ( x2**2 - syl**2 ) &
+          + cc * ( x2 - syl )
+ 
+    ca = atemp
+    cb = btemp
+    cc = ctemp
+ 
+    syl = x2
+ 
+  end do
+ 
+  result = sum1 &
+        + ca * ( b**3 - syl**3 ) / 3.0D+00 &
+        + cb * 0.5D+00 * ( b**2 - syl**2 ) &
+        + cc * ( b - syl )
+!
+!  Restore original values of A and B, reverse sign of integral
+!  because of earlier switch.
+!
+  if ( ind /= 1 ) then
+    ind = 1
+    syl = b
+    b = a
+    a = syl
+    result = -result
+  end if
+ 
+  return
+  end subroutine avint
+  
+  end module math_lib
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/mrgrnk.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/mrgrnk.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/mrgrnk.F90	(revision 1262)
@@ -0,0 +1,410 @@
+Module m_mrgrnk
+Integer, Parameter :: kdp = selected_real_kind(15)
+public :: mrgrnk
+private :: kdp
+private :: I_mrgrnk, D_mrgrnk
+interface mrgrnk
+  module procedure D_mrgrnk, I_mrgrnk
+end interface mrgrnk
+contains
+
+Subroutine D_mrgrnk (XDONT, IRNGT)
+! __________________________________________________________
+!   MRGRNK = Merge-sort ranking of an array
+!   For performance reasons, the first 2 passes are taken
+!   out of the standard loop, and use dedicated coding.
+! __________________________________________________________
+! __________________________________________________________
+      Real (kind=kdp), Dimension (:), Intent (In) :: XDONT
+      Integer, Dimension (:), Intent (Out) :: IRNGT
+! __________________________________________________________
+      Real (kind=kdp) :: XVALA, XVALB
+!
+      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
+      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
+      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
+!
+      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
+      Select Case (NVAL)
+      Case (:0)
+         Return
+      Case (1)
+         IRNGT (1) = 1
+         Return
+      Case Default
+         Continue
+      End Select
+!
+!  Fill-in the index array, creating ordered couples
+!
+      Do IIND = 2, NVAL, 2
+         If (XDONT(IIND-1) <= XDONT(IIND)) Then
+            IRNGT (IIND-1) = IIND - 1
+            IRNGT (IIND) = IIND
+         Else
+            IRNGT (IIND-1) = IIND
+            IRNGT (IIND) = IIND - 1
+         End If
+      End Do
+      If (Modulo(NVAL, 2) /= 0) Then
+         IRNGT (NVAL) = NVAL
+      End If
+!
+!  We will now have ordered subsets A - B - A - B - ...
+!  and merge A and B couples into     C   -   C   - ...
+!
+      LMTNA = 2
+      LMTNC = 4
+!
+!  First iteration. The length of the ordered subsets goes from 2 to 4
+!
+      Do
+         If (NVAL <= 2) Exit
+!
+!   Loop on merges of A and B into C
+!
+         Do IWRKD = 0, NVAL - 1, 4
+            If ((IWRKD+4) > NVAL) Then
+               If ((IWRKD+2) >= NVAL) Exit
+!
+!   1 2 3
+!
+               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
+!
+!   1 3 2
+!
+               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+                  IRNG2 = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNG2
+!
+!   3 1 2
+!
+               Else
+                  IRNG1 = IRNGT (IWRKD+1)
+                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNG1
+               End If
+               Exit
+            End If
+!
+!   1 2 3 4
+!
+            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
+!
+!   1 3 x x
+!
+            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   1 3 2 4
+                  IRNGT (IWRKD+3) = IRNG2
+               Else
+!   1 3 4 2
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+!
+!   3 x x x
+!
+            Else
+               IRNG1 = IRNGT (IWRKD+1)
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
+                  IRNGT (IWRKD+2) = IRNG1
+                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   3 1 2 4
+                     IRNGT (IWRKD+3) = IRNG2
+                  Else
+!   3 1 4 2
+                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                     IRNGT (IWRKD+4) = IRNG2
+                  End If
+               Else
+!   3 4 1 2
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+3) = IRNG1
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+            End If
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 4
+         Exit
+      End Do
+!
+!  Iteration loop. Each time, the length of the ordered subsets
+!  is doubled.
+!
+      Do
+         If (LMTNA >= NVAL) Exit
+         IWRKF = 0
+         LMTNC = 2 * LMTNC
+!
+!   Loop on merges of A and B into C
+!
+         Do
+            IWRK = IWRKF
+            IWRKD = IWRKF + 1
+            JINDA = IWRKF + LMTNA
+            IWRKF = IWRKF + LMTNC
+            If (IWRKF >= NVAL) Then
+               If (JINDA >= NVAL) Exit
+               IWRKF = NVAL
+            End If
+            IINDA = 1
+            IINDB = JINDA + 1
+!
+!   Shortcut for the case when the max of A is smaller
+!   than the min of B. This line may be activated when the
+!   initial set is already close to sorted.
+!
+!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
+!
+!  One steps in the C subset, that we build in the final rank array
+!
+!  Make a copy of the rank array for the merge iteration
+!
+            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
+!
+            XVALA = XDONT (JWRKT(IINDA))
+            XVALB = XDONT (IRNGT(IINDB))
+!
+            Do
+               IWRK = IWRK + 1
+!
+!  We still have unprocessed values in both A and B
+!
+               If (XVALA > XVALB) Then
+                  IRNGT (IWRK) = IRNGT (IINDB)
+                  IINDB = IINDB + 1
+                  If (IINDB > IWRKF) Then
+!  Only A still with unprocessed values
+                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
+                     Exit
+                  End If
+                  XVALB = XDONT (IRNGT(IINDB))
+               Else
+                  IRNGT (IWRK) = JWRKT (IINDA)
+                  IINDA = IINDA + 1
+                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
+                  XVALA = XDONT (JWRKT(IINDA))
+               End If
+!
+            End Do
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 2 * LMTNA
+      End Do
+!
+      Return
+!
+End Subroutine D_mrgrnk
+
+Subroutine I_mrgrnk (XDONT, IRNGT)
+! __________________________________________________________
+!   MRGRNK = Merge-sort ranking of an array
+!   For performance reasons, the first 2 passes are taken
+!   out of the standard loop, and use dedicated coding.
+! __________________________________________________________
+! __________________________________________________________
+      Integer, Dimension (:), Intent (In)  :: XDONT
+      Integer, Dimension (:), Intent (Out) :: IRNGT
+! __________________________________________________________
+      Integer :: XVALA, XVALB
+!
+      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
+      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
+      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
+!
+      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
+      Select Case (NVAL)
+      Case (:0)
+         Return
+      Case (1)
+         IRNGT (1) = 1
+         Return
+      Case Default
+         Continue
+      End Select
+!
+!  Fill-in the index array, creating ordered couples
+!
+      Do IIND = 2, NVAL, 2
+         If (XDONT(IIND-1) <= XDONT(IIND)) Then
+            IRNGT (IIND-1) = IIND - 1
+            IRNGT (IIND) = IIND
+         Else
+            IRNGT (IIND-1) = IIND
+            IRNGT (IIND) = IIND - 1
+         End If
+      End Do
+      If (Modulo(NVAL, 2) /= 0) Then
+         IRNGT (NVAL) = NVAL
+      End If
+!
+!  We will now have ordered subsets A - B - A - B - ...
+!  and merge A and B couples into     C   -   C   - ...
+!
+      LMTNA = 2
+      LMTNC = 4
+!
+!  First iteration. The length of the ordered subsets goes from 2 to 4
+!
+      Do
+         If (NVAL <= 2) Exit
+!
+!   Loop on merges of A and B into C
+!
+         Do IWRKD = 0, NVAL - 1, 4
+            If ((IWRKD+4) > NVAL) Then
+               If ((IWRKD+2) >= NVAL) Exit
+!
+!   1 2 3
+!
+               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
+!
+!   1 3 2
+!
+               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+                  IRNG2 = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNG2
+!
+!   3 1 2
+!
+               Else
+                  IRNG1 = IRNGT (IWRKD+1)
+                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNG1
+               End If
+               Exit
+            End If
+!
+!   1 2 3 4
+!
+            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
+!
+!   1 3 x x
+!
+            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   1 3 2 4
+                  IRNGT (IWRKD+3) = IRNG2
+               Else
+!   1 3 4 2
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+!
+!   3 x x x
+!
+            Else
+               IRNG1 = IRNGT (IWRKD+1)
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
+                  IRNGT (IWRKD+2) = IRNG1
+                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   3 1 2 4
+                     IRNGT (IWRKD+3) = IRNG2
+                  Else
+!   3 1 4 2
+                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                     IRNGT (IWRKD+4) = IRNG2
+                  End If
+               Else
+!   3 4 1 2
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+3) = IRNG1
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+            End If
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 4
+         Exit
+      End Do
+!
+!  Iteration loop. Each time, the length of the ordered subsets
+!  is doubled.
+!
+      Do
+         If (LMTNA >= NVAL) Exit
+         IWRKF = 0
+         LMTNC = 2 * LMTNC
+!
+!   Loop on merges of A and B into C
+!
+         Do
+            IWRK = IWRKF
+            IWRKD = IWRKF + 1
+            JINDA = IWRKF + LMTNA
+            IWRKF = IWRKF + LMTNC
+            If (IWRKF >= NVAL) Then
+               If (JINDA >= NVAL) Exit
+               IWRKF = NVAL
+            End If
+            IINDA = 1
+            IINDB = JINDA + 1
+!
+!   Shortcut for the case when the max of A is smaller
+!   than the min of B. This line may be activated when the
+!   initial set is already close to sorted.
+!
+!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
+!
+!  One steps in the C subset, that we build in the final rank array
+!
+!  Make a copy of the rank array for the merge iteration
+!
+            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
+!
+            XVALA = XDONT (JWRKT(IINDA))
+            XVALB = XDONT (IRNGT(IINDB))
+!
+            Do
+               IWRK = IWRK + 1
+!
+!  We still have unprocessed values in both A and B
+!
+               If (XVALA > XVALB) Then
+                  IRNGT (IWRK) = IRNGT (IINDB)
+                  IINDB = IINDB + 1
+                  If (IINDB > IWRKF) Then
+!  Only A still with unprocessed values
+                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
+                     Exit
+                  End If
+                  XVALB = XDONT (IRNGT(IINDB))
+               Else
+                  IRNGT (IWRK) = JWRKT (IINDA)
+                  IINDA = IINDA + 1
+                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
+                  XVALA = XDONT (JWRKT(IINDA))
+               End If
+!
+            End Do
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 2 * LMTNA
+      End Do
+!
+      Return
+!
+End Subroutine I_mrgrnk
+end module m_mrgrnk
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/optics_lib.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/optics_lib.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/optics_lib.F90	(revision 1262)
@@ -0,0 +1,747 @@
+! OPTICS_LIB: Optical proecures for for F90
+! Compiled/Modified:
+!   07/01/06  John Haynes (haynes@atmos.colostate.edu)
+!
+! m_wat (subroutine)
+! m_ice (subroutine)
+! mie_int (subroutine)
+  
+  module optics_lib
+  implicit none
+
+  contains
+
+! ----------------------------------------------------------------------------
+! subroutine M_WAT
+! ----------------------------------------------------------------------------
+  subroutine m_wat(freq, t, n_r, n_i)
+  implicit none
+!  
+! Purpose:
+!   compute complex index of refraction of liquid water
+!
+! Inputs:
+!   [freq]    frequency (GHz)
+!   [t]       temperature (C)
+!
+! Outputs:
+!   [n_r]     real part index of refraction
+!   [n_i]     imaginary part index of refraction
+!
+! Reference:
+!   Based on the work of Ray (1972)
+!
+! Coded:
+!   03/22/05  John Haynes (haynes@atmos.colostate.edu)
+  
+! ----- INPUTS -----
+  real*8, intent(in) :: freq,t
+  
+! ----- OUTPUTS -----
+  real*8, intent(out) :: n_r, n_i
+
+! ----- INTERNAL -----    
+  real*8 ld,es,ei,a,ls,sg,tm1,cos1,sin1
+  real*8 e_r,e_i
+  real*8 pi
+  complex*16 e_comp, sq
+
+  ld = 100.*2.99792458E8/(freq*1E9)
+  es = 78.54*(1-(4.579E-3*(t-25.)+1.19E-5*(t-25.)**2 &
+       -2.8E-8*(t-25.)**3))
+  ei = 5.27137+0.021647*t-0.00131198*t**2
+  a = -(16.8129/(t+273.))+0.0609265
+  ls = 0.00033836*exp(2513.98/(t+273.))
+  sg = 12.5664E8
+
+  tm1 = (ls/ld)**(1-a)
+  pi = acos(-1.D0)
+  cos1 = cos(0.5*a*pi)
+  sin1 = sin(0.5*a*pi)
+
+  e_r = ei + (((es-ei)*(1.+tm1*sin1))/(1.+2*tm1*sin1+tm1**2))
+  e_i = (((es-ei)*tm1*cos1)/(1.+2*tm1*sin1+tm1**2)) &
+        +((sg*ld)/1.885E11)
+
+  e_comp = dcmplx(e_r,e_i)
+  sq = sqrt(e_comp)
+  
+  n_r = real(sq)
+  n_i = aimag(sq)      
+  
+  return
+  end subroutine m_wat
+
+! ----------------------------------------------------------------------------
+! subroutine M_ICE
+! ----------------------------------------------------------------------------
+  subroutine m_ice(freq,t,n_r,n_i)
+  implicit none
+!
+! Purpose:
+!   compute complex index of refraction of ice
+!
+! Inputs:
+!   [freq]    frequency (GHz)
+!   [t]       temperature (C)
+!
+! Outputs:
+!   [n_r]     real part index of refraction
+!   [n_i]     imaginary part index of refraction
+!
+! Reference:
+!    Fortran 90 port from IDL of REFICE by Stephen G. Warren
+!
+! Modified:
+!   05/31/05  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----
+  real*8, intent(in) :: freq, t
+  
+! ----- OUTPUTS -----  
+  real*8, intent(out) :: n_r,n_i
+
+! Parameters:
+  integer*2 :: i,lt1,lt2,nwl,nwlt
+  parameter(nwl=468,nwlt=62)
+
+  real*8 :: alam,cutice,pi,t1,t2,tk,wlmax,wlmin, &
+            x,x1,x2,y,y1,y2,ylo,yhi
+
+  real*8 :: &
+       tabim(nwl),tabimt(nwlt,4),tabre(nwl),tabret(nwlt,4),temref(4), &
+       wl(nwl),wlt(nwlt)
+
+! Defines wavelength dependent complex index of refraction for ice.
+! Allowable wavelength range extends from 0.045 microns to 8.6 meter
+! temperature dependence only considered beyond 167 microns.
+! 
+! interpolation is done     n_r  vs. log(xlam)
+!                           n_r  vs.        t
+!                       log(n_i) vs. log(xlam)
+!                       log(n_i) vs.        t
+!
+! Stephen G. Warren - 1983
+! Dept. of Atmospheric Sciences
+! University of Washington
+! Seattle, Wa  98195
+!
+! Based on
+!
+!    Warren,S.G.,1984.
+!    Optical constants of ice from the ultraviolet to the microwave.
+!    Applied Optics,23,1206-1225
+!
+! Reference temperatures are -1.0,-5.0,-20.0, and -60.0 deg C
+ 
+      data temref/272.16,268.16,253.16,213.16/
+ 
+      data wlmin,wlmax/0.045,8.6e6/
+      data cutice/167.0/
+ 
+      data (wl(i),i=1,114)/ &
+      0.4430e-01,0.4510e-01,0.4590e-01,0.4680e-01,0.4770e-01,0.4860e-01, &
+      0.4960e-01,0.5060e-01,0.5170e-01,0.5280e-01,0.5390e-01,0.5510e-01, &
+      0.5640e-01,0.5770e-01,0.5900e-01,0.6050e-01,0.6200e-01,0.6360e-01, &
+      0.6530e-01,0.6700e-01,0.6890e-01,0.7080e-01,0.7290e-01,0.7380e-01, &
+      0.7510e-01,0.7750e-01,0.8000e-01,0.8270e-01,0.8550e-01,0.8860e-01, &
+      0.9180e-01,0.9300e-01,0.9540e-01,0.9920e-01,0.1033e+00,0.1078e+00, &
+      0.1100e+00,0.1127e+00,0.1140e+00,0.1181e+00,0.1210e+00,0.1240e+00, &
+      0.1272e+00,0.1295e+00,0.1305e+00,0.1319e+00,0.1333e+00,0.1348e+00, &
+      0.1362e+00,0.1370e+00,0.1378e+00,0.1387e+00,0.1393e+00,0.1409e+00, &
+      0.1425e+00,0.1435e+00,0.1442e+00,0.1450e+00,0.1459e+00,0.1468e+00, &
+      0.1476e+00,0.1480e+00,0.1485e+00,0.1494e+00,0.1512e+00,0.1531e+00, &
+      0.1540e+00,0.1550e+00,0.1569e+00,0.1580e+00,0.1589e+00,0.1610e+00, &
+      0.1625e+00,0.1648e+00,0.1669e+00,0.1692e+00,0.1713e+00,0.1737e+00, &
+      0.1757e+00,0.1779e+00,0.1802e+00,0.1809e+00,0.1821e+00,0.1833e+00, &
+      0.1843e+00,0.1850e+00,0.1860e+00,0.1870e+00,0.1880e+00,0.1890e+00, &
+      0.1900e+00,0.1910e+00,0.1930e+00,0.1950e+00,0.2100e+00,0.2500e+00, &
+      0.3000e+00,0.3500e+00,0.4000e+00,0.4100e+00,0.4200e+00,0.4300e+00, &
+      0.4400e+00,0.4500e+00,0.4600e+00,0.4700e+00,0.4800e+00,0.4900e+00, &
+      0.5000e+00,0.5100e+00,0.5200e+00,0.5300e+00,0.5400e+00,0.5500e+00/
+      data (wl(i),i=115,228)/ &
+      0.5600e+00,0.5700e+00,0.5800e+00,0.5900e+00,0.6000e+00,0.6100e+00, &
+      0.6200e+00,0.6300e+00,0.6400e+00,0.6500e+00,0.6600e+00,0.6700e+00, &
+      0.6800e+00,0.6900e+00,0.7000e+00,0.7100e+00,0.7200e+00,0.7300e+00, &
+      0.7400e+00,0.7500e+00,0.7600e+00,0.7700e+00,0.7800e+00,0.7900e+00, &
+      0.8000e+00,0.8100e+00,0.8200e+00,0.8300e+00,0.8400e+00,0.8500e+00, &
+      0.8600e+00,0.8700e+00,0.8800e+00,0.8900e+00,0.9000e+00,0.9100e+00, &
+      0.9200e+00,0.9300e+00,0.9400e+00,0.9500e+00,0.9600e+00,0.9700e+00, &
+      0.9800e+00,0.9900e+00,0.1000e+01,0.1010e+01,0.1020e+01,0.1030e+01, &
+      0.1040e+01,0.1050e+01,0.1060e+01,0.1070e+01,0.1080e+01,0.1090e+01, &
+      0.1100e+01,0.1110e+01,0.1120e+01,0.1130e+01,0.1140e+01,0.1150e+01, &
+      0.1160e+01,0.1170e+01,0.1180e+01,0.1190e+01,0.1200e+01,0.1210e+01, &
+      0.1220e+01,0.1230e+01,0.1240e+01,0.1250e+01,0.1260e+01,0.1270e+01, &
+      0.1280e+01,0.1290e+01,0.1300e+01,0.1310e+01,0.1320e+01,0.1330e+01, &
+      0.1340e+01,0.1350e+01,0.1360e+01,0.1370e+01,0.1380e+01,0.1390e+01, &
+      0.1400e+01,0.1410e+01,0.1420e+01,0.1430e+01,0.1440e+01,0.1449e+01, &
+      0.1460e+01,0.1471e+01,0.1481e+01,0.1493e+01,0.1504e+01,0.1515e+01, &
+      0.1527e+01,0.1538e+01,0.1563e+01,0.1587e+01,0.1613e+01,0.1650e+01, &
+      0.1680e+01,0.1700e+01,0.1730e+01,0.1760e+01,0.1800e+01,0.1830e+01, &
+      0.1840e+01,0.1850e+01,0.1855e+01,0.1860e+01,0.1870e+01,0.1890e+01/
+      data (wl(i),i=229,342)/ &
+      0.1905e+01,0.1923e+01,0.1942e+01,0.1961e+01,0.1980e+01,0.2000e+01, &
+      0.2020e+01,0.2041e+01,0.2062e+01,0.2083e+01,0.2105e+01,0.2130e+01, &
+      0.2150e+01,0.2170e+01,0.2190e+01,0.2220e+01,0.2240e+01,0.2245e+01, &
+      0.2250e+01,0.2260e+01,0.2270e+01,0.2290e+01,0.2310e+01,0.2330e+01, &
+      0.2350e+01,0.2370e+01,0.2390e+01,0.2410e+01,0.2430e+01,0.2460e+01, &
+      0.2500e+01,0.2520e+01,0.2550e+01,0.2565e+01,0.2580e+01,0.2590e+01, &
+      0.2600e+01,0.2620e+01,0.2675e+01,0.2725e+01,0.2778e+01,0.2817e+01, &
+      0.2833e+01,0.2849e+01,0.2865e+01,0.2882e+01,0.2899e+01,0.2915e+01, &
+      0.2933e+01,0.2950e+01,0.2967e+01,0.2985e+01,0.3003e+01,0.3021e+01, &
+      0.3040e+01,0.3058e+01,0.3077e+01,0.3096e+01,0.3115e+01,0.3135e+01, &
+      0.3155e+01,0.3175e+01,0.3195e+01,0.3215e+01,0.3236e+01,0.3257e+01, &
+      0.3279e+01,0.3300e+01,0.3322e+01,0.3345e+01,0.3367e+01,0.3390e+01, &
+      0.3413e+01,0.3436e+01,0.3460e+01,0.3484e+01,0.3509e+01,0.3534e+01, &
+      0.3559e+01,0.3624e+01,0.3732e+01,0.3775e+01,0.3847e+01,0.3969e+01, &
+      0.4099e+01,0.4239e+01,0.4348e+01,0.4387e+01,0.4444e+01,0.4505e+01, &
+      0.4547e+01,0.4560e+01,0.4580e+01,0.4719e+01,0.4904e+01,0.5000e+01, &
+      0.5100e+01,0.5200e+01,0.5263e+01,0.5400e+01,0.5556e+01,0.5714e+01, &
+      0.5747e+01,0.5780e+01,0.5814e+01,0.5848e+01,0.5882e+01,0.6061e+01, &
+      0.6135e+01,0.6250e+01,0.6289e+01,0.6329e+01,0.6369e+01,0.6410e+01/
+      data (wl(i),i=343,456)/ &
+      0.6452e+01,0.6494e+01,0.6579e+01,0.6667e+01,0.6757e+01,0.6897e+01, &
+      0.7042e+01,0.7143e+01,0.7246e+01,0.7353e+01,0.7463e+01,0.7576e+01, &
+      0.7692e+01,0.7812e+01,0.7937e+01,0.8065e+01,0.8197e+01,0.8333e+01, &
+      0.8475e+01,0.8696e+01,0.8929e+01,0.9091e+01,0.9259e+01,0.9524e+01, &
+      0.9804e+01,0.1000e+02,0.1020e+02,0.1031e+02,0.1042e+02,0.1053e+02, &
+      0.1064e+02,0.1075e+02,0.1087e+02,0.1100e+02,0.1111e+02,0.1136e+02, &
+      0.1163e+02,0.1190e+02,0.1220e+02,0.1250e+02,0.1282e+02,0.1299e+02, &
+      0.1316e+02,0.1333e+02,0.1351e+02,0.1370e+02,0.1389e+02,0.1408e+02, &
+      0.1429e+02,0.1471e+02,0.1515e+02,0.1538e+02,0.1563e+02,0.1613e+02, &
+      0.1639e+02,0.1667e+02,0.1695e+02,0.1724e+02,0.1818e+02,0.1887e+02, &
+      0.1923e+02,0.1961e+02,0.2000e+02,0.2041e+02,0.2083e+02,0.2222e+02, &
+      0.2260e+02,0.2305e+02,0.2360e+02,0.2460e+02,0.2500e+02,0.2600e+02, &
+      0.2857e+02,0.3100e+02,0.3333e+02,0.3448e+02,0.3564e+02,0.3700e+02, &
+      0.3824e+02,0.3960e+02,0.4114e+02,0.4276e+02,0.4358e+02,0.4458e+02, &
+      0.4550e+02,0.4615e+02,0.4671e+02,0.4736e+02,0.4800e+02,0.4878e+02, &
+      0.5003e+02,0.5128e+02,0.5275e+02,0.5350e+02,0.5424e+02,0.5500e+02, &
+      0.5574e+02,0.5640e+02,0.5700e+02,0.5746e+02,0.5840e+02,0.5929e+02, &
+      0.6000e+02,0.6100e+02,0.6125e+02,0.6250e+02,0.6378e+02,0.6467e+02, &
+      0.6558e+02,0.6655e+02,0.6760e+02,0.6900e+02,0.7053e+02,0.7300e+02/
+      data (wl(i),i=457,468)/ &
+      0.7500e+02,0.7629e+02,0.8000e+02,0.8297e+02,0.8500e+02,0.8680e+02, &
+      0.9080e+02,0.9517e+02,0.1000e+03,0.1200e+03,0.1500e+03,0.1670e+03/
+      data  wlt/ &
+                                       0.1670e+03,0.1778e+03,0.1884e+03, &
+      0.1995e+03,0.2113e+03,0.2239e+03,0.2371e+03,0.2512e+03,0.2661e+03, &
+      0.2818e+03,0.2985e+03,0.3162e+03,0.3548e+03,0.3981e+03,0.4467e+03, &
+      0.5012e+03,0.5623e+03,0.6310e+03,0.7943e+03,0.1000e+04,0.1259e+04, &
+      0.2500e+04,0.5000e+04,0.1000e+05,0.2000e+05,0.3200e+05,0.3500e+05, &
+      0.4000e+05,0.4500e+05,0.5000e+05,0.6000e+05,0.7000e+05,0.9000e+05, &
+      0.1110e+06,0.1200e+06,0.1300e+06,0.1400e+06,0.1500e+06,0.1600e+06, &
+      0.1700e+06,0.1800e+06,0.2000e+06,0.2500e+06,0.2900e+06,0.3200e+06, &
+      0.3500e+06,0.3800e+06,0.4000e+06,0.4500e+06,0.5000e+06,0.6000e+06, &
+      0.6400e+06,0.6800e+06,0.7200e+06,0.7600e+06,0.8000e+06,0.8400e+06, &
+      0.9000e+06,0.1000e+07,0.2000e+07,0.5000e+07,0.8600e+07/
+      data (tabre(i),i=1,114)/ &
+         0.83441,   0.83676,   0.83729,   0.83771,   0.83827,   0.84038, &
+         0.84719,   0.85522,   0.86047,   0.86248,   0.86157,   0.86093, &
+         0.86419,   0.86916,   0.87764,   0.89296,   0.91041,   0.93089, &
+         0.95373,   0.98188,   1.02334,   1.06735,   1.11197,   1.13134, &
+         1.15747,   1.20045,   1.23840,   1.27325,   1.32157,   1.38958, &
+         1.41644,   1.40906,   1.40063,   1.40169,   1.40934,   1.40221, &
+         1.39240,   1.38424,   1.38075,   1.38186,   1.39634,   1.40918, &
+         1.40256,   1.38013,   1.36303,   1.34144,   1.32377,   1.30605, &
+         1.29054,   1.28890,   1.28931,   1.30190,   1.32025,   1.36302, &
+         1.41872,   1.45834,   1.49028,   1.52128,   1.55376,   1.57782, &
+         1.59636,   1.60652,   1.61172,   1.61919,   1.62522,   1.63404, &
+         1.63689,   1.63833,   1.63720,   1.63233,   1.62222,   1.58269, &
+         1.55635,   1.52453,   1.50320,   1.48498,   1.47226,   1.45991, &
+         1.45115,   1.44272,   1.43498,   1.43280,   1.42924,   1.42602, &
+         1.42323,   1.42143,   1.41897,   1.41660,   1.41434,   1.41216, &
+         1.41006,   1.40805,   1.40423,   1.40067,   1.38004,   1.35085, &
+         1.33394,   1.32492,   1.31940,   1.31854,   1.31775,   1.31702, &
+         1.31633,   1.31569,   1.31509,   1.31452,   1.31399,   1.31349, &
+         1.31302,   1.31257,   1.31215,   1.31175,   1.31136,   1.31099/
+      data (tabre(i),i=115,228)/ &
+         1.31064,   1.31031,   1.30999,   1.30968,   1.30938,   1.30909, &
+         1.30882,   1.30855,   1.30829,   1.30804,   1.30780,   1.30756, &
+         1.30733,   1.30710,   1.30688,   1.30667,   1.30646,   1.30625, &
+         1.30605,   1.30585,   1.30566,   1.30547,   1.30528,   1.30509, &
+         1.30491,   1.30473,   1.30455,   1.30437,   1.30419,   1.30402, &
+         1.30385,   1.30367,   1.30350,   1.30333,   1.30316,   1.30299, &
+         1.30283,   1.30266,   1.30249,   1.30232,   1.30216,   1.30199, &
+         1.30182,   1.30166,   1.30149,   1.30132,   1.30116,   1.30099, &
+         1.30082,   1.30065,   1.30048,   1.30031,   1.30014,   1.29997, &
+         1.29979,   1.29962,   1.29945,   1.29927,   1.29909,   1.29891, &
+         1.29873,   1.29855,   1.29837,   1.29818,   1.29800,   1.29781, &
+         1.29762,   1.29743,   1.29724,   1.29705,   1.29686,   1.29666, &
+         1.29646,   1.29626,   1.29605,   1.29584,   1.29563,   1.29542, &
+         1.29521,   1.29499,   1.29476,   1.29453,   1.29430,   1.29406, &
+         1.29381,   1.29355,   1.29327,   1.29299,   1.29272,   1.29252, &
+         1.29228,   1.29205,   1.29186,   1.29167,   1.29150,   1.29130, &
+         1.29106,   1.29083,   1.29025,   1.28962,   1.28891,   1.28784, &
+         1.28689,   1.28623,   1.28521,   1.28413,   1.28261,   1.28137, &
+         1.28093,   1.28047,   1.28022,   1.27998,   1.27948,   1.27849/
+      data (tabre(i),i=229,342)/ &
+         1.27774,   1.27691,   1.27610,   1.27535,   1.27471,   1.27404, &
+         1.27329,   1.27240,   1.27139,   1.27029,   1.26901,   1.26736, &
+         1.26591,   1.26441,   1.26284,   1.26036,   1.25860,   1.25815, &
+         1.25768,   1.25675,   1.25579,   1.25383,   1.25179,   1.24967, &
+         1.24745,   1.24512,   1.24266,   1.24004,   1.23725,   1.23270, &
+         1.22583,   1.22198,   1.21548,   1.21184,   1.20790,   1.20507, &
+         1.20209,   1.19566,   1.17411,   1.14734,   1.10766,   1.06739, &
+         1.04762,   1.02650,   1.00357,   0.98197,   0.96503,   0.95962, &
+         0.97269,   0.99172,   1.00668,   1.02186,   1.04270,   1.07597, &
+         1.12954,   1.21267,   1.32509,   1.42599,   1.49656,   1.55095, &
+         1.59988,   1.63631,   1.65024,   1.64278,   1.62691,   1.61284, &
+         1.59245,   1.57329,   1.55770,   1.54129,   1.52654,   1.51139, &
+         1.49725,   1.48453,   1.47209,   1.46125,   1.45132,   1.44215, &
+         1.43366,   1.41553,   1.39417,   1.38732,   1.37735,   1.36448, &
+         1.35414,   1.34456,   1.33882,   1.33807,   1.33847,   1.34053, &
+         1.34287,   1.34418,   1.34634,   1.34422,   1.33453,   1.32897, &
+         1.32333,   1.31800,   1.31432,   1.30623,   1.29722,   1.28898, &
+         1.28730,   1.28603,   1.28509,   1.28535,   1.28813,   1.30156, &
+         1.30901,   1.31720,   1.31893,   1.32039,   1.32201,   1.32239/
+      data (tabre(i),i=343,456)/ &
+         1.32149,   1.32036,   1.31814,   1.31705,   1.31807,   1.31953, &
+         1.31933,   1.31896,   1.31909,   1.31796,   1.31631,   1.31542, &
+         1.31540,   1.31552,   1.31455,   1.31193,   1.30677,   1.29934, &
+         1.29253,   1.28389,   1.27401,   1.26724,   1.25990,   1.24510, &
+         1.22241,   1.19913,   1.17150,   1.15528,   1.13700,   1.11808, &
+         1.10134,   1.09083,   1.08734,   1.09254,   1.10654,   1.14779, &
+         1.20202,   1.25825,   1.32305,   1.38574,   1.44478,   1.47170, &
+         1.49619,   1.51652,   1.53328,   1.54900,   1.56276,   1.57317, &
+         1.58028,   1.57918,   1.56672,   1.55869,   1.55081,   1.53807, &
+         1.53296,   1.53220,   1.53340,   1.53289,   1.51705,   1.50097, &
+         1.49681,   1.49928,   1.50153,   1.49856,   1.49053,   1.46070, &
+         1.45182,   1.44223,   1.43158,   1.41385,   1.40676,   1.38955, &
+         1.34894,   1.31039,   1.26420,   1.23656,   1.21663,   1.20233, &
+         1.19640,   1.19969,   1.20860,   1.22173,   1.24166,   1.28175, &
+         1.32784,   1.38657,   1.46486,   1.55323,   1.60379,   1.61877, &
+         1.62963,   1.65712,   1.69810,   1.72065,   1.74865,   1.76736, &
+         1.76476,   1.75011,   1.72327,   1.68490,   1.62398,   1.59596, &
+         1.58514,   1.59917,   1.61405,   1.66625,   1.70663,   1.73713, &
+         1.76860,   1.80343,   1.83296,   1.85682,   1.87411,   1.89110/
+      data (tabre(i),i=457,468)/ &
+         1.89918,   1.90432,   1.90329,   1.88744,   1.87499,   1.86702, &
+         1.85361,   1.84250,   1.83225,   1.81914,   1.82268,   1.82961/
+      data (tabret(i,1),i=1,nwlt)/ &
+                                          1.82961,   1.83258,   1.83149, &
+         1.82748,   1.82224,   1.81718,   1.81204,   1.80704,   1.80250, &
+         1.79834,   1.79482,   1.79214,   1.78843,   1.78601,   1.78434, &
+         1.78322,   1.78248,   1.78201,   1.78170,   1.78160,   1.78190, &
+         1.78300,   1.78430,   1.78520,   1.78620,   1.78660,   1.78680, &
+         1.78690,   1.78700,   1.78700,   1.78710,   1.78710,   1.78720, &
+         1.78720,   1.78720,   1.78720,   1.78720,   1.78720,   1.78720, &
+         1.78720,   1.78720,   1.78720,   1.78720,   1.78720,   1.78720, &
+         1.78720,   1.78720,   1.78720,   1.78720,   1.78720,   1.78720, &
+         1.78720,   1.78720,   1.78720,   1.78720,   1.78720,   1.78720, &
+         1.78720,   1.78720,   1.78720,   1.78720,   1.78800/
+      data (tabret(i,2),i=1,nwlt)/ &
+                               1.82961,   1.83258,   1.83149,   1.82748, &
+         1.82224,   1.81718,   1.81204,   1.80704,   1.80250,   1.79834, &
+         1.79482,   1.79214,   1.78843,   1.78601,   1.78434,   1.78322, &
+         1.78248,   1.78201,   1.78170,   1.78160,   1.78190,   1.78300, &
+         1.78430,   1.78520,   1.78610,   1.78630,   1.78640,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78650,   1.78650,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78650,   1.78650,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78650,   1.78650,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78650,   1.78650,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78650,   1.78650,   1.78650, &
+         1.78650,   1.78650,   1.78650,   1.78720/
+      data(tabret(i,3),i=1,nwlt)/ &
+                    1.82961,   1.83258,   1.83149,   1.82748,   1.82224, &
+         1.81718,   1.81204,   1.80704,   1.80250,   1.79834,   1.79482, &
+         1.79214,   1.78843,   1.78601,   1.78434,   1.78322,   1.78248, &
+         1.78201,   1.78160,   1.78140,   1.78160,   1.78220,   1.78310, &
+         1.78380,   1.78390,   1.78400,   1.78400,   1.78400,   1.78400, &
+         1.78400,   1.78390,   1.78380,   1.78370,   1.78370,   1.78370, &
+         1.78370,   1.78370,   1.78370,   1.78370,   1.78370,   1.78370, &
+         1.78370,   1.78370,   1.78370,   1.78370,   1.78370,   1.78370, &
+         1.78370,   1.78370,   1.78370,   1.78370,   1.78370,   1.78370, &
+         1.78370,   1.78370,   1.78370,   1.78370,   1.78370,   1.78370, &
+         1.78370,   1.78400,   1.78450/
+      data (tabret(i,4),i=1,nwlt)/ &
+         1.82961,   1.83258,   1.83149,   1.82748,   1.82224,   1.81718, &
+         1.81204,   1.80704,   1.80250,   1.79834,   1.79482,   1.79214, &
+         1.78843,   1.78601,   1.78434,   1.78322,   1.78248,   1.78201, &
+         1.78150,   1.78070,   1.78010,   1.77890,   1.77790,   1.77730, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77720,   1.77720,   1.77720,   1.77720,   1.77720, &
+         1.77720,   1.77800/
+      data(tabim(i),i=1,114)/ &
+      0.1640e+00,0.1730e+00,0.1830e+00,0.1950e+00,0.2080e+00,0.2230e+00, &
+      0.2400e+00,0.2500e+00,0.2590e+00,0.2680e+00,0.2790e+00,0.2970e+00, &
+      0.3190e+00,0.3400e+00,0.3660e+00,0.3920e+00,0.4160e+00,0.4400e+00, &
+      0.4640e+00,0.4920e+00,0.5170e+00,0.5280e+00,0.5330e+00,0.5340e+00, &
+      0.5310e+00,0.5240e+00,0.5100e+00,0.5000e+00,0.4990e+00,0.4680e+00, &
+      0.3800e+00,0.3600e+00,0.3390e+00,0.3180e+00,0.2910e+00,0.2510e+00, &
+      0.2440e+00,0.2390e+00,0.2390e+00,0.2440e+00,0.2470e+00,0.2240e+00, &
+      0.1950e+00,0.1740e+00,0.1720e+00,0.1800e+00,0.1940e+00,0.2130e+00, &
+      0.2430e+00,0.2710e+00,0.2890e+00,0.3340e+00,0.3440e+00,0.3820e+00, &
+      0.4010e+00,0.4065e+00,0.4050e+00,0.3890e+00,0.3770e+00,0.3450e+00, &
+      0.3320e+00,0.3150e+00,0.2980e+00,0.2740e+00,0.2280e+00,0.1980e+00, &
+      0.1720e+00,0.1560e+00,0.1100e+00,0.8300e-01,0.5800e-01,0.2200e-01, &
+      0.1000e-01,0.3000e-02,0.1000e-02,0.3000e-03,0.1000e-03,0.3000e-04, &
+      0.1000e-04,0.3000e-05,0.1000e-05,0.7000e-06,0.4000e-06,0.2000e-06, &
+      0.1000e-06,0.6377e-07,0.3750e-07,0.2800e-07,0.2400e-07,0.2200e-07, &
+      0.1900e-07,0.1750e-07,0.1640e-07,0.1590e-07,0.1325e-07,0.8623e-08, &
+      0.5504e-08,0.3765e-08,0.2710e-08,0.2510e-08,0.2260e-08,0.2080e-08, &
+      0.1910e-08,0.1540e-08,0.1530e-08,0.1550e-08,0.1640e-08,0.1780e-08, &
+      0.1910e-08,0.2140e-08,0.2260e-08,0.2540e-08,0.2930e-08,0.3110e-08/
+      data(tabim(i),i=115,228)/ &
+      0.3290e-08,0.3520e-08,0.4040e-08,0.4880e-08,0.5730e-08,0.6890e-08, &
+      0.8580e-08,0.1040e-07,0.1220e-07,0.1430e-07,0.1660e-07,0.1890e-07, &
+      0.2090e-07,0.2400e-07,0.2900e-07,0.3440e-07,0.4030e-07,0.4300e-07, &
+      0.4920e-07,0.5870e-07,0.7080e-07,0.8580e-07,0.1020e-06,0.1180e-06, &
+      0.1340e-06,0.1400e-06,0.1430e-06,0.1450e-06,0.1510e-06,0.1830e-06, &
+      0.2150e-06,0.2650e-06,0.3350e-06,0.3920e-06,0.4200e-06,0.4440e-06, &
+      0.4740e-06,0.5110e-06,0.5530e-06,0.6020e-06,0.7550e-06,0.9260e-06, &
+      0.1120e-05,0.1330e-05,0.1620e-05,0.2000e-05,0.2250e-05,0.2330e-05, &
+      0.2330e-05,0.2170e-05,0.1960e-05,0.1810e-05,0.1740e-05,0.1730e-05, &
+      0.1700e-05,0.1760e-05,0.1820e-05,0.2040e-05,0.2250e-05,0.2290e-05, &
+      0.3040e-05,0.3840e-05,0.4770e-05,0.5760e-05,0.6710e-05,0.8660e-05, &
+      0.1020e-04,0.1130e-04,0.1220e-04,0.1290e-04,0.1320e-04,0.1350e-04, &
+      0.1330e-04,0.1320e-04,0.1320e-04,0.1310e-04,0.1320e-04,0.1320e-04, &
+      0.1340e-04,0.1390e-04,0.1420e-04,0.1480e-04,0.1580e-04,0.1740e-04, &
+      0.1980e-04,0.2500e-04,0.5400e-04,0.1040e-03,0.2030e-03,0.2708e-03, &
+      0.3511e-03,0.4299e-03,0.5181e-03,0.5855e-03,0.5899e-03,0.5635e-03, &
+      0.5480e-03,0.5266e-03,0.4394e-03,0.3701e-03,0.3372e-03,0.2410e-03, &
+      0.1890e-03,0.1660e-03,0.1450e-03,0.1280e-03,0.1030e-03,0.8600e-04, &
+      0.8220e-04,0.8030e-04,0.8500e-04,0.9900e-04,0.1500e-03,0.2950e-03/
+      data(tabim(i),i=229,342)/ &
+      0.4687e-03,0.7615e-03,0.1010e-02,0.1313e-02,0.1539e-02,0.1588e-02, &
+      0.1540e-02,0.1412e-02,0.1244e-02,0.1068e-02,0.8414e-03,0.5650e-03, &
+      0.4320e-03,0.3500e-03,0.2870e-03,0.2210e-03,0.2030e-03,0.2010e-03, &
+      0.2030e-03,0.2140e-03,0.2320e-03,0.2890e-03,0.3810e-03,0.4620e-03, &
+      0.5480e-03,0.6180e-03,0.6800e-03,0.7300e-03,0.7820e-03,0.8480e-03, &
+      0.9250e-03,0.9200e-03,0.8920e-03,0.8700e-03,0.8900e-03,0.9300e-03, &
+      0.1010e-02,0.1350e-02,0.3420e-02,0.7920e-02,0.2000e-01,0.3800e-01, &
+      0.5200e-01,0.6800e-01,0.9230e-01,0.1270e+00,0.1690e+00,0.2210e+00, &
+      0.2760e+00,0.3120e+00,0.3470e+00,0.3880e+00,0.4380e+00,0.4930e+00, &
+      0.5540e+00,0.6120e+00,0.6250e+00,0.5930e+00,0.5390e+00,0.4910e+00, &
+      0.4380e+00,0.3720e+00,0.3000e+00,0.2380e+00,0.1930e+00,0.1580e+00, &
+      0.1210e+00,0.1030e+00,0.8360e-01,0.6680e-01,0.5400e-01,0.4220e-01, &
+      0.3420e-01,0.2740e-01,0.2200e-01,0.1860e-01,0.1520e-01,0.1260e-01, &
+      0.1060e-01,0.8020e-02,0.6850e-02,0.6600e-02,0.6960e-02,0.9160e-02, &
+      0.1110e-01,0.1450e-01,0.2000e-01,0.2300e-01,0.2600e-01,0.2900e-01, &
+      0.2930e-01,0.3000e-01,0.2850e-01,0.1730e-01,0.1290e-01,0.1200e-01, &
+      0.1250e-01,0.1340e-01,0.1400e-01,0.1750e-01,0.2400e-01,0.3500e-01, &
+      0.3800e-01,0.4200e-01,0.4600e-01,0.5200e-01,0.5700e-01,0.6900e-01, &
+      0.7000e-01,0.6700e-01,0.6500e-01,0.6400e-01,0.6200e-01,0.5900e-01/
+      data(tabim(i),i=343,456)/ &
+      0.5700e-01,0.5600e-01,0.5500e-01,0.5700e-01,0.5800e-01,0.5700e-01, &
+      0.5500e-01,0.5500e-01,0.5400e-01,0.5200e-01,0.5200e-01,0.5200e-01, &
+      0.5200e-01,0.5000e-01,0.4700e-01,0.4300e-01,0.3900e-01,0.3700e-01, &
+      0.3900e-01,0.4000e-01,0.4200e-01,0.4400e-01,0.4500e-01,0.4600e-01, &
+      0.4700e-01,0.5100e-01,0.6500e-01,0.7500e-01,0.8800e-01,0.1080e+00, &
+      0.1340e+00,0.1680e+00,0.2040e+00,0.2480e+00,0.2800e+00,0.3410e+00, &
+      0.3790e+00,0.4090e+00,0.4220e+00,0.4220e+00,0.4030e+00,0.3890e+00, &
+      0.3740e+00,0.3540e+00,0.3350e+00,0.3150e+00,0.2940e+00,0.2710e+00, &
+      0.2460e+00,0.1980e+00,0.1640e+00,0.1520e+00,0.1420e+00,0.1280e+00, &
+      0.1250e+00,0.1230e+00,0.1160e+00,0.1070e+00,0.7900e-01,0.7200e-01, &
+      0.7600e-01,0.7500e-01,0.6700e-01,0.5500e-01,0.4500e-01,0.2900e-01, &
+      0.2750e-01,0.2700e-01,0.2730e-01,0.2890e-01,0.3000e-01,0.3400e-01, &
+      0.5300e-01,0.7550e-01,0.1060e+00,0.1350e+00,0.1761e+00,0.2229e+00, &
+      0.2746e+00,0.3280e+00,0.3906e+00,0.4642e+00,0.5247e+00,0.5731e+00, &
+      0.6362e+00,0.6839e+00,0.7091e+00,0.6790e+00,0.6250e+00,0.5654e+00, &
+      0.5433e+00,0.5292e+00,0.5070e+00,0.4883e+00,0.4707e+00,0.4203e+00, &
+      0.3771e+00,0.3376e+00,0.3056e+00,0.2835e+00,0.3170e+00,0.3517e+00, &
+      0.3902e+00,0.4509e+00,0.4671e+00,0.4779e+00,0.4890e+00,0.4899e+00, &
+      0.4873e+00,0.4766e+00,0.4508e+00,0.4193e+00,0.3880e+00,0.3433e+00/
+      data(tabim(i),i=457,468)/ &
+      0.3118e+00,0.2935e+00,0.2350e+00,0.1981e+00,0.1865e+00,0.1771e+00, &
+      0.1620e+00,0.1490e+00,0.1390e+00,0.1200e+00,0.9620e-01,0.8300e-01/
+      data(tabimt(i,1),i=1,nwlt)/ &
+                                       0.8300e-01,0.6900e-01,0.5700e-01, &
+      0.4560e-01,0.3790e-01,0.3140e-01,0.2620e-01,0.2240e-01,0.1960e-01, &
+      0.1760e-01,0.1665e-01,0.1620e-01,0.1550e-01,0.1470e-01,0.1390e-01, &
+      0.1320e-01,0.1250e-01,0.1180e-01,0.1060e-01,0.9540e-02,0.8560e-02, &
+      0.6210e-02,0.4490e-02,0.3240e-02,0.2340e-02,0.1880e-02,0.1740e-02, &
+      0.1500e-02,0.1320e-02,0.1160e-02,0.8800e-03,0.6950e-03,0.4640e-03, &
+      0.3400e-03,0.3110e-03,0.2940e-03,0.2790e-03,0.2700e-03,0.2640e-03, &
+      0.2580e-03,0.2520e-03,0.2490e-03,0.2540e-03,0.2640e-03,0.2740e-03, &
+      0.2890e-03,0.3050e-03,0.3150e-03,0.3460e-03,0.3820e-03,0.4620e-03, &
+      0.5000e-03,0.5500e-03,0.5950e-03,0.6470e-03,0.6920e-03,0.7420e-03, &
+      0.8200e-03,0.9700e-03,0.1950e-02,0.5780e-02,0.9700e-02/
+      data(tabimt(i,2),i=1,nwlt)/ &
+                            0.8300e-01,0.6900e-01,0.5700e-01,0.4560e-01, &
+      0.3790e-01,0.3140e-01,0.2620e-01,0.2240e-01,0.1960e-01,0.1760e-01, &
+      0.1665e-01,0.1600e-01,0.1500e-01,0.1400e-01,0.1310e-01,0.1230e-01, &
+      0.1150e-01,0.1080e-01,0.9460e-02,0.8290e-02,0.7270e-02,0.4910e-02, &
+      0.3300e-02,0.2220e-02,0.1490e-02,0.1140e-02,0.1060e-02,0.9480e-03, &
+      0.8500e-03,0.7660e-03,0.6300e-03,0.5200e-03,0.3840e-03,0.2960e-03, &
+      0.2700e-03,0.2520e-03,0.2440e-03,0.2360e-03,0.2300e-03,0.2280e-03, &
+      0.2250e-03,0.2200e-03,0.2160e-03,0.2170e-03,0.2200e-03,0.2250e-03, &
+      0.2320e-03,0.2390e-03,0.2600e-03,0.2860e-03,0.3560e-03,0.3830e-03, &
+      0.4150e-03,0.4450e-03,0.4760e-03,0.5080e-03,0.5400e-03,0.5860e-03, &
+      0.6780e-03,0.1280e-02,0.3550e-02,0.5600e-02/
+      data(tabimt(i,3),i=1,nwlt)/ &
+                 0.8300e-01,0.6900e-01,0.5700e-01,0.4560e-01,0.3790e-01, &
+      0.3140e-01,0.2620e-01,0.2190e-01,0.1880e-01,0.1660e-01,0.1540e-01, &
+      0.1470e-01,0.1350e-01,0.1250e-01,0.1150e-01,0.1060e-01,0.9770e-02, &
+      0.9010e-02,0.7660e-02,0.6520e-02,0.5540e-02,0.3420e-02,0.2100e-02, &
+      0.1290e-02,0.7930e-03,0.5700e-03,0.5350e-03,0.4820e-03,0.4380e-03, &
+      0.4080e-03,0.3500e-03,0.3200e-03,0.2550e-03,0.2120e-03,0.2000e-03, &
+      0.1860e-03,0.1750e-03,0.1660e-03,0.1560e-03,0.1490e-03,0.1440e-03, &
+      0.1350e-03,0.1210e-03,0.1160e-03,0.1160e-03,0.1170e-03,0.1200e-03, &
+      0.1230e-03,0.1320e-03,0.1440e-03,0.1680e-03,0.1800e-03,0.1900e-03, &
+      0.2090e-03,0.2160e-03,0.2290e-03,0.2400e-03,0.2600e-03,0.2920e-03, &
+      0.6100e-03,0.1020e-02,0.1810e-02/
+      data(tabimt(i,4),i=1,nwlt)/ &
+      0.8300e-01,0.6900e-01,0.5700e-01,0.4450e-01,0.3550e-01,0.2910e-01, &
+      0.2440e-01,0.1970e-01,0.1670e-01,0.1400e-01,0.1235e-01,0.1080e-01, &
+      0.8900e-02,0.7340e-02,0.6400e-02,0.5600e-02,0.5000e-02,0.4520e-02, &
+      0.3680e-02,0.2990e-02,0.2490e-02,0.1550e-02,0.9610e-03,0.5950e-03, &
+      0.3690e-03,0.2670e-03,0.2510e-03,0.2290e-03,0.2110e-03,0.1960e-03, &
+      0.1730e-03,0.1550e-03,0.1310e-03,0.1130e-03,0.1060e-03,0.9900e-04, &
+      0.9300e-04,0.8730e-04,0.8300e-04,0.7870e-04,0.7500e-04,0.6830e-04, &
+      0.5600e-04,0.4960e-04,0.4550e-04,0.4210e-04,0.3910e-04,0.3760e-04, &
+      0.3400e-04,0.3100e-04,0.2640e-04,0.2510e-04,0.2430e-04,0.2390e-04, &
+      0.2370e-04,0.2380e-04,0.2400e-04,0.2460e-04,0.2660e-04,0.4450e-04, &
+      0.8700e-04,0.1320e-03/
+ 
+  pi = acos(-1.0)
+  n_r=0.0
+  n_i=0.0
+
+! // convert frequency to wavelength (um)
+  alam=3E5/freq
+  if((alam < wlmin) .or. (alam > wlmax)) then
+    print *, 'm_ice: wavelength out of bounds'
+    stop
+  endif
+
+! // convert temperature to K
+  tk = t + 273.16
+
+  if (alam < cutice) then
+
+!   // region from 0.045 microns to 167.0 microns - no temperature depend
+    do i=2,nwl
+      if(alam < wl(i)) continue
+    enddo
+    x1=log(wl(i-1))
+    x2=log(wl(i))
+    y1=tabre(i-1)
+    y2=tabre(i)
+    x=log(alam)
+    y=((x-x1)*(y2-y1)/(x2-x1))+y1
+    n_r=y
+    y1=log(abs(tabim(i-1)))
+    y2=log(abs(tabim(i)))
+    y=((x-x1)*(y2-y1)/(x2-x1))+y1
+    n_i=exp(y)
+
+  else
+
+!   // region from 167.0 microns to 8.6 meters - temperature dependence
+    if(tk > temref(1)) tk=temref(1)
+    if(tk < temref(4)) tk=temref(4)
+    do 11 i=2,4
+      if(tk.ge.temref(i)) go to 12
+    11 continue
+    12 lt1=i
+    lt2=i-1
+    do 13 i=2,nwlt
+      if(alam.le.wlt(i)) go to 14
+    13 continue
+    14 x1=log(wlt(i-1))
+    x2=log(wlt(i))
+    y1=tabret(i-1,lt1)
+    y2=tabret(i,lt1)
+    x=log(alam)
+    ylo=((x-x1)*(y2-y1)/(x2-x1))+y1
+    y1=tabret(i-1,lt2)
+    y2=tabret(i,lt2)
+    yhi=((x-x1)*(y2-y1)/(x2-x1))+y1
+    t1=temref(lt1)
+    t2=temref(lt2)
+    y=((tk-t1)*(yhi-ylo)/(t2-t1))+ylo
+    n_r=y
+    y1=log(abs(tabimt(i-1,lt1)))
+    y2=log(abs(tabimt(i,lt1)))
+    ylo=((x-x1)*(y2-y1)/(x2-x1))+y1
+    y1=log(abs(tabimt(i-1,lt2)))
+    y2=log(abs(tabimt(i,lt2)))
+    yhi=((x-x1)*(y2-y1)/(x2-x1))+y1
+    y=((tk-t1)*(yhi-ylo)/(t2-t1))+ylo
+    n_i=exp(y)
+
+  endif
+
+  end subroutine m_ice
+
+! ----------------------------------------------------------------------------
+! subroutine MIEINT
+! ----------------------------------------------------------------------------
+!
+!     General purpose Mie scattering routine for single particles
+!     Author: R Grainger 1990
+!     History:
+!     G Thomas, March 2005: Added calculation of Phase function and
+!     code to ensure correct calculation of backscatter coeficient
+!     Options/Extend_Source
+!
+      Subroutine MieInt(Dx, SCm, Inp, Dqv, Dqxt, Dqsc, Dbsc, Dg, Xs1, Xs2, DPh, Error)
+
+      Integer * 2  Imaxx
+      Parameter (Imaxx = 12000)
+      Real * 4     RIMax          ! largest real part of refractive index
+      Parameter (RIMax = 2.5)
+      Real * 4     IRIMax         ! largest imaginary part of refractive index
+      Parameter (IRIMax = -2)
+      Integer * 2  Itermax
+      Parameter (Itermax = 12000 * 2.5)
+                                ! must be large enough to cope with the
+                                ! largest possible nmx = x * abs(scm) + 15
+                                ! or nmx =  Dx + 4.05*Dx**(1./3.) + 2.0
+      Integer * 2  Imaxnp
+      Parameter (Imaxnp = 10000)  ! Change this as required
+!     INPUT
+      Real * 8     Dx
+      Complex * 16  SCm
+      Integer * 4  Inp
+      Real * 8     Dqv(Inp)
+!     OUTPUT
+      Complex * 16  Xs1(InP)
+      Complex * 16  Xs2(InP)
+      Real * 8     Dqxt
+      Real * 8     Dqsc
+      Real * 8     Dg
+      Real * 8     Dbsc
+      Real * 8     DPh(InP)
+      Integer * 4  Error
+!     LOCAL
+      Integer * 2  I
+      Integer * 2  NStop
+      Integer * 2  NmX
+      Integer * 4  N    ! N*N > 32767 ie N > 181
+      Integer * 4  Inp2
+      Real * 8     Chi,Chi0,Chi1
+      Real * 8     APsi,APsi0,APsi1
+      Real * 8     Pi0(Imaxnp)
+      Real * 8     Pi1(Imaxnp)
+      Real * 8     Taun(Imaxnp)
+      Real * 8     Psi,Psi0,Psi1
+      Complex * 8  Ir
+      Complex * 16 Cm
+      Complex * 16 A,ANM1,APB
+      Complex * 16 B,BNM1,AMB
+      Complex * 16 D(Itermax)
+      Complex * 16 Sp(Imaxnp)
+      Complex * 16 Sm(Imaxnp)
+      Complex * 16 Xi,Xi0,Xi1
+      Complex * 16 Y
+!     ACCELERATOR VARIABLES
+      Integer * 2  Tnp1
+      Integer * 2  Tnm1
+      Real * 8     Dn
+      Real * 8     Rnx
+      Real * 8     S(Imaxnp)
+      Real * 8     T(Imaxnp)
+      Real * 8     Turbo
+      Real * 8     A2
+      Complex * 16 A1
+      
+      If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
+        Error = 1
+        Return
+      EndIf
+      Cm = SCm
+      Ir = 1 / Cm
+      Y =  Dx * Cm
+      If (Dx.Lt.0.02) Then
+         NStop = 2
+      Else
+         If (Dx.Le.8.0) Then
+            NStop = Dx + 4.00*Dx**(1./3.) + 2.0
+         Else
+            If (Dx.Lt. 4200.0) Then
+               NStop = Dx + 4.05*Dx**(1./3.) + 2.0
+            Else
+               NStop = Dx + 4.00*Dx**(1./3.) + 2.0
+            End If
+         End If
+      End If
+      NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
+      If (Nmx .gt. Itermax) then
+          Error = 1
+          Return
+      End If
+      Inp2 = Inp+1
+      D(NmX) = Dcmplx(0,0)
+      Do N = Nmx-1,1,-1
+         A1 = (N+1) / Y
+         D(N) = A1 - 1/(A1+D(N+1))
+      End Do
+      Do I =1,Inp2
+         Sm(I) = Dcmplx(0,0)
+         Sp(I) = Dcmplx(0,0)
+         Pi0(I) = 0
+         Pi1(I) = 1
+      End Do
+      Psi0 = Cos(Dx)
+      Psi1 = Sin(Dx)
+      Chi0 =-Sin(Dx)
+      Chi1 = Cos(Dx)
+      APsi0 = Psi0
+      APsi1 = Psi1
+      Xi0 = Dcmplx(APsi0,Chi0)
+      Xi1 = Dcmplx(APsi1,Chi1)
+      Dg = 0
+      Dqsc = 0
+      Dqxt = 0
+      Tnp1 = 1
+      Do N = 1,Nstop
+         DN = N
+         Tnp1 = Tnp1 + 2
+         Tnm1 = Tnp1 - 2
+         A2 = Tnp1 / (DN*(DN+1D0))
+         Turbo = (DN+1D0) / DN
+         Rnx = DN/Dx
+         Psi = Dble(Tnm1)*Psi1/Dx - Psi0
+         APsi = Psi
+         Chi = Tnm1*Chi1/Dx       - Chi0
+         Xi = Dcmplx(APsi,Chi)
+         A = ((D(N)*Ir+Rnx)*APsi-APsi1) / ((D(N)*Ir+Rnx)*  Xi-  Xi1)
+         B = ((D(N)*Cm+Rnx)*APsi-APsi1) / ((D(N)*Cm+Rnx)*  Xi-  Xi1)
+         Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
+         Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
+         If (N.Gt.1) then
+	    Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
+         End If
+         Anm1 = A
+         Bnm1 = B
+         APB = A2 * (A + B)
+         AMB = A2 * (A - B)
+         Do I = 1,Inp2
+            If (I.GT.Inp) Then
+               S(I) = -Pi1(I)
+            Else
+               S(I) = Dqv(I) * Pi1(I)
+            End If
+            T(I) = S(I) - Pi0(I)
+            Taun(I) = N*T(I) - Pi0(I)
+            Sp(I) = APB * (Pi1(I) + Taun(I)) + Sp(I)
+            Sm(I) = AMB * (Pi1(I) - Taun(I)) + Sm(I)
+            Pi0(I) = Pi1(I)
+            Pi1(I) = S(I) + T(I)*Turbo
+         End Do
+         Psi0 = Psi1
+         Psi1 = Psi
+         Apsi1 = Psi1
+         Chi0 = Chi1
+         Chi1 = Chi
+         Xi1 = Dcmplx(APsi1,Chi1)
+      End Do
+      If (Dg .GT.0) Dg = 2 * Dg / Dqsc
+      Dqsc =  2 * Dqsc / Dx**2
+      Dqxt =  2 * Dqxt / Dx**2
+      Do I = 1,Inp
+         Xs1(I) = (Sp(I)+Sm(I)) / 2
+         Xs2(I) = (Sp(I)-Sm(I)) / 2
+         Dph(I) = 2 * Dble(Xs1(I)*Conjg(Xs1(I)) + Xs2(I)*Conjg(Xs2(I))) / (Dx**2 * Dqsc)
+      End Do
+      Dbsc = 4 * Abs(( (Sp(Inp2)+Sm(Inp2))/2 )**2) / Dx**2
+      Error = 0
+      Return
+      End subroutine MieInt
+
+  end module optics_lib
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/pf_to_mr.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/pf_to_mr.F	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/pf_to_mr.F	(revision 1262)
@@ -0,0 +1,128 @@
+! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list 
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation 
+!       nor the names of its contributors may be used to endorse or promote products derived from 
+!       this software without specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+      
+      subroutine pf_to_mr(npoints,nlev,ncol,rain_ls,snow_ls,grpl_ls,
+     &                    rain_cv,snow_cv,prec_frac,
+     &                    p,t,mx_rain_ls,mx_snow_ls,mx_grpl_ls,
+     &                    mx_rain_cv,mx_snow_cv)
+
+
+      implicit none
+
+      INTEGER npoints       !  number of model points in the horizontal
+      INTEGER nlev          !  number of model levels in column
+      INTEGER ncol          !  number of subcolumns
+
+      INTEGER i,j,ilev,ibox
+      
+      REAL rain_ls(npoints,nlev),snow_ls(npoints,nlev) ! large-scale precipitation flux
+      REAL grpl_ls(npoints,nlev)
+      REAL rain_cv(npoints,nlev),snow_cv(npoints,nlev) ! convective precipitation flux
+
+      REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky
+                                        ! 1 -> LS precipitation
+                                        ! 2 -> CONV precipitation
+                                        ! 3 -> both
+      REAL mx_rain_ls(npoints,ncol,nlev),mx_snow_ls(npoints,ncol,nlev)
+      REAL mx_grpl_ls(npoints,ncol,nlev)
+      REAL mx_rain_cv(npoints,ncol,nlev),mx_snow_cv(npoints,ncol,nlev)
+      REAL p(npoints,nlev),t(npoints,nlev)
+      REAL ar,as,ag,br,bs,bg,nr,ns,ng,rho0,rhor,rhos,rhog,rho
+      REAL term1r,term1s,term1g,term2r,term2s,term2g,term3
+      REAL term4r_ls,term4s_ls,term4g_ls,term4r_cv,term4s_cv
+      REAL term1x2r,term1x2s,term1x2g,t123r,t123s,t123g
+      
+      ! method from Khairoutdinov and Randall (2003 JAS)		
+
+      ! --- List of constants from Appendix B
+      ! Constant in fall speed formula
+      ar=842.
+      as=4.84
+      ag=94.5
+      ! Exponent in fall speed formula
+      br=0.8
+      bs=0.25
+      bg=0.5
+      ! Intercept parameter
+      nr=8.*1000.*1000.
+      ns=3.*1000.*1000.
+      ng=4.*1000.*1000.
+      ! Densities for air and hydrometeors
+      rho0=1.29
+      rhor=1000.
+      rhos=100.
+      rhog=400.
+      ! Term 1 of Eq. (A19).
+      term1r=ar*17.8379/6.
+      term1s=as*8.28508/6.
+      term1g=ag*11.6317/6.
+      ! Term 2 of Eq. (A19).
+      term2r=(3.14159265*rhor*nr)**(-br/4.)
+      term2s=(3.14159265*rhos*ns)**(-bs/4.)
+      term2g=(3.14159265*rhog*ng)**(-bg/4.)
+      
+      term1x2r=term1r*term2r
+      term1x2s=term1s*term2s
+      term1x2g=term1g*term2g
+      do ilev=1,nlev
+        do j=1,npoints
+            rho=p(j,ilev)/(287.05*t(j,ilev))
+            term3=(rho0/rho)**0.5
+            ! Term 4 of Eq. (A19).
+            t123r=term1x2r*term3
+            t123s=term1x2s*term3
+            t123g=term1x2g*term3
+            term4r_ls=rain_ls(j,ilev)/(t123r)
+            term4s_ls=snow_ls(j,ilev)/(t123s)
+            term4g_ls=grpl_ls(j,ilev)/(t123g)
+            term4r_cv=rain_cv(j,ilev)/(t123r)
+            term4s_cv=snow_cv(j,ilev)/(t123s)
+            do ibox=1,ncol
+                mx_rain_ls(j,ibox,ilev)=0.
+                mx_snow_ls(j,ibox,ilev)=0.
+                mx_grpl_ls(j,ibox,ilev)=0.
+                mx_rain_cv(j,ibox,ilev)=0.
+                mx_snow_cv(j,ibox,ilev)=0.
+                if ((prec_frac(j,ibox,ilev) .eq. 1.) .or.
+     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then 
+                    mx_rain_ls(j,ibox,ilev)=
+     &                     (term4r_ls**(1./(1.+br/4.)))/rho
+                    mx_snow_ls(j,ibox,ilev)=
+     &                     (term4s_ls**(1./(1.+bs/4.)))/rho
+                    mx_grpl_ls(j,ibox,ilev)=
+     &                     (term4g_ls**(1./(1.+bg/4.)))/rho
+                endif
+                if ((prec_frac(j,ibox,ilev) .eq. 2.) .or.
+     &              (prec_frac(j,ibox,ilev) .eq. 3.)) then 
+                    mx_rain_cv(j,ibox,ilev)=
+     &                     (term4r_cv**(1./(1.+br/4.)))/rho
+                    mx_snow_cv(j,ibox,ilev)=
+     &                     (term4s_cv**(1./(1.+bs/4.)))/rho
+                endif
+            enddo ! loop over ncol
+        enddo ! loop over npoints
+      enddo ! loop over nlev
+  
+      end
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90	(revision 1262)
@@ -0,0 +1,465 @@
+! Simulateur COSP : Cfmip Observation Simulator Package
+! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS
+!Idelkadi Abderrahmane Aout-Septembre 2009
+
+
+  subroutine phys_cosp( itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf, &
+                        overlaplmdz,Nptslmdz,Nlevlmdz,lon,lat, presnivs, &
+                        ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phi,ph,p,skt,t, &
+                        sh,rh,tca,cca,mr_lsliq,mr_lsice,fl_lsrainI,fl_lssnowI, &
+                        fl_ccrainI,fl_ccsnowI,mr_ozone,dtau_s,dem_s)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! Inputs :
+! itap,                                 !Increment de la physiq
+! dtime,                                !Pas de temps physiq
+! overlap,                              !Overlap type in SCOPS
+! Npoints,                              !Nb de points de la grille physiq
+! Nlevels,                              !Nb de niveaux verticaux
+! Ncolumns,                             !Number of subcolumns
+! lon,lat,                              !Longitudes et latitudes de la grille LMDZ
+! ref_liq,ref_ice,                      !Rayons effectifs des particules liq et ice (en microm)
+! fracTerLic,                               !Fraction terre a convertir en masque
+! u_wind,v_wind,                        !Vents a 10m ???
+! phi,                                  !Geopotentiel
+! ph,                                   !pression pour chaque inter-couche
+! p,                                    !Pression aux milieux des couches
+! skt,t,                                !Temp au sol et temp 3D
+! sh,                                   !Humidite specifique
+! rh,                                   !Humidite relatif
+! tca,                                  !Fraction nuageuse
+! cca                                   !Fraction nuageuse convective
+! mr_lsliq,                             !Liq Cloud water content
+! mr_lsice,                             !Ice Cloud water content
+! mr_ccliq,                             !Convective Cloud Liquid water content  
+! mr_ccice,                             !Cloud ice water content
+! fl_lsrain,                            !Large scale precipitation lic
+! fl_lssnow,                            !Large scale precipitation ice
+! fl_ccrain,                            !Convective precipitation lic
+! fl_ccsnow,                            !Convective precipitation ice
+! mr_ozone,                             !Concentration ozone (Kg/Kg)
+! dem_s                                 !Cloud optical emissivity
+! dtau_s               			!Cloud optical thickness
+! emsfc_lw = 1.        			!Surface emissivity dans radlwsw.F90
+
+!!! Outputs :
+! calipso2D,                            !Lidar Low/heigh/Mean/Total-level Cloud Fraction
+! calipso3D,                            !Lidar Cloud Fraction (532 nm)
+! cfadlidar,                            !Lidar Scattering Ratio CFAD (532 nm)
+! parasolrefl,                          !PARASOL-like mono-directional reflectance
+! atb,                                  !Lidar Attenuated Total Backscatter (532 nm)
+! betamol,                              !Lidar Molecular Backscatter (532 nm)
+! cfaddbze,                             !Radar Reflectivity Factor CFAD (94 GHz)
+! clcalipso2,                           !Cloud frequency of occurrence as seen by CALIPSO but not CloudSat
+! dbze,                                 !Efective_reflectivity_factor
+! cltlidarradar,                        !Lidar and Radar Total Cloud Fraction
+! clMISR,                               !Cloud Fraction as Calculated by the MISR Simulator
+! clisccp2,                             !Cloud Fraction as Calculated by the ISCCP Simulator
+! boxtauisccp,                          !Optical Depth in Each Column as Calculated by the ISCCP Simulator
+! boxptopisccp,                         !Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator
+! tclisccp,                             !Total Cloud Fraction as Calculated by the ISCCP Simulator
+! ctpisccp,                             !Mean Cloud Top Pressure as Calculated by the ISCCP Simulator
+! tauisccp,                             !Mean Optical Depth as Calculated by the ISCCP Simulator
+! albisccp,                             !Mean Cloud Albedo as Calculated by the ISCCP Simulator
+! meantbisccp,                          !Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
+! meantbclrisccp                        !Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  USE MOD_COSP
+  USE mod_phys_lmdz_para
+  use ioipsl
+  use iophy
+ 
+  IMPLICIT NONE
+
+  ! Local variables
+  character(len=64)  :: cosp_input_nl='cosp_input_nl.txt'
+  character(len=64)  :: cosp_output_nl='cosp_output_nl.txt'
+  character(len=512), save :: finput ! Input file name
+  character(len=512), save :: cmor_nl
+  integer, save :: isccp_topheight,isccp_topheight_direction,overlap
+  integer,save  :: Ncolumns     ! Number of subcolumns in SCOPS
+  integer,parameter :: Ncollmdz=20
+  integer, save :: Npoints      ! Number of gridpoints
+  integer, save :: Nlevels      ! Number of levels
+  Integer :: Nptslmdz,Nlevlmdz ! Nb de points issus de physiq.F
+  integer, save :: Nlr          ! Number of levels in statistical outputs
+  integer, save :: Npoints_it   ! Max number of gridpoints to be processed in one iteration
+  integer :: i
+  type(cosp_config),save :: cfg   ! Configuration options
+  type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
+  type(cosp_subgrid) :: sgx     ! Subgrid outputs
+  type(cosp_sgradar) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr)    :: misr    ! Output from MISR simulator
+  type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats
+  type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
+
+  integer :: t0,t1,count_rate,count_max
+  integer :: Nlon,Nlat,geomode
+  real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw
+  integer,dimension(RTTOV_MAX_CHANNELS),save :: Channels
+  real,dimension(RTTOV_MAX_CHANNELS),save :: Surfem
+  integer, save :: surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay
+  integer, save :: Nprmts_max_hydro,Naero,Nprmts_max_aero,lidar_ice_type
+  integer, save :: platform,satellite,Instrument,Nchannels
+  logical, save :: use_vgrid,csat_vgrid,use_precipitation_fluxes,use_reff
+
+! Declaration necessaires pour les sorties IOIPSL
+  integer :: ii,idayref
+  real    :: zjulian,zstoday,zstomth,zstohf,zout,ecrit_day,ecrit_hf,ecrit_mth
+  integer :: nhori,nvert,nvertp,nvertisccp,nvertm,nvertcol
+  integer, save :: nid_day_cosp,nid_mth_cosp,nid_hf_cosp
+  logical, save :: debut_cosp=.true.
+  integer :: itau_wcosp
+  character(len=10),dimension(Ncollmdz) :: chcol=(/'c01','c02','c03','c04','c05','c06','c07','c08','c09','c10', &
+                                                   'c11','c12','c13','c14','c15','c16','c17','c18','c19','c20'/)
+  real,dimension(Ncollmdz) :: column_ax
+  integer, save :: Nlevout
+
+  include "dimensions.h"
+  include "temps.h"  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
+  integer                         :: overlaplmdz   !  overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
+!  real,dimension(Npoints,Nlevels) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
+  real,dimension(Nptslmdz,Nlevlmdz) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, & 
+                                     fl_lsrain,fl_lssnow,fl_ccrain,fl_ccsnow,fl_lsgrpl, &
+                                     zlev,mr_ozone,radliq,radice,dtau_s,dem_s,ref_liq,ref_ice
+  real,dimension(Nptslmdz,Nlevlmdz) ::  fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
+  real,dimension(Nptslmdz)        :: lon,lat,skt,fracTerLic,u_wind,v_wind
+  real,dimension(Nlevlmdz)        :: presnivs
+  integer                         :: itap,k,ip
+  real                            :: dtime,freq_cosp
+
+!
+   namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight,isccp_topheight_direction, &
+              npoints,npoints_it,ncolumns,nlevels,use_vgrid,nlr,csat_vgrid,finput, &
+              radar_freq,surface_radar,use_mie_tables, &
+              use_gas_abs,do_ray,melt_lay,k2,Nprmts_max_hydro,Naero,Nprmts_max_aero, &
+              lidar_ice_type,use_precipitation_fluxes,use_reff, &
+              platform,satellite,Instrument,Nchannels, &
+              Channels,Surfem,ZenAng,co2,ch4,n2o,co
+
+!---------------- End of declaration of variables --------------
+   
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Read namelist with COSP inputs
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+ if (debut_cosp) then
+! Lecture du namelist input 
+  open(10,file=cosp_input_nl,status='old')
+  read(10,nml=cosp_input)
+  close(10)
+! Clefs Outputs 
+  call read_cosp_output_nl(cosp_output_nl,cfg)
+
+    if ( (Ncollmdz.ne.Ncolumns).or.(Nptslmdz.ne.Npoints).or.(Nlevlmdz.ne.Nlevels) ) then
+       print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F = ', &
+               Nptslmdz, Nlevlmdz, Ncollmdz
+       print*,'Nb points Horiz, Vert, Sub-col lus dans namelist = ', &
+               Npoints, Nlevels, Ncolumns
+       print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F est different de celui lu par namelist '
+       call abort
+    endif
+
+    if (overlaplmdz.ne.overlap) then
+       print*,'Attention overlaplmdz different de overlap lu dans namelist '
+    endif
+   print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
+
+  print*,' Cles sorties cosp :'
+  print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
+          cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
+
+  endif ! debut_cosp
+
+  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
+          itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Allocate local arrays
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!        call system_clock(t0,count_rate,count_max) !!! Only for testing purposes
+        
+        
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Allocate memory for gridbox type
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Allocating memory for gridbox type...'
+
+        call construct_cosp_gridbox(float(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
+                                    Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
+                                    lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
+                                    use_precipitation_fluxes,use_reff, &
+                                    Platform,Satellite,Instrument,Nchannels,ZenAng, &
+                                    channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
+        
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Here code to populate input structure
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+        print *, 'Populating input structure...'
+        gbx%longitude = lon
+        gbx%latitude = lat
+
+        gbx%p = p !
+        gbx%ph = ph
+        gbx%zlev_half = phi/9.81
+
+       do k = 1, Nlevels-1
+       do ip = 1, Npoints
+        zlev(ip,k) = phi(ip,k)/9.81 + (phi(ip,k+1)-phi(ip,k))/9.81 * (ph(ip,k)-ph(ip,k+1))/p(ip,k)
+       enddo
+       enddo
+       do ip = 1, Npoints
+        zlev(ip,Nlevels) = zlev(ip,Nlevels-1)+ 2.*(phi(ip,Nlevels)/9.81-zlev(ip,Nlevels-1))
+       END DO
+        gbx%zlev = zlev
+
+        gbx%T = T
+        gbx%q = rh*100.
+        gbx%sh = sh
+        gbx%cca = cca !convective_cloud_amount (1)
+        gbx%tca = tca ! total_cloud_amount (1)
+        gbx%psfc = ph(:,1) !pression de surface
+        gbx%skt  = skt !Skin temperature (K)
+
+        do ip = 1, Npoints
+          if (fracTerLic(ip).ge.0.5) then
+             gbx%land(ip) = 1.
+          else
+             gbx%land(ip) = 0.
+          endif
+        enddo
+        gbx%mr_ozone  = mr_ozone !mass_fraction_of_ozone_in_air (kg/kg)
+! A voir l equivalent LMDZ (u10m et v10m)
+        gbx%u_wind  = u_wind !eastward_wind (m s-1)
+        gbx%v_wind  = v_wind !northward_wind
+! Attention
+        gbx%sunlit  = 1
+
+! A voir l equivalent LMDZ
+  mr_ccliq = 0.0
+  mr_ccice = 0.0
+        gbx%mr_hydro(:,:,I_LSCLIQ) = mr_lsliq !mixing_ratio_large_scale_cloud_liquid (kg/kg)
+        gbx%mr_hydro(:,:,I_LSCICE) = mr_lsice !mixing_ratio_large_scale_cloud_ic
+        gbx%mr_hydro(:,:,I_CVCLIQ) = mr_ccliq !mixing_ratio_convective_cloud_liquid
+        gbx%mr_hydro(:,:,I_CVCICE) = mr_ccice !mixing_ratio_convective_cloud_ice
+! A revoir
+        fl_lsrain = fl_lsrainI + fl_ccrainI
+        fl_lssnow = fl_lssnowI + fl_ccsnowI
+        gbx%rain_ls = fl_lsrain !flux_large_scale_cloud_rain (kg m^-2 s^-1)
+        gbx%snow_ls = fl_lssnow !flux_large_scale_cloud_snow
+!  A voir l equivalent LMDZ
+        fl_lsgrpl=0.
+        fl_ccsnow = 0.
+        fl_ccrain = 0.
+        gbx%grpl_ls = fl_lsgrpl  !flux_large_scale_cloud_graupel
+        gbx%rain_cv = fl_ccrain  !flux_convective_cloud_rain
+        gbx%snow_cv = fl_ccsnow  !flux_convective_cloud_snow
+
+!Attention Teste
+!       do k = 1, Nlevels
+!        do ip = 1, Npoints
+!!     liquid particles :
+!         radliq(ip,k) = 12.0e-06
+!         if (k.le.3) radliq(ip,k) = 11.0e-06
+
+!    ice particles :
+!        if ( (t(ip,k)-273.15).gt.-81.4 ) then
+!          radice(ip,k) = (0.71*(t(ip,k)-273.15)+61.29)*1e-6
+!        else
+!          radice(ip,k) = 3.5*1e-6
+!        endif
+!       END DO
+!      END DO
+
+!      gbx%Reff(:,:,I_LSCLIQ) = radliq
+!      gbx%Reff(:,:,I_LSCICE) = radice
+!      gbx%Reff(:,:,I_CVCLIQ) = radliq
+!      gbx%Reff(:,:,I_CVCICE) = radice
+!      print*,'radliq(1,:)=',radliq(1,:)
+!      print*,'radice(1,:)=',radice(1,:)
+
+     gbx%Reff(:,:,I_LSCLIQ) = ref_liq*1e-6
+     gbx%Reff(:,:,I_LSCICE) = ref_ice*1e-6
+     gbx%Reff(:,:,I_CVCLIQ) = ref_liq*1e-6
+     gbx%Reff(:,:,I_CVCICE) = ref_ice*1e-6
+!     print*,'ref_liq(1,:)=',ref_liq(1,:)*1e-6
+!     print*,'ref_liq(1,:)=',ref_ice(1,:)*1e-6
+
+        ! ISCCP simulator
+        gbx%dtau_s   = dtau_s
+        gbx%dtau_c   = 0.
+        gbx%dem_s    = dem_s
+        gbx%dem_c    = 0.
+
+! Surafce emissivity
+       emsfc_lw = 1.
+               
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Define new vertical grid
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Defining new vertical grid...'
+        call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
+
+ if (debut_cosp) then
+! Creer le fichier de sorie, definir les variable de sortie
+  ! Axe verticale (Pa ou Km)
+     Nlevout = vgrid%Nlvgrid
+   
+        do ii=1,Ncolumns
+          column_ax(ii) = float(ii)
+        enddo
+
+     include "ini_histmthCOSP.h"
+     include "ini_histdayCOSP.h"
+     include "ini_histhfCOSP.h"
+
+
+!   print*,'Fin Initialisation des sorties COSP, debut_cosp =',debut_cosp 
+!   print*,'R_UNDEF=',R_UNDEF
+
+   debut_cosp=.false.
+  endif ! debut_cosp
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+       ! Allocate memory for other types
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Allocating memory for other types...'
+        call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx)
+        call construct_cosp_sgradar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar)
+        call construct_cosp_radarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar)
+        call construct_cosp_sglidar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar)
+        call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar)
+        call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
+        call construct_cosp_misr(cfg,Npoints,misr)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Call simulator
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Calling simulator...'
+        call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Write outputs to CMOR-compliant NetCDF
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+! A traiter le cas ou l on a des valeurs indefinies
+! Attention teste
+
+! if(1.eq.0)then
+
+
+   do k = 1,Nlevout
+     do ip = 1,Npoints
+     if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
+      stlidar%lidarcld(ip,k)=0.
+     endif
+     enddo
+
+
+     do ii= 1,SR_BINS
+      do ip = 1,Npoints
+       if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
+        stlidar%cfad_sr(ip,ii,k)=0.
+       endif
+      enddo
+     enddo
+   enddo   
+   
+  do ip = 1,Npoints
+   do k = 1,Nlevlmdz 
+     if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
+      sglidar%beta_mol(ip,k)=0.
+     endif
+    
+     do ii= 1,Ncolumns
+       if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
+        sglidar%beta_tot(ip,ii,k)=0.
+       endif  
+     enddo
+
+    enddo    !k = 1,Nlevlmdz
+   enddo     !ip = 1,Npoints
+
+   do k = 1,LIDAR_NCAT
+    do ip = 1,Npoints
+     if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
+      stlidar%cldlayer(ip,k)=0.
+     endif
+    enddo
+   enddo
+
+! endif 
+
+   do ip = 1,Npoints
+    if(isccp%totalcldarea(ip).eq.-1.E+30)then
+      isccp%totalcldarea(ip)=0.
+    endif
+    if(isccp%meanptop(ip).eq.-1.E+30)then
+      isccp%meanptop(ip)=0.
+    endif
+    if(isccp%meantaucld(ip).eq.-1.E+30)then
+      isccp%meantaucld(ip)=0.
+    endif
+    if(isccp%meanalbedocld(ip).eq.-1.E+30)then
+      isccp%meanalbedocld(ip)=0.
+    endif
+    if(isccp%meantb(ip).eq.-1.E+30)then
+      isccp%meantb(ip)=0.
+    endif
+    if(isccp%meantbclr(ip).eq.-1.E+30)then
+      isccp%meantbclr(ip)=0.
+    endif
+
+    do k=1,7
+     do ii=1,7
+     if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
+      isccp%fq_isccp(ip,ii,k)=0.
+     endif
+     enddo
+    enddo
+
+    do ii=1,Ncolumns
+     if(isccp%boxtau(ip,ii).eq.-1.E+30)then
+       isccp%boxtau(ip,ii)=0.
+     endif
+    enddo
+
+    do ii=1,Ncolumns
+     if(isccp%boxptop(ip,ii).eq.-1.E+30)then
+       isccp%boxptop(ip,ii)=0.
+     endif
+    enddo
+   enddo
+
+  include "write_histmthCOSP.h"
+  include "write_histdayCOSP.h"
+  include "write_histhfCOSP.h"
+
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Deallocate memory in derived types
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Deallocating memory...'
+        call free_cosp_gridbox(gbx)
+        call free_cosp_subgrid(sgx)
+        call free_cosp_sgradar(sgradar)
+        call free_cosp_radarstats(stradar)
+        call free_cosp_sglidar(sglidar)
+        call free_cosp_lidarstats(stlidar)
+        call free_cosp_isccp(isccp)
+        call free_cosp_misr(misr)
+        call free_cosp_vgrid(vgrid)  
+  
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! Time in s. Only for testing purposes
+!  call system_clock(t1,count_rate,count_max)
+!  print *,(t1-t0)*1.0/count_rate
+    
+end subroutine phys_cosp
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90.prev
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90.prev	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/phys_cosp.F90.prev	(revision 1262)
@@ -0,0 +1,456 @@
+! Simulateur COSP : Cfmip Observation Simulator Package
+! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS
+!Idelkadi Abderrahmane Aout-Septembre 2009
+
+  subroutine phys_cosp( itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf, &
+                        overlaplmdz,Nptslmdz,Nlevlmdz,lon,lat, presnivs, &
+                        ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phi,ph,p,skt,t, &
+                        sh,rh,tca,cca,mr_lsliq,mr_lsice,fl_lsrainI,fl_lssnowI, &
+                        fl_ccrainI,fl_ccsnowI,mr_ozone,dtau_s,dem_s)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!! Inputs :
+! itap,                                 !Increment de la physiq
+! dtime,                                !Pas de temps physiq
+! overlap,                              !Overlap type in SCOPS
+! Npoints,                              !Nb de points de la grille physiq
+! Nlevels,                              !Nb de niveaux verticaux
+! Ncolumns,                             !Number of subcolumns
+! lon,lat,                              !Longitudes et latitudes de la grille LMDZ
+! ref_liq,ref_ice,                      !Rayons effectifs des particules liq et ice (en microm)
+! fracTerLic,                               !Fraction terre a convertir en masque
+! u_wind,v_wind,                        !Vents a 10m ???
+! phi,                                  !Geopotentiel
+! ph,                                   !pression pour chaque inter-couche
+! p,                                    !Pression aux milieux des couches
+! skt,t,                                !Temp au sol et temp 3D
+! sh,                                   !Humidite specifique
+! rh,                                   !Humidite relatif
+! tca,                                  !Fraction nuageuse
+! cca                                   !Fraction nuageuse convective
+! mr_lsliq,                             !Liq Cloud water content
+! mr_lsice,                             !Ice Cloud water content
+! mr_ccliq,                             !Convective Cloud Liquid water content  
+! mr_ccice,                             !Cloud ice water content
+! fl_lsrain,                            !Large scale precipitation lic
+! fl_lssnow,                            !Large scale precipitation ice
+! fl_ccrain,                            !Convective precipitation lic
+! fl_ccsnow,                            !Convective precipitation ice
+! mr_ozone,                             !Concentration ozone (Kg/Kg)
+! dem_s                                 !Cloud optical emissivity
+! dtau_s               			!Cloud optical thickness
+! emsfc_lw = 1.        			!Surface emissivity dans radlwsw.F90
+
+!!! Outputs :
+! calipso2D,                            !Lidar Low/heigh/Mean/Total-level Cloud Fraction
+! calipso3D,                            !Lidar Cloud Fraction (532 nm)
+! cfadlidar,                            !Lidar Scattering Ratio CFAD (532 nm)
+! parasolrefl,                          !PARASOL-like mono-directional reflectance
+! atb,                                  !Lidar Attenuated Total Backscatter (532 nm)
+! betamol,                              !Lidar Molecular Backscatter (532 nm)
+! cfaddbze,                             !Radar Reflectivity Factor CFAD (94 GHz)
+! clcalipso2,                           !Cloud frequency of occurrence as seen by CALIPSO but not CloudSat
+! dbze,                                 !Efective_reflectivity_factor
+! cltlidarradar,                        !Lidar and Radar Total Cloud Fraction
+! clMISR,                               !Cloud Fraction as Calculated by the MISR Simulator
+! clisccp2,                             !Cloud Fraction as Calculated by the ISCCP Simulator
+! boxtauisccp,                          !Optical Depth in Each Column as Calculated by the ISCCP Simulator
+! boxptopisccp,                         !Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator
+! tclisccp,                             !Total Cloud Fraction as Calculated by the ISCCP Simulator
+! ctpisccp,                             !Mean Cloud Top Pressure as Calculated by the ISCCP Simulator
+! tauisccp,                             !Mean Optical Depth as Calculated by the ISCCP Simulator
+! albisccp,                             !Mean Cloud Albedo as Calculated by the ISCCP Simulator
+! meantbisccp,                          !Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
+! meantbclrisccp                        !Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  USE MOD_COSP
+  USE mod_phys_lmdz_para
+  use ioipsl
+  use iophy
+ 
+  IMPLICIT NONE
+
+  ! Local variables
+  character(len=64)  :: cosp_input_nl='cosp_input_nl.txt'
+  character(len=64)  :: cosp_output_nl='cosp_output_nl.txt'
+  character(len=512), save :: finput ! Input file name
+  character(len=512), save :: cmor_nl
+  integer, save :: isccp_topheight,isccp_topheight_direction,overlap
+  integer,save  :: Ncolumns     ! Number of subcolumns in SCOPS
+  integer,parameter :: Ncollmdz=20
+  integer, save :: Npoints      ! Number of gridpoints
+  integer, save :: Nlevels      ! Number of levels
+  Integer :: Nptslmdz,Nlevlmdz ! Nb de points issus de physiq.F
+  integer, save :: Nlr          ! Number of levels in statistical outputs
+  integer, save :: Npoints_it   ! Max number of gridpoints to be processed in one iteration
+  integer :: i
+  type(cosp_config),save :: cfg   ! Configuration options
+  type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
+  type(cosp_subgrid) :: sgx     ! Subgrid outputs
+  type(cosp_sgradar) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr)    :: misr    ! Output from MISR simulator
+  type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats
+  type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
+
+  integer :: t0,t1,count_rate,count_max
+  integer :: Nlon,Nlat,geomode
+  real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw
+  integer,dimension(RTTOV_MAX_CHANNELS),save :: Channels
+  real,dimension(RTTOV_MAX_CHANNELS),save :: Surfem
+  integer, save :: surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay
+  integer, save :: Nprmts_max_hydro,Naero,Nprmts_max_aero,lidar_ice_type
+  integer, save :: platform,satellite,Instrument,Nchannels
+  logical, save :: use_vgrid,csat_vgrid,use_precipitation_fluxes,use_reff
+
+! Declaration necessaires pour les sorties IOIPSL
+  integer :: ii,idayref
+  real    :: zjulian,zstoday,zstomth,zstohf,zout,ecrit_day,ecrit_hf,ecrit_mth
+  integer :: nhori,nvert,nvertp,nvertisccp,nvertm,nvertcol
+  integer, save :: nid_day_cosp,nid_mth_cosp,nid_hf_cosp
+  logical, save :: debut_cosp=.true.
+  integer :: itau_wcosp
+  character(len=10),dimension(Ncollmdz) :: chcol=(/'c01','c02','c03','c04','c05','c06','c07','c08','c09','c10', &
+                                                   'c11','c12','c13','c14','c15','c16','c17','c18','c19','c20'/)
+  real,dimension(Ncollmdz) :: column_ax
+  integer, save :: Nlevout
+
+  include "dimensions.h"
+  include "temps.h"  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
+  integer                         :: overlaplmdz   !  overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
+!  real,dimension(Npoints,Nlevels) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
+  real,dimension(Nptslmdz,Nlevlmdz) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, & 
+                                     fl_lsrain,fl_lssnow,fl_ccrain,fl_ccsnow,fl_lsgrpl, &
+                                     zlev,mr_ozone,radliq,radice,dtau_s,dem_s
+  real,dimension(Nptslmdz,Nlevlmdz) ::  fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
+  real,dimension(Nptslmdz)        :: lon,lat,skt,fracTerLic,u_wind,v_wind
+  real,dimension(Nlevlmdz)        :: presnivs
+  real                            :: ref_liq,ref_ice 
+  integer                         :: itap,k,ip
+  real                            :: dtime,freq_cosp
+
+!
+   namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight,isccp_topheight_direction, &
+              npoints,npoints_it,ncolumns,nlevels,use_vgrid,nlr,csat_vgrid,finput, &
+              radar_freq,surface_radar,use_mie_tables, &
+              use_gas_abs,do_ray,melt_lay,k2,Nprmts_max_hydro,Naero,Nprmts_max_aero, &
+              lidar_ice_type,use_precipitation_fluxes,use_reff, &
+              platform,satellite,Instrument,Nchannels, &
+              Channels,Surfem,ZenAng,co2,ch4,n2o,co
+
+!---------------- End of declaration of variables --------------
+   
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Read namelist with COSP inputs
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+ if (debut_cosp) then
+! Lecture du namelist input 
+  open(10,file=cosp_input_nl,status='old')
+  read(10,nml=cosp_input)
+  close(10)
+! Clefs Outputs 
+  call read_cosp_output_nl(cosp_output_nl,cfg)
+
+    if ( (Ncollmdz.ne.Ncolumns).or.(Nptslmdz.ne.Npoints).or.(Nlevlmdz.ne.Nlevels) ) then
+       print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F = ', &
+               Nptslmdz, Nlevlmdz, Ncollmdz
+       print*,'Nb points Horiz, Vert, Sub-col lus dans namelist = ', &
+               Npoints, Nlevels, Ncolumns
+       print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F est different de celui lu par namelist '
+       call abort
+    endif
+
+    if (overlaplmdz.ne.overlap) then
+       print*,'Attention overlaplmdz different de overlap lu dans namelist '
+    endif
+   print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
+
+  endif ! debut_cosp
+
+  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
+          itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Allocate local arrays
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!        call system_clock(t0,count_rate,count_max) !!! Only for testing purposes
+        
+        
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Allocate memory for gridbox type
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Allocating memory for gridbox type...'
+        print*,'Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro ',Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro 
+  print*,' Cles sorties cosp :'
+  print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
+          cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
+        call construct_cosp_gridbox(float(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
+                                    Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
+                                    lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
+                                    use_precipitation_fluxes,use_reff, &
+                                    Platform,Satellite,Instrument,Nchannels,ZenAng, &
+                                    channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
+        
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! Here code to populate input structure
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+        print *, 'Populating input structure...'
+        gbx%longitude = lon
+        gbx%latitude = lat
+
+        gbx%p = p !
+        gbx%ph = ph
+        gbx%zlev_half = phi/9.81
+
+       do k = 1, Nlevels-1
+       do ip = 1, Npoints
+        zlev(ip,k) = phi(ip,k)/9.81 + (phi(ip,k+1)-phi(ip,k))/9.81 * (ph(ip,k)-ph(ip,k+1))/p(ip,k)
+       enddo
+       enddo
+       do ip = 1, Npoints
+        zlev(ip,Nlevels) = zlev(ip,Nlevels-1)+ 2.*(phi(ip,Nlevels)/9.81-zlev(ip,Nlevels-1))
+       END DO
+        gbx%zlev = zlev
+
+        gbx%T = T
+        gbx%q = rh*100.
+        gbx%sh = sh
+        gbx%cca = cca !convective_cloud_amount (1)
+        gbx%tca = tca ! total_cloud_amount (1)
+        gbx%psfc = ph(:,1) !pression de surface
+        gbx%skt  = skt !Skin temperature (K)
+
+        do ip = 1, Npoints
+          if (fracTerLic(ip).ge.0.5) then
+             gbx%land(ip) = 1.
+          else
+             gbx%land(ip) = 0.
+          endif
+        enddo
+        gbx%mr_ozone  = mr_ozone !mass_fraction_of_ozone_in_air (kg/kg)
+! A voir l equivalent LMDZ (u10m et v10m)
+        gbx%u_wind  = u_wind !eastward_wind (m s-1)
+        gbx%v_wind  = v_wind !northward_wind
+! Attention
+        gbx%sunlit  = 1
+
+! A voir l equivalent LMDZ
+  mr_ccliq = 0.0
+  mr_ccice = 0.0
+        gbx%mr_hydro(:,:,I_LSCLIQ) = mr_lsliq !mixing_ratio_large_scale_cloud_liquid (kg/kg)
+        gbx%mr_hydro(:,:,I_LSCICE) = mr_lsice !mixing_ratio_large_scale_cloud_ic
+        gbx%mr_hydro(:,:,I_CVCLIQ) = mr_ccliq !mixing_ratio_convective_cloud_liquid
+        gbx%mr_hydro(:,:,I_CVCICE) = mr_ccice !mixing_ratio_convective_cloud_ice
+! A revoir
+        fl_lsrain = fl_lsrainI + fl_ccrainI
+        fl_lssnow = fl_lssnowI + fl_ccsnowI
+        gbx%rain_ls = fl_lsrain !flux_large_scale_cloud_rain (kg m^-2 s^-1)
+        gbx%snow_ls = fl_lssnow !flux_large_scale_cloud_snow
+!  A voir l equivalent LMDZ
+        fl_lsgrpl=0.
+        fl_ccsnow = 0.
+        fl_ccrain = 0.
+        gbx%grpl_ls = fl_lsgrpl  !flux_large_scale_cloud_graupel
+        gbx%rain_cv = fl_ccrain  !flux_convective_cloud_rain
+        gbx%snow_cv = fl_ccsnow  !flux_convective_cloud_snow
+
+!Attention Teste
+       do k = 1, Nlevels
+        do ip = 1, Npoints
+!     liquid particles :
+         radliq(ip,k) = 12.0e-06
+         if (k.le.3) radliq(ip,k) = 11.0e-06
+
+!    ice particles :
+        if ( (t(ip,k)-273.15).gt.-81.4 ) then
+          radice(ip,k) = (0.71*(t(ip,k)-273.15)+61.29)*1e-6
+        else
+          radice(ip,k) = 3.5*1e-6
+        endif
+       END DO
+      END DO
+      gbx%Reff(:,:,I_LSCLIQ) = radliq
+      gbx%Reff(:,:,I_LSCICE) = radice
+      gbx%Reff(:,:,I_CVCLIQ) = radliq
+      gbx%Reff(:,:,I_CVCICE) = radice
+
+        ! ISCCP simulator
+        gbx%dtau_s   = dtau_s
+        print*,'dtau_s(1,:)=',gbx%dtau_s(1,:)
+        gbx%dtau_c   = 0.
+        gbx%dem_s    = dem_s
+        print*,'dem_s(1,:)=',gbx%dem_s(1,:)
+        gbx%dem_c    = 0.
+
+! Surafce emissivity
+       emsfc_lw = 1.
+               
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Define new vertical grid
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Defining new vertical grid...'
+        call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
+
+ if (debut_cosp) then
+! Creer le fichier de sorie, definir les variable de sortie
+  ! Axe verticale (Pa ou Km)
+     Nlevout = vgrid%Nlvgrid
+   
+        do ii=1,Ncolumns
+          column_ax(ii) = float(ii)
+        enddo
+
+     include "ini_histmthCOSP.h"
+     include "ini_histdayCOSP.h"
+     include "ini_histhfCOSP.h"
+
+   print*,'Fin Initialisation des sorties COSP, debut_cosp =',debut_cosp 
+   print*,'R_UNDEF=',R_UNDEF
+
+   debut_cosp=.false.
+  endif ! debut_cosp
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+       ! Allocate memory for other types
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Allocating memory for other types...'
+        call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx)
+        call construct_cosp_sgradar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar)
+        call construct_cosp_radarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar)
+        call construct_cosp_sglidar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar)
+        call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar)
+        call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
+        call construct_cosp_misr(cfg,Npoints,misr)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Call simulator
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Calling simulator...'
+        call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
+         print*,'stlidar%lidarcld(1,:)=',stlidar%lidarcld(1,:)
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Write outputs to CMOR-compliant NetCDF
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+! A traiter le cas ou l on a des valeurs indefinies
+! Attention teste
+
+! if(1.eq.0)then
+
+
+   do k = 1,Nlevout
+!     do ip = 1,Npoints
+!     if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
+!      stlidar%lidarcld(ip,k)=0.
+!     endif
+!     enddo
+
+
+     do ii= 1,SR_BINS
+      do ip = 1,Npoints
+       if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
+        stlidar%cfad_sr(ip,ii,k)=0.
+       endif
+      enddo
+     enddo
+   enddo   
+   
+  do ip = 1,Npoints
+   do k = 1,Nlevlmdz 
+     if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
+      sglidar%beta_mol(ip,k)=0.
+     endif
+    
+     do ii= 1,Ncolumns
+       if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
+        sglidar%beta_tot(ip,ii,k)=0.
+       endif  
+     enddo
+
+    enddo    !k = 1,Nlevlmdz
+   enddo     !ip = 1,Npoints
+
+   do k = 1,LIDAR_NCAT
+    do ip = 1,Npoints
+     if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
+      stlidar%cldlayer(ip,k)=0.
+     endif
+    enddo
+   enddo
+
+! endif 
+
+   do ip = 1,Npoints
+    if(isccp%totalcldarea(ip).eq.-1.E+30)then
+      isccp%totalcldarea(ip)=0.
+    endif
+    if(isccp%meanptop(ip).eq.-1.E+30)then
+      isccp%meanptop(ip)=0.
+    endif
+    if(isccp%meantaucld(ip).eq.-1.E+30)then
+      isccp%meantaucld(ip)=0.
+    endif
+    if(isccp%meanalbedocld(ip).eq.-1.E+30)then
+      isccp%meanalbedocld(ip)=0.
+    endif
+    if(isccp%meantb(ip).eq.-1.E+30)then
+      isccp%meantb(ip)=0.
+    endif
+    if(isccp%meantbclr(ip).eq.-1.E+30)then
+      isccp%meantbclr(ip)=0.
+    endif
+
+    do k=1,7
+     do ii=1,7
+     if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
+      isccp%fq_isccp(ip,ii,k)=0.
+     endif
+     enddo
+    enddo
+
+    do ii=1,Ncolumns
+     if(isccp%boxtau(ip,ii).eq.-1.E+30)then
+       isccp%boxtau(ip,ii)=0.
+     endif
+    enddo
+
+    do ii=1,Ncolumns
+     if(isccp%boxptop(ip,ii).eq.-1.E+30)then
+       isccp%boxptop(ip,ii)=0.
+     endif
+    enddo
+   enddo
+
+  include "write_histmthCOSP.h"
+  include "write_histdayCOSP.h"
+  include "write_histhfCOSP.h"
+
+
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        ! Deallocate memory in derived types
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        print *, 'Deallocating memory...'
+        call free_cosp_gridbox(gbx)
+        call free_cosp_subgrid(sgx)
+        call free_cosp_sgradar(sgradar)
+        call free_cosp_radarstats(stradar)
+        call free_cosp_sglidar(sglidar)
+        call free_cosp_lidarstats(stlidar)
+        call free_cosp_isccp(isccp)
+        call free_cosp_misr(misr)
+        call free_cosp_vgrid(vgrid)  
+  
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! Time in s. Only for testing purposes
+!  call system_clock(t1,count_rate,count_max)
+!  print *,(t1-t0)*1.0/count_rate
+    
+end subroutine phys_cosp
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/prec_scops.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/prec_scops.F	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/prec_scops.F	(revision 1262)
@@ -0,0 +1,268 @@
+! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without modification, are permitted 
+! provided that the following conditions are met:
+! 
+!     * Redistributions of source code must retain the above copyright notice, this list 
+!       of conditions and the following disclaimer.
+!     * Redistributions in binary form must reproduce the above copyright notice, this list 
+!       of conditions and the following disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Lawrence Livermore National Security Limited Liability Corporation 
+!       nor the names of its contributors may be used to endorse or promote products derived from 
+!       this software without specific prior written permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
+! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
+! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
+! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
+! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+      
+      subroutine prec_scops(npoints,nlev,ncol,ls_p_rate,cv_p_rate,
+     &                      frac_out,prec_frac)
+
+
+      implicit none
+
+      INTEGER npoints       !  number of model points in the horizontal
+      INTEGER nlev          !  number of model levels in column
+      INTEGER ncol          !  number of subcolumns
+
+      INTEGER i,j,ilev,ibox,cv_col
+      
+      REAL ls_p_rate(npoints,nlev),cv_p_rate(npoints,nlev)
+
+      REAL frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into
+                              ! Equivalent of BOX in original version, but
+                              ! indexed by column then row, rather than
+                              ! by row then column
+                              !TOA to SURFACE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky
+                                        ! 1 -> LS precipitation
+                                        ! 2 -> CONV precipitation
+					! 3 -> both
+                                        !TOA to SURFACE!!!!!!!!!!!!!!!!!!
+					
+      INTEGER flag_ls, flag_cv
+      INTEGER frac_out_ls(npoints,ncol),frac_out_cv(npoints,ncol) !flag variables for 
+                       ! stratiform cloud and convective cloud in the vertical column
+
+      cv_col = 0.05*ncol
+      if (cv_col .eq. 0) cv_col=1
+ 
+      do ilev=1,nlev
+      do ibox=1,ncol
+        do j=1,npoints 
+        prec_frac(j,ibox,ilev) = 0
+        enddo
+      enddo
+      enddo
+      
+      do j=1,npoints
+       do ibox=1,ncol
+       frac_out_ls(j,ibox)=0
+       frac_out_cv(j,ibox)=0
+       flag_ls=0
+       flag_cv=0
+        do ilev=1,nlev
+	 if (frac_out(j,ibox,ilev) .eq. 1) then 
+	  flag_ls=1
+	 endif
+	 if (frac_out(j,ibox,ilev) .eq. 2) then 
+	  flag_cv=1
+	 endif
+	enddo !loop over nlev
+	if (flag_ls .eq. 1) then
+	 frac_out_ls(j,ibox)=1
+	endif
+	if (flag_cv .eq. 1) then
+	 frac_out_cv(j,ibox)=1
+	endif
+       enddo  ! loop over ncol
+      enddo ! loop over npoints
+
+!      initialize the top layer      
+       do j=1,npoints
+        flag_ls=0
+	flag_cv=0
+	
+        if (ls_p_rate(j,1) .gt. 0.) then 
+         do ibox=1,ncol ! possibility ONE
+          if (frac_out(j,ibox,1) .eq. 1) then 
+           prec_frac(j,ibox,1) = 1
+	   flag_ls=1
+	  endif
+	 enddo ! loop over ncol
+	 if (flag_ls .eq. 0) then ! possibility THREE
+	  do ibox=1,ncol
+	   if (frac_out(j,ibox,2) .eq. 1) then 
+	    prec_frac(j,ibox,1) = 1
+	    flag_ls=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_ls .eq. 0) then ! possibility Four
+	  do ibox=1,ncol
+	   if (frac_out_ls(j,ibox) .eq. 1) then 
+	    prec_frac(j,ibox,1) = 1
+	    flag_ls=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_ls .eq. 0) then ! possibility Five
+	  do ibox=1,ncol
+!	  prec_frac(j,1:ncol,1) = 1
+	  prec_frac(j,ibox,1) = 1
+	  enddo ! loop over ncol
+       	 endif
+	endif
+       ! There is large scale precipitation
+	 
+        if (cv_p_rate(j,1) .gt. 0.) then 
+         do ibox=1,ncol ! possibility ONE
+          if (frac_out(j,ibox,1) .eq. 2) then 
+           if (prec_frac(j,ibox,1) .eq. 0) then
+	    prec_frac(j,ibox,1) = 2
+	   else
+	    prec_frac(j,ibox,1) = 3
+	   endif
+	   flag_cv=1
+	  endif
+	 enddo ! loop over ncol
+	 if (flag_cv .eq. 0) then ! possibility THREE
+	  do ibox=1,ncol
+	   if (frac_out(j,ibox,2) .eq. 2) then 
+            if (prec_frac(j,ibox,1) .eq. 0) then
+	     prec_frac(j,ibox,1) = 2
+	    else
+	     prec_frac(j,ibox,1) = 3
+	    endif
+	    flag_cv=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_cv .eq. 0) then ! possibility Four
+	  do ibox=1,ncol
+	   if (frac_out_cv(j,ibox) .eq. 1) then 
+            if (prec_frac(j,ibox,1) .eq. 0) then
+	     prec_frac(j,ibox,1) = 2
+	    else
+	     prec_frac(j,ibox,1) = 3
+	    endif
+	    flag_cv=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_cv .eq. 0) then  ! possibility Five
+	  do ibox=1,cv_col
+            if (prec_frac(j,ibox,1) .eq. 0) then
+	     prec_frac(j,ibox,1) = 2
+	    else
+	     prec_frac(j,ibox,1) = 3
+	    endif 
+	  enddo !loop over cv_col
+       	 endif 
+	endif 
+       ! There is convective precipitation
+	
+       enddo ! loop over npoints
+!      end of initializing the top layer
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!     working on the levels from top to surface
+      do ilev=2,nlev
+       do j=1,npoints
+        flag_ls=0
+	flag_cv=0
+	
+        if (ls_p_rate(j,ilev) .gt. 0.) then 
+         do ibox=1,ncol ! possibility ONE&TWO
+          if ((frac_out(j,ibox,ilev) .eq. 1) .or. 
+     &       ((prec_frac(j,ibox,ilev-1) .eq. 1) 
+     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
+           prec_frac(j,ibox,ilev) = 1
+	   flag_ls=1
+          endif
+	 enddo ! loop over ncol
+	 if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
+	  do ibox=1,ncol
+	   if (frac_out(j,ibox,ilev+1) .eq. 1) then 
+	    prec_frac(j,ibox,ilev) = 1
+	    flag_ls=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_ls .eq. 0) then ! possibility Four
+	  do ibox=1,ncol
+	   if (frac_out_ls(j,ibox) .eq. 1) then 
+	    prec_frac(j,ibox,ilev) = 1
+	    flag_ls=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_ls .eq. 0) then ! possibility Five
+	  do ibox=1,ncol
+!	  prec_frac(j,1:ncol,ilev) = 1
+	  prec_frac(j,ibox,ilev) = 1
+	  enddo ! loop over ncol
+       	 endif
+	endif ! There is large scale precipitation
+	
+        if (cv_p_rate(j,ilev) .gt. 0.) then 
+         do ibox=1,ncol ! possibility ONE&TWO
+          if ((frac_out(j,ibox,ilev) .eq. 2) .or. 
+     &       ((prec_frac(j,ibox,ilev-1) .eq. 2) 
+     &       .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 
+            if (prec_frac(j,ibox,ilev) .eq. 0) then
+	     prec_frac(j,ibox,ilev) = 2
+	    else
+	     prec_frac(j,ibox,ilev) = 3
+	    endif 
+	   flag_cv=1
+          endif
+	 enddo ! loop over ncol
+	 if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE
+	  do ibox=1,ncol
+	   if (frac_out(j,ibox,ilev+1) .eq. 2) then 
+            if (prec_frac(j,ibox,ilev) .eq. 0) then
+	     prec_frac(j,ibox,ilev) = 2
+	    else
+	     prec_frac(j,ibox,ilev) = 3
+	    endif
+	    flag_cv=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_cv .eq. 0) then ! possibility Four
+	  do ibox=1,ncol
+	   if (frac_out_cv(j,ibox) .eq. 1) then 
+            if (prec_frac(j,ibox,ilev) .eq. 0) then
+	     prec_frac(j,ibox,ilev) = 2
+	    else
+	     prec_frac(j,ibox,ilev) = 3
+	    endif
+	    flag_cv=1
+	   endif
+	  enddo ! loop over ncol
+	 endif
+	 if (flag_cv .eq. 0) then  ! possibility Five 
+	  do ibox=1,cv_col
+            if (prec_frac(j,ibox,ilev) .eq. 0) then
+	     prec_frac(j,ibox,ilev) = 2
+	    else
+	     prec_frac(j,ibox,ilev) = 3
+	    endif 
+	  enddo !loop over cv_col 
+       	 endif 
+	endif ! There is convective precipitation
+
+       enddo ! loop over npoints
+      enddo ! loop over nlev
+
+      end
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator.F90	(revision 1262)
@@ -0,0 +1,511 @@
+  subroutine radar_simulator(freq,k2,do_ray,use_gas_abs,use_mie_table,mt, &
+    nhclass,hp,nprof,ngate,nsizes,D,hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix, &
+    rh_matrix,Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe, &
+    g_to_vol_in,g_to_vol_out)
+
+!     rh_matrix,Ze_non,Ze_ray,kr_matrix,g_atten_to_vol,dBZe)
+ 
+  use m_mrgrnk 
+  use array_lib
+  use math_lib
+  use optics_lib
+  use radar_simulator_types
+  implicit none
+  
+! Purpose:
+!   Simulates a vertical profile of radar reflectivity
+!   Part of QuickBeam v1.04 by John Haynes & Roger Marchand
+!
+! Inputs:
+!   [freq]            radar frequency (GHz), can be anything unless
+!                     use_mie_table=1, in which case one of 94,35,13.8,9.6,3
+!   [k2]              |K|^2, the dielectric constant, set to -1 to use the
+!                     frequency dependent default
+!   [do_ray]          1=do Rayleigh calcs, 0=not
+!   [use_gas_abs]     1=do gaseous abs calcs, 0=not,
+!                     2=use same as first profile (undocumented)
+!   [use_mie_table]   1=use Mie tables, 0=not
+!   [mt]              Mie look up table
+!   [nhclass]         number of hydrometeor types
+!   [hp]              structure that defines hydrometeor types
+!   [nprof]           number of hydrometeor profiles
+!   [ngate]           number of vertical layers
+!   [nsizes]          number of discrete particles in [D]
+!   [D]               array of discrete particles (um)
+!
+!   (The following 5 arrays must be in order from closest to the radar
+!    to farthest...)
+!   [hgt_matrix]      height of hydrometeors (km)
+!   [hm_matrix]       table of hydrometeor mixing rations (g/kg)
+!   [re_matrix]       OPTIONAL table of hydrometeor effective radii (microns)
+!   [p_matrix]        pressure profile (hPa)
+!   [t_matrix]        temperature profile (C)
+!   [rh_matrix]       relative humidity profile (%)
+!
+! Outputs:
+!   [Ze_non]          radar reflectivity without attenuation (dBZ)
+!   [Ze_ray]          Rayleigh reflectivity (dBZ)
+!   [h_atten_to_vol]  attenuation by hydromets, radar to vol (dB)
+!   [g_atten_to_vol]  gaseous atteunation, radar to vol (dB)
+!   [dBZe]            effective radar reflectivity factor (dBZ)
+!
+! Optional:
+!   [g_to_vol_in]     integrated atten due to gases, r>v (dB).
+!                     If present then is used as gaseous absorption, independently of the
+!                     value in use_gas_abs
+!   [g_to_vol_out]    integrated atten due to gases, r>v (dB).
+!                     If present then gaseous absorption for each profile is returned here.
+!
+! Created:
+!   11/28/2005  John Haynes (haynes@atmos.colostate.edu)
+! Modified:
+!   09/2006  placed into subroutine form, scaling factors (Roger Marchand,JMH)
+!   08/2007  added equivalent volume spheres, Z and N scalling most distrubtion types (Roger Marchand)
+!   01/2008  'Do while' to determine if hydrometeor(s) present in volume
+!             changed for vectorization purposes (A. Bodas-Salcedo)
+
+! ----- INPUTS -----  
+  type(mie), intent(in) :: mt
+  type(class_param), intent(inout) :: hp
+  real*8, intent(in) :: freq,k2
+  integer, intent(in) ::  do_ray,use_gas_abs,use_mie_table, &
+    nhclass,nprof,ngate,nsizes
+  real*8, dimension(nsizes), intent(in) :: D
+  real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
+    t_matrix,rh_matrix
+  real*8, dimension(nhclass,nprof,ngate), intent(in) :: hm_matrix
+  real*8, dimension(nhclass,nprof,ngate), intent(inout) :: re_matrix
+    
+! ----- OUTPUTS -----
+  real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
+ 	g_atten_to_vol,dBZe,h_atten_to_vol
+
+! ----- OPTIONAL -----
+  real*8, optional, dimension(ngate,nprof) :: &
+  g_to_vol_in,g_to_vol_out ! integrated atten due to gases, r>v (dB). This allows to output and then input
+                           ! the same gaseous absorption in different calls. Optional to allow compatibility
+                           ! with original version. A. Bodas April 2008.
+        
+!  real*8, dimension(nprof,ngate) :: kr_matrix 
+
+! ----- INTERNAL -----
+  integer :: &
+  phase, &			! 0=liquid, 1=ice
+  ns 				! number of discrete drop sizes
+
+  integer*4, dimension(ngate) :: &
+  hydro				! 1=hydrometeor in vol, 0=none
+  real*8 :: &
+  rho_a, &			! air density (kg m^-3)
+  gases				! function: 2-way gas atten (dB/km)
+
+  real*8, dimension(:), allocatable :: &
+  Di, Deq, &      		! discrete drop sizes (um)
+  Ni, Ntemp, &    		! discrete concentrations (cm^-3 um^-1)
+  rhoi				! discrete densities (kg m^-3)
+  
+  real*8, dimension(ngate) :: &
+  z_vol, &			! effective reflectivity factor (mm^6/m^3)
+  z_ray, &                      ! reflectivity factor, Rayleigh only (mm^6/m^3)
+  kr_vol, &			! attenuation coefficient hydro (dB/km)
+  g_vol, &			! attenuation coefficient gases (dB/km)
+  a_to_vol, &			! integrated atten due to hydometeors, r>v (dB)
+  g_to_vol			! integrated atten due to gases, r>v (dB)
+   
+ 
+  integer,parameter :: KR8 = selected_real_kind(15,300)
+  real*8, parameter :: xx = -1.0_KR8
+  real*8,  dimension(:), allocatable :: xxa
+  real*8 :: kr, ze, zr, pi, scale_factor, tc, Re, ld, tmp1, ze2, kr2,apm,bpm
+  integer*4 :: tp, i, j, k, pr, itt, iff
+
+  real*8 bin_length,step,base,step_list(25),base_list(25)
+  integer*4 iRe_type,n,max_bin
+  
+  logical :: g_to_vol_in_present, g_to_vol_out_present
+	
+  ! Logicals to avoid calling present within the loops
+  g_to_vol_in_present  = present(g_to_vol_in)
+  g_to_vol_out_present = present(g_to_vol_out)
+  
+    ! set up Re bins for z_scalling
+	bin_length=50;
+	max_bin=25
+
+	step_list(1)=1
+	base_list(1)=75 
+	do j=2,max_bin
+		step_list(j)=3*(j-1);
+		if(step_list(j)>bin_length) then
+			step_list(j)=bin_length;
+		endif
+		base_list(j)=base_list(j-1)+floor(bin_length/step_list(j-1));
+	enddo
+
+
+  pi = acos(-1.0)
+  if (use_mie_table == 1) iff = infind(mt%freq,freq,sort=1)
+
+	
+  ! // loop over each profile (nprof)
+  do pr=1,nprof
+
+!   ----- calculations for each volume ----- 
+    z_vol(:) = 0
+    z_ray(:) = 0
+    kr_vol(:) = 0
+    hydro(:) = 0    
+
+!   // loop over eacho range gate (ngate)
+    do k=1,ngate
+  
+!     :: determine if hydrometeor(s) present in volume
+      hydro(k) = 0
+      do j=1,nhclass ! Do while changed for vectorization purposes (A. B-S)
+        if ((hm_matrix(j,pr,k) > 1E-12) .and. (hp%dtype(j) > 0)) then
+          hydro(k) = 1
+          exit
+        endif
+      enddo
+
+      if (hydro(k) == 1) then
+!     :: if there is hydrometeor in the volume            
+
+        rho_a = (p_matrix(pr,k)*100.)/(287*(t_matrix(pr,k)+273.15))
+
+!       :: loop over hydrometeor type
+        do tp=1,nhclass
+
+          if (hm_matrix(tp,pr,k) <= 1E-12) cycle
+
+	  phase = hp%phase(tp)
+	  if(phase==0) then
+		itt = infind(mt_ttl,t_matrix(pr,k))
+  	  else
+		itt = infind(mt_tti,t_matrix(pr,k))
+      endif
+
+	  ! calculate Re if we have an exponential distribution with fixed No ... precipitation type particle
+	  if( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8)  then
+
+		apm=hp%apm(tp)
+		bpm=hp%bpm(tp)
+
+  		if ((hp%rho(tp) > 0) .and. (apm < 0)) then
+    			apm = (pi/6)*hp%rho(tp)
+    			bpm = 3.
+  		endif
+
+		tmp1 = 1./(1.+bpm)
+		ld = ((apm*gamma(1.+bpm)*hp%p1(tp))/(rho_a*hm_matrix(tp,pr,k)*1E-3))**tmp1
+		
+		Re = 1.5E6/ld 
+		
+		re_matrix(tp,pr,k) = Re;
+
+	  endif
+  
+	  if(re_matrix(tp,pr,k).eq.0) then
+
+		iRe_type=1
+		Re=0
+	  else
+		iRe_type=1
+		Re=re_matrix(tp,pr,k)
+		
+		n=floor(Re/bin_length)
+		if(n==0) then
+			if(Re<25) then
+				step=0.5
+				base=0
+			else			
+				step=1
+				base=25
+			endif
+		else
+			if(n>max_bin) then
+				n=max_bin	
+			endif
+
+			step=step_list(n)
+			base=base_list(n)
+		endif
+
+		iRe_type=floor(Re/step)
+
+		if(iRe_type.lt.1) then  
+			iRe_type=1			
+		endif
+
+		Re=step*(iRe_type+0.5)
+		iRe_type=iRe_type+base-floor(n*bin_length/step)
+
+	 	! make sure iRe_type is within bounds
+		if(iRe_type.ge.nRe_types) then  
+
+			! print *, tp, re_matrix(tp,pr,k), Re, iRe_type
+
+			! no scaling allowed
+			Re=re_matrix(tp,pr,k)
+
+			iRe_type=nRe_types
+			hp%z_flag(tp,itt,iRe_type)=.false.
+			hp%scaled(tp,iRe_type)=.false.			
+		endif
+	  endif
+	
+  	  ! use Ze_scaled, Zr_scaled, and kr_scaled ... if know them
+	  ! if not we will calculate Ze, Zr, and Kr from the distribution parameters
+  	  if( .not. hp%z_flag(tp,itt,iRe_type) )  then
+ 	 
+!         :: create a distribution of hydrometeors within volume	  
+	  select case(hp%dtype(tp))
+          case(4)
+	    ns = 1
+	    allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns))
+	    if (use_mie_table == 1) allocate(mt_qext(ns),mt_qbsca(ns),Ntemp(ns))
+	    Di = hp%p1(tp)
+	    Ni = 0.
+	  case default
+ 	    ns = nsizes            
+	    allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns))
+	    if (use_mie_table == 1) allocate(mt_qext(ns),mt_qbsca(ns),Ntemp(ns))	    
+ 	    Di = D
+ 	    Ni = 0.
+	  end select
+
+!         :: create a DSD (using scaling factor if applicable)
+	  ! hp%scaled(tp,iRe_type)=.false.   ! turn off N scaling
+
+	  call dsd(hm_matrix(tp,pr,k),Re,Di,Ni,ns,hp%dtype(tp),rho_a, &
+	    t_matrix(pr,k),hp%dmin(tp),hp%dmax(tp),hp%apm(tp),hp%bpm(tp), &
+	    hp%rho(tp),hp%p1(tp),hp%p2(tp),hp%p3(tp),hp%fc(tp,1:ns,iRe_type), &
+	    hp%scaled(tp,iRe_type))
+
+!         :: calculate particle density 
+          ! if ((hp%rho_eff(tp,1,iRe_type) < 0) .and. (phase == 1)) then
+	  if (phase == 1) then
+	    if (hp%rho(tp) < 0) then
+                
+		! MG Mie approach - adjust density of sphere with D = D_characteristic to match particle density		
+		! hp%rho_eff(tp,1:ns,iRe_type) = (6/pi)*hp%apm(tp)*(Di*1E-6)**(hp%bpm(tp)-3)   !MG Mie approach
+		
+		! as the particle size gets small it is possible that the mass to size relationship of 
+		! (given by power law in hclass.data) can produce impossible results 
+		! where the mass is larger than a solid sphere of ice.  
+		! This loop ensures that no ice particle can have more mass/density larger than an ice sphere.
+		! do i=1,ns
+		! if(hp%rho_eff(tp,i,iRe_type) > 917 ) then
+		!	hp%rho_eff(tp,i,iRe_type) = 917
+		!endif
+		!enddo
+
+		! alternative is to use equivalent volume spheres.
+	    	hp%rho_eff(tp,1:ns,iRe_type) = 917  				! solid ice == equivalent volume approach
+	      	Deq = ( ( 6/pi*hp%apm(tp)/917 ) ** (1.0/3.0) ) * &
+			   ( (Di*1E-6) ** (hp%bpm(tp)/3.0) )  * 1E6 		! Di now really Deq in microns.
+		
+            else
+
+            	! hp%rho_eff(tp,1:ns,iRe_type) = hp%rho(tp)   !MG Mie approach
+	     	
+		! Equivalent volume sphere (solid ice rho_ice=917 kg/m^3).
+	     	hp%rho_eff(tp,1:ns,iRe_type) = 917
+	     	Deq=Di * ((hp%rho(tp)/917)**(1.0/3.0))  
+
+	    endif
+
+		! if using equivalent volume spheres
+		if (use_mie_table == 1) then
+
+			Ntemp=Ni
+
+			! Find N(Di) from N(Deq) which we know
+			do i=1,ns
+                     		j=infind(Deq,Di(i))
+				Ni(i)=Ntemp(j)
+	        	enddo
+		else
+			! just use Deq and D variable input to mie code
+			Di=Deq;
+		endif
+
+	  endif
+	  rhoi = hp%rho_eff(tp,1:ns,iRe_type)
+	  
+!         :: calculate effective reflectivity factor of volume
+	  if (use_mie_table == 1) then
+	  
+	    if ((hp%dtype(tp) == 4) .and. (hp%idd(tp) < 0)) then
+              hp%idd(tp) = infind(mt%D,Di(1))
+	    endif
+	    
+	    if (phase == 0) then
+	    
+	      ! itt = infind(mt_ttl,t_matrix(pr,k))
+              select case(hp%dtype(tp))
+	      case(4)
+		mt_qext(1) = mt%qext(hp%idd(tp),itt,1,iff)
+	        mt_qbsca(1) = mt%qbsca(hp%idd(tp),itt,1,iff)
+              case default
+  	        mt_qext = mt%qext(:,itt,1,iff)
+	        mt_qbsca = mt%qbsca(:,itt,1,iff)
+	      end select
+
+          call zeff(freq,Di,Ni,ns,k2,mt_ttl(itt),0,do_ray, &
+	        ze,zr,kr,mt_qext,mt_qbsca,xx)
+	    
+	    else
+
+	      ! itt = infind(mt_tti,t_matrix(pr,k))
+	      select case(hp%dtype(tp))
+	      case(4)
+                if (hp%ifc(tp,1,iRe_type) < 0) then
+                  hp%ifc(tp,1,iRe_type) = infind(mt%f,rhoi(1)/917.)
+ 	        endif	   	      
+                mt_qext(1) = &
+		  mt%qext(hp%idd(tp),itt+cnt_liq,hp%ifc(tp,1,iRe_type),iff)
+	        mt_qbsca(1) = &
+		  mt%qbsca(hp%idd(tp),itt+cnt_liq,hp%ifc(tp,1,iRe_type),iff)	      
+	      case default
+ 	        do i=1,ns
+ 	          if (hp%ifc(tp,i,iRe_type) < 0) then
+                    hp%ifc(tp,i,iRe_type) = infind(mt%f,rhoi(i)/917.)
+ 	          endif	      
+       	          mt_qext(i) = mt%qext(i,itt+cnt_liq,hp%ifc(tp,i,iRe_type),iff)
+		  mt_qbsca(i) = mt%qbsca(i,itt+cnt_liq,hp%ifc(tp,i,iRe_type),iff)
+	        enddo
+	      end select
+
+		   call zeff(freq,Di,Ni,ns,k2,mt_tti(itt),1,do_ray, &
+	        ze,zr,kr,mt_qext,mt_qbsca,xx)
+
+	    endif
+
+	  else
+       
+	    xxa = -9.9
+	    call zeff(freq,Di,Ni,ns,k2,t_matrix(pr,k),phase,do_ray, &
+	      ze,zr,kr,xxa,xxa,rhoi)
+
+	      
+	  endif  ! end of use mie table 
+
+		! xxa = -9.9
+	    	!call zeff(freq,Di,Ni,ns,k2,t_matrix(pr,k),phase,do_ray, &
+	      	!	ze2,zr,kr2,xxa,xxa,rhoi)
+
+		! if(abs(ze2-ze)/ze2 > 0.1) then
+  		! if(abs(kr2-kr)/kr2 > 0.1) then
+  		
+		! write(*,*) pr,k,tp,ze2,ze2-ze,abs(ze2-ze)/ze2,itt+cnt_liq,iff
+		! write(*,*) pr,k,tp,ze2,kr2,kr2-kr,abs(kr2-kr)/kr2
+		! stop
+
+		!endif
+
+	  deallocate(Di,Ni,rhoi,xxa,Deq)
+  	  if (use_mie_table == 1) deallocate(mt_qext,mt_qbsca,Ntemp)
+
+	  else ! can use z scaling
+	  
+		if( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8 )  then
+		 
+			ze = hp%Ze_scaled(tp,itt,iRe_type)
+			zr = hp%Zr_scaled(tp,itt,iRe_type)
+			kr = hp%kr_scaled(tp,itt,iRe_type)
+
+		else
+	    		scale_factor=rho_a*hm_matrix(tp,pr,k) 
+
+			zr = hp%Zr_scaled(tp,itt,iRe_type) * scale_factor 
+			ze = hp%Ze_scaled(tp,itt,iRe_type) * scale_factor
+			kr = hp%kr_scaled(tp,itt,iRe_type) * scale_factor	
+		endif
+
+	  endif  ! end z_scaling
+ 
+	  ! kr=0 
+
+	  kr_vol(k) = kr_vol(k) + kr
+	  z_vol(k) = z_vol(k) + ze
+	  z_ray(k) = z_ray(k) + zr
+	
+	  ! construct Ze_scaled, Zr_scaled, and kr_scaled ... if we can
+	  if( .not. hp%z_flag(tp,itt,iRe_type) .and. 1.eq.1 ) then
+
+		if( ( (hp%dtype(tp)==1 .or. hp%dtype(tp)==5 .or.  hp%dtype(tp)==2)  .and. abs(hp%p1(tp)+1) < 1E-8  ) .or. &
+		    (  hp%dtype(tp)==3 .or. hp%dtype(tp)==4 )  &
+		) then
+
+			scale_factor=rho_a*hm_matrix(tp,pr,k) 
+
+			hp%Ze_scaled(tp,itt,iRe_type) = ze/ scale_factor
+			hp%Zr_scaled(tp,itt,iRe_type) = zr/ scale_factor
+			hp%kr_scaled(tp,itt,iRe_type) = kr/ scale_factor
+
+			hp%z_flag(tp,itt,iRe_type)=.True.
+
+		elseif( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8 ) then 
+		 
+			hp%Ze_scaled(tp,itt,iRe_type) = ze
+			hp%Zr_scaled(tp,itt,iRe_type) = zr
+			hp%kr_scaled(tp,itt,iRe_type) = kr
+
+			hp%z_flag(tp,itt,iRe_type)=.True.
+		endif
+
+	  endif
+
+        enddo	! end loop of tp (hydrometeor type)
+
+      else
+!     :: volume is hydrometeor-free
+	
+        kr_vol(k) = 0
+	z_vol(k) = -999
+        z_ray(k) = -999
+	
+      endif
+
+!     :: attenuation due to hydrometeors between radar and volume
+      a_to_vol(k) = 2*path_integral(kr_vol,hgt_matrix(pr,:),1,k-1)
+      
+!     :: attenuation due to gaseous absorption between radar and volume
+      if (g_to_vol_in_present) then
+        g_to_vol(k) = g_to_vol_in(k,pr)
+      else
+        if ( (use_gas_abs == 1) .or. ((use_gas_abs == 2) .and. (pr == 1)) )  then
+            g_vol(k) = gases(p_matrix(pr,k),t_matrix(pr,k)+273.15, &
+            rh_matrix(pr,k),freq)
+            g_to_vol(k) = path_integral(g_vol,hgt_matrix(pr,:),1,k-1)
+        elseif (use_gas_abs == 0) then
+            g_to_vol(k) = 0
+        endif  
+      endif
+    
+!      kr_matrix(pr,:)=kr_vol
+
+!     :: store results in matrix for return to calling program
+      h_atten_to_vol(pr,k)=a_to_vol(k)
+      g_atten_to_vol(pr,k)=g_to_vol(k)
+      if ((do_ray == 1) .and. (z_ray(k) > 0)) then
+        Ze_ray(pr,k) = 10*log10(z_ray(k))
+      else
+        Ze_ray(pr,k) = -999
+      endif
+      if (z_vol(k) > 0) then
+        dBZe(pr,k) = 10*log10(z_vol(k))-a_to_vol(k)-g_to_vol(k)
+        Ze_non(pr,k) = 10*log10(z_vol(k))
+      else
+        dBZe(pr,k) = -999
+        Ze_non(pr,k) = -999
+      endif
+      
+    enddo	! end loop of k (range gate)
+    ! Output array with gaseous absorption
+    if (g_to_vol_out_present) g_to_vol_out(:,pr) = g_to_vol
+  enddo		! end loop over pr (profile)  
+
+  end subroutine radar_simulator
+  
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator_types.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator_types.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/radar_simulator_types.F90	(revision 1262)
@@ -0,0 +1,53 @@
+  module radar_simulator_types
+
+! Collection of common variables and types
+! Part of QuickBeam v1.03 by John Haynes
+! http://reef.atmos.colostate.edu/haynes/radarsim
+
+  integer, parameter ::       &
+  maxhclass = 20 	     ,& ! max number of hydrometeor classes
+  nd = 85		     ,& ! number of discrete particles  
+  nRe_types = 250		! number or Re size bins allowed in N and Z_scaled look up table
+
+  real*8, parameter ::        &
+  dmin = 0.1                 ,& ! min size of discrete particle
+  dmax = 10000.                	! max size of discrete particle
+   
+  integer, parameter :: &
+  mt_nfreq = 5              , &
+  mt_ntt = 39               , &	! num temperatures in table
+  mt_nf	= 14		    , &	! number of ice fractions in table  
+  mt_nd = 85                   ! num discrete mode-p drop sizes in table
+
+
+! ---- hydrometeor class type -----  
+  
+  type class_param
+    real*8,  dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho
+    integer, dimension(maxhclass) :: dtype,col,cp,phase
+    logical, dimension(maxhclass,nRe_types) :: scaled
+    logical, dimension(maxhclass,mt_ntt,nRe_types) :: z_flag
+    real*8,  dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled
+    real*8,  dimension(maxhclass,nd,nRe_types) :: fc, rho_eff
+    integer, dimension(maxhclass,nd,nRe_types) :: ifc
+    integer, dimension(maxhclass) :: idd
+  end type class_param
+
+! ----- mie table structure -----
+  
+  type mie
+    real*8 :: freq(mt_nfreq), tt(mt_ntt), f(mt_nf), D(mt_nd)
+    real*8, dimension(mt_nd,mt_ntt,mt_nf,mt_nfreq) :: qext, qbsca
+    integer :: phase(mt_ntt)
+  end type mie
+
+  real*8, dimension(:), allocatable :: &
+    mt_ttl, &			! liquid temperatures (C)
+    mt_tti, &			! ice temperatures (C)
+    mt_qext, mt_qbsca		! extincion/backscatter efficiency
+
+  integer*4 :: &
+    cnt_liq, &			! liquid temperature count
+    cnt_ice			! ice temperature count
+
+  end module radar_simulator_types
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/read_cosp_output_nl.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/read_cosp_output_nl.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/read_cosp_output_nl.F90	(revision 1262)
@@ -0,0 +1,193 @@
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------- SUBROUTINE READ_COSP_OUTPUT_NL -------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ SUBROUTINE READ_COSP_OUTPUT_NL(cosp_nl,cfg)
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  character(len=*),intent(in) :: cosp_nl
+  type(cosp_config),intent(out) :: cfg
+  ! Local variables
+  integer :: i
+
+  logical, save ::   Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, &
+             Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, &
+             Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, &
+             Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, &
+             Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
+             Lfrac_out,Lbeta_mol532,Ltbrttov
+  namelist/COSP_OUTPUT/Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, &
+             Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, &
+             Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2, &
+             Lcllcalipso,Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp, &
+             Ltclisccp,Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
+             Lfrac_out,Lbeta_mol532,Ltbrttov
+
+  do i=1,N_OUT_LIST
+    cfg%out_list(i)=''
+  enddo
+  open(10,file=cosp_nl,status='old')
+  read(10,nml=cosp_output)
+  close(10)
+
+!  print*,' Cles sorties cosp :'
+!  print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
+!           Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim
+
+  ! Deal with dependencies
+  if (.not.Lradar_sim) then
+    Lcfad_dbze94   = .false.
+    Lclcalipso2    = .false.
+    Lcltlidarradar = .false.
+    Ldbze94        = .false.
+  endif
+  if (.not.Llidar_sim) then
+    Latb532 = .false.
+    Lcfad_lidarsr532 = .false.
+    Lclcalipso2      = .false.
+    Lclcalipso       = .false.
+    Lclhcalipso      = .false.
+    Lcllcalipso      = .false.
+    Lclmcalipso      = .false.
+    Lcltcalipso      = .false.
+    Lcltlidarradar   = .false.
+    Lparasol_refl    = .false.
+    Lbeta_mol532     = .false.
+  endif
+  if (.not.Lisccp_sim) then
+    Lalbisccp       = .false.
+    Lboxptopisccp   = .false.
+    Lboxtauisccp    = .false.
+    Lclisccp2       = .false.
+    Lctpisccp       = .false.
+    Ltauisccp       = .false.
+    Ltclisccp       = .false.
+    Lmeantbisccp    = .false.
+    Lmeantbclrisccp = .false.
+  endif
+  if (.not.Lmisr_sim) then
+    LclMISR = .false.
+  endif
+  if (.not.Lrttov_sim) then
+    Ltbrttov = .false.
+  endif
+  if ((.not.Lradar_sim).and.(.not.Llidar_sim).and. &
+      (.not.Lisccp_sim).and.(.not.Lmisr_sim)) then
+    Lfrac_out = .false.
+  endif
+
+  ! Diagnostics that use Radar and Lidar
+  if (((Lclcalipso2).or.(Lcltlidarradar)).and.((Lradar_sim).or.(Llidar_sim))) then
+    Lclcalipso2    = .true.
+    Lcltlidarradar = .true.
+    Llidar_sim     = .true.
+    Lradar_sim     = .true.
+  endif
+
+  cfg%Lstats = .false.
+  if ((Lradar_sim).or.(Llidar_sim).or.(Lisccp_sim)) cfg%Lstats = .true.
+
+  ! Copy instrument flags to cfg structure
+  cfg%Lradar_sim = Lradar_sim
+  cfg%Llidar_sim = Llidar_sim
+  cfg%Lisccp_sim = Lisccp_sim
+  cfg%Lmisr_sim  = Lmisr_sim
+  cfg%Lrttov_sim = Lrttov_sim
+
+  ! Flag to control output to file
+  cfg%Lwrite_output = .false.
+  if (cfg%Lstats.or.cfg%Lmisr_sim.or.cfg%Lrttov_sim) then
+    cfg%Lwrite_output = .true.
+  endif
+
+  ! Output diagnostics
+  i = 1
+  if (Lalbisccp)        cfg%out_list(i) = 'albisccp'
+  i = i+1
+  if (Latb532)          cfg%out_list(i) = 'atb532'
+  i = i+1
+  if (Lboxptopisccp)    cfg%out_list(i) = 'boxptopisccp'
+  i = i+1
+  if (Lboxtauisccp)     cfg%out_list(i) = 'boxtauisccp'
+  i = i+1
+  if (Lcfad_dbze94)     cfg%out_list(i) = 'cfad_dbze94'
+  i = i+1
+  if (Lcfad_lidarsr532) cfg%out_list(i) = 'cfad_lidarsr532'
+  i = i+1
+  if (Lclcalipso2)      cfg%out_list(i) = 'clcalipso2'
+  i = i+1
+  if (Lclcalipso)       cfg%out_list(i) = 'clcalipso'
+  i = i+1
+  if (Lclhcalipso)      cfg%out_list(i) = 'clhcalipso'
+  i = i+1
+  if (Lclisccp2)        cfg%out_list(i) = 'clisccp2'
+  i = i+1
+  if (Lcllcalipso)      cfg%out_list(i) = 'cllcalipso'
+  i = i+1
+  if (Lclmcalipso)      cfg%out_list(i) = 'clmcalipso'
+  i = i+1
+  if (Lcltcalipso)      cfg%out_list(i) = 'cltcalipso'
+  i = i+1
+  if (Lcltlidarradar)   cfg%out_list(i) = 'cltlidarradar'
+  i = i+1
+  if (Lctpisccp)        cfg%out_list(i) = 'ctpisccp'
+  i = i+1
+  if (Ldbze94)          cfg%out_list(i) = 'dbze94'
+  i = i+1
+  if (Ltauisccp)        cfg%out_list(i) = 'tauisccp'
+  i = i+1
+  if (Ltclisccp)        cfg%out_list(i) = 'tclisccp'
+  i = i+1
+  if (Llongitude)       cfg%out_list(i) = 'lon'
+  i = i+1
+  if (Llatitude)        cfg%out_list(i) = 'lat'
+  i = i+1
+  if (Lparasol_refl)    cfg%out_list(i) = 'parasol_refl'
+  i = i+1
+  if (LclMISR)          cfg%out_list(i) = 'clMISR'
+  i = i+1
+  if (Lmeantbisccp)     cfg%out_list(i) = 'meantbisccp'
+  i = i+1
+  if (Lmeantbclrisccp)  cfg%out_list(i) = 'meantbclrisccp'
+  i = i+1
+  if (Lfrac_out)        cfg%out_list(i) = 'frac_out'
+  i = i+1
+  if (Lbeta_mol532)     cfg%out_list(i) = 'beta_mol532'
+  i = i+1
+  if (Ltbrttov)         cfg%out_list(i) = 'tbrttov'
+
+  if (i /= N_OUT_LIST) then
+     print *, 'COSP_IO: wrong number of output diagnostics'
+     stop
+  endif
+
+  ! Copy diagnostic flags to cfg structure
+  cfg%Lalbisccp = Lalbisccp
+  cfg%Latb532 = Latb532
+  cfg%Lboxptopisccp = Lboxptopisccp
+  cfg%Lboxtauisccp = Lboxtauisccp
+  cfg%Lcfad_dbze94 = Lcfad_dbze94
+  cfg%Lcfad_lidarsr532 = Lcfad_lidarsr532
+  cfg%Lclcalipso2 = Lclcalipso2
+  cfg%Lclcalipso = Lclcalipso
+  cfg%Lclhcalipso = Lclhcalipso
+  cfg%Lclisccp2 = Lclisccp2
+  cfg%Lcllcalipso = Lcllcalipso
+  cfg%Lclmcalipso = Lclmcalipso
+  cfg%Lcltcalipso = Lcltcalipso
+  cfg%Lcltlidarradar = Lcltlidarradar
+  cfg%Lctpisccp = Lctpisccp
+  cfg%Ldbze94 = Ldbze94
+  cfg%Ltauisccp = Ltauisccp
+  cfg%Ltclisccp = Ltclisccp
+  cfg%Llongitude = Llongitude
+  cfg%Llatitude = Llatitude
+  cfg%Lparasol_refl = Lparasol_refl
+  cfg%LclMISR = LclMISR
+  cfg%Lmeantbisccp = Lmeantbisccp
+  cfg%Lmeantbclrisccp = Lmeantbclrisccp
+  cfg%Lfrac_out = Lfrac_out
+  cfg%Lbeta_mol532 = Lbeta_mol532
+  cfg%Ltbrttov = Ltbrttov
+
+ END SUBROUTINE READ_COSP_OUTPUT_NL
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/scops.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/scops.F	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/scops.F	(revision 1262)
@@ -0,0 +1,335 @@
+      subroutine scops(npoints,nlev,ncol,seed,cc,conv,
+     &                 overlap,frac_out,ncolprint)
+
+
+! *****************************COPYRIGHT****************************
+! (c) British Crown Copyright 2009, the Met Office.
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without 
+! modification, are permitted provided that the
+! following conditions are met:
+! 
+!     * Redistributions of source code must retain the above 
+!       copyright  notice, this list of conditions and the following 
+!       disclaimer.
+!     * Redistributions in binary form must reproduce the above 
+!       copyright notice, this list of conditions and the following 
+!       disclaimer in the documentation and/or other materials 
+!       provided with the distribution.
+!     * Neither the name of the Met Office nor the names of its 
+!       contributors may be used to endorse or promote products
+!       derived from this software without specific prior written 
+!       permission.
+! 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
+! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
+! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
+! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
+! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 
+! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 
+! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
+! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.  
+! 
+! *****************************COPYRIGHT*******************************
+! *****************************COPYRIGHT*******************************
+! *****************************COPYRIGHT*******************************
+
+      implicit none
+
+      INTEGER npoints       !  number of model points in the horizontal
+      INTEGER nlev          !  number of model levels in column
+      INTEGER ncol          !  number of subcolumns
+
+
+      INTEGER overlap         !  overlap type
+                              !  1=max
+                              !  2=rand
+                              !  3=max/rand
+      REAL cc(npoints,nlev)
+                  !  input cloud cover in each model level (fraction)
+                  !  NOTE:  This is the HORIZONTAL area of each
+                  !         grid box covered by clouds
+
+      REAL conv(npoints,nlev)
+                  !  input convective cloud cover in each model
+                  !   level (fraction)
+                  !  NOTE:  This is the HORIZONTAL area of each
+                  !         grid box covered by convective clouds
+
+      INTEGER i,j,ilev,ibox,ncolprint,ilev2
+
+      REAL frac_out(npoints,ncol,nlev) ! boxes gridbox divided up into
+                              ! Equivalent of BOX in original version, but
+                              ! indexed by column then row, rather than
+                              ! by row then column
+
+
+      INTEGER seed(npoints)
+      !  seed values for marsaglia  random number generator
+      !  It is recommended that the seed is set
+      !  to a different value for each model
+      !  gridbox it is called on, as it is
+      !  possible that the choice of the same
+      !  seed value every time may introduce some
+      !  statistical bias in the results, particularly
+      !  for low values of NCOL.
+
+      REAL tca(npoints,0:nlev) ! total cloud cover in each model level (fraction)
+                                        ! with extra layer of zeroes on top
+                                        ! in this version this just contains the values input
+                                        ! from cc but with an extra level
+
+      REAL threshold(npoints,ncol)   ! pointer to position in gridbox
+      REAL maxocc(npoints,ncol)      ! Flag for max overlapped conv cld
+      REAL maxosc(npoints,ncol)      ! Flag for max overlapped strat cld
+
+      REAL boxpos(npoints,ncol)      ! ordered pointer to position in gridbox
+
+      REAL threshold_min(npoints,ncol) ! minimum value to define range in with new threshold
+                                        ! is chosen
+
+      REAL ran(npoints)                 ! vector of random numbers
+
+      INTEGER irand,i2_16,huge32,overflow_32  ! variables for RNG
+      PARAMETER(huge32=2147483647)
+      i2_16=65536
+
+      do ibox=1,ncol
+        do j=1,npoints 
+        boxpos(j,ibox)=(ibox-.5)/ncol
+        enddo
+      enddo
+
+!     ---------------------------------------------------!
+!     Initialise working variables
+!     ---------------------------------------------------!
+
+!     Initialised frac_out to zero
+
+      do ilev=1,nlev
+        do ibox=1,ncol
+          do j=1,npoints
+          frac_out(j,ibox,ilev)=0.0
+          enddo
+        enddo
+      enddo
+
+!     assign 2d tca array using 1d input array cc
+
+      do j=1,npoints
+        tca(j,0)=0
+      enddo
+
+      do ilev=1,nlev
+        do j=1,npoints
+          tca(j,ilev)=cc(j,ilev)
+        enddo
+      enddo
+
+      if (ncolprint.ne.0) then
+        write (6,'(a)') 'frac_out_pp_rev:'
+          do j=1,npoints,1000
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write (6,'(8f5.2)') 
+     &     ((frac_out(j,ibox,ilev),ibox=1,ncolprint),ilev=1,nlev)
+
+          enddo
+        write (6,'(a)') 'ncol:'
+        write (6,'(I3)') ncol
+      endif
+      if (ncolprint.ne.0) then
+        write (6,'(a)') 'last_frac_pp:'
+          do j=1,npoints,1000
+          write(6,'(a10)') 'j='
+          write(6,'(8I10)') j
+          write (6,'(8f5.2)') (tca(j,0))
+          enddo
+      endif
+
+!     ---------------------------------------------------!
+!     ALLOCATE CLOUD INTO BOXES, FOR NCOLUMNS, NLEVELS
+!     frac_out is the array that contains the information 
+!     where 0 is no cloud, 1 is a stratiform cloud and 2 is a
+!     convective cloud
+      
+      !loop over vertical levels
+      DO 200 ilev = 1,nlev
+                                  
+!     Initialise threshold
+
+        IF (ilev.eq.1) then
+          ! If max overlap 
+          IF (overlap.eq.1) then
+            ! select pixels spread evenly
+            ! across the gridbox
+              DO ibox=1,ncol
+                do j=1,npoints
+                  threshold(j,ibox)=boxpos(j,ibox)
+                enddo
+              enddo
+          ELSE
+              DO ibox=1,ncol
+                include 'congvec.h'
+                ! select random pixels from the non-convective
+                ! part the gridbox ( some will be converted into
+                ! convective pixels below )
+                do j=1,npoints
+                  threshold(j,ibox)=
+     &            conv(j,ilev)+(1-conv(j,ilev))*ran(j)
+                enddo
+              enddo
+            ENDIF
+            IF (ncolprint.ne.0) then
+              write (6,'(a)') 'threshold_nsf2:'
+                do j=1,npoints,1000
+                write(6,'(a10)') 'j='
+                write(6,'(8I10)') j
+                write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint)
+                enddo
+            ENDIF
+        ENDIF
+
+        IF (ncolprint.ne.0) then
+            write (6,'(a)') 'ilev:'
+            write (6,'(I2)') ilev
+        ENDIF
+
+        DO ibox=1,ncol
+
+          ! All versions
+          do j=1,npoints
+            if (boxpos(j,ibox).le.conv(j,ilev)) then
+              maxocc(j,ibox) = 1.
+            else
+              maxocc(j,ibox) = 0.
+            end if
+          enddo
+
+          ! Max overlap
+          if (overlap.eq.1) then 
+            do j=1,npoints
+              threshold_min(j,ibox)=conv(j,ilev)
+              maxosc(j,ibox)=1
+            enddo
+          endif
+
+          ! Random overlap
+          if (overlap.eq.2) then 
+            do j=1,npoints
+              threshold_min(j,ibox)=conv(j,ilev)
+              maxosc(j,ibox)=0
+            enddo
+          endif
+
+          ! Max/Random overlap
+          if (overlap.eq.3) then 
+            do j=1,npoints
+              threshold_min(j,ibox)=max(conv(j,ilev),
+     &          min(tca(j,ilev-1),tca(j,ilev)))
+              if (threshold(j,ibox)
+     &          .lt.min(tca(j,ilev-1),tca(j,ilev))
+     &          .and.(threshold(j,ibox).gt.conv(j,ilev))) then
+                   maxosc(j,ibox)= 1
+              else
+                   maxosc(j,ibox)= 0
+              end if
+            enddo
+          endif
+    
+          ! Reset threshold 
+
+          include 'congvec.h'
+
+          do j=1,npoints
+            threshold(j,ibox)=
+              !if max overlapped conv cloud
+     &        maxocc(j,ibox) * (                                       
+     &            boxpos(j,ibox)                                               
+     &        ) +                                                      
+              !else
+     &        (1-maxocc(j,ibox)) * (                                   
+                  !if max overlapped strat cloud
+     &            (maxosc(j,ibox)) * (                                 
+                      !threshold=boxpos
+     &                threshold(j,ibox)                                        
+     &            ) +                                                  
+                  !else
+     &            (1-maxosc(j,ibox)) * (                               
+                      !threshold_min=random[thrmin,1]
+     &                threshold_min(j,ibox)+
+     &                  (1-threshold_min(j,ibox))*ran(j)  
+     &           ) 
+     &        )
+          enddo
+
+        ENDDO ! ibox
+
+!          Fill frac_out with 1's where tca is greater than the threshold
+
+           DO ibox=1,ncol
+             do j=1,npoints 
+               if (tca(j,ilev).gt.threshold(j,ibox)) then
+               frac_out(j,ibox,ilev)=1
+               else
+               frac_out(j,ibox,ilev)=0
+               end if               
+             enddo
+           ENDDO
+
+!         Code to partition boxes into startiform and convective parts
+!         goes here
+
+           DO ibox=1,ncol
+             do j=1,npoints 
+                if (threshold(j,ibox).le.conv(j,ilev)) then
+                    ! = 2 IF threshold le conv(j)
+                    frac_out(j,ibox,ilev) = 2 
+                else
+                    ! = the same IF NOT threshold le conv(j) 
+                    frac_out(j,ibox,ilev) = frac_out(j,ibox,ilev)
+                end if
+             enddo
+           ENDDO
+
+!         Set last_frac to tca at this level, so as to be tca 
+!         from last level next time round
+
+          if (ncolprint.ne.0) then
+
+            do j=1,npoints ,1000
+            write(6,'(a10)') 'j='
+            write(6,'(8I10)') j
+            write (6,'(a)') 'last_frac:'
+            write (6,'(8f5.2)') (tca(j,ilev-1))
+    
+            write (6,'(a)') 'conv:'
+            write (6,'(8f5.2)') (conv(j,ilev),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'max_overlap_cc:'
+            write (6,'(8f5.2)') (maxocc(j,ibox),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'max_overlap_sc:'
+            write (6,'(8f5.2)') (maxosc(j,ibox),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'threshold_min_nsf2:'
+            write (6,'(8f5.2)') (threshold_min(j,ibox),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'threshold_nsf2:'
+            write (6,'(8f5.2)') (threshold(j,ibox),ibox=1,ncolprint)
+    
+            write (6,'(a)') 'frac_out_pp_rev:'
+            write (6,'(8f5.2)') 
+     &       ((frac_out(j,ibox,ilev2),ibox=1,ncolprint),ilev2=1,nlev)
+          enddo
+          endif
+
+200   CONTINUE    !loop over nlev
+
+
+      end
+
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histdayCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histdayCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histdayCOSP.h	(revision 1262)
@@ -0,0 +1,121 @@
+! Ecriture des fichiers de sorties COSP
+! Sorties journalierres
+! Abderrahmane Idelkadi Septembre 2009
+
+      IF (MOD(itap,NINT(freq_COSP/dtime)).EQ.0) THEN
+
+       itau_wcosp = itau_phy + itap
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+          CALL histwrite_phy(nid_day_cosp,"cllcalipso",itau_wcosp,stlidar%cldlayer(:,1))
+         endif
+         if (cfg%Lclhcalipso) then
+          CALL histwrite_phy(nid_day_cosp,"clhcalipso",itau_wcosp,stlidar%cldlayer(:,3))
+         endif
+         if (cfg%Lclmcalipso) then
+          CALL histwrite_phy(nid_day_cosp,"clmcalipso",itau_wcosp,stlidar%cldlayer(:,2))
+         endif
+         if (cfg%Lcltcalipso) then
+          CALL histwrite_phy(nid_day_cosp,"cltcalipso",itau_wcosp,stlidar%cldlayer(:,4)) 
+         endif
+         if (cfg%Lclcalipso) then
+          CALL histwrite_phy(nid_day_cosp,"clcalipso",itau_wcosp,stlidar%lidarcld)
+         endif
+         if (cfg%Lcfad_lidarsr532) then
+           do ii=1,SR_BINS
+            CALL histwrite_phy(nid_day_cosp,"cfad_lidarsr532_"//chcol(ii),itau_wcosp,stlidar%cfad_sr(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lparasol_refl) then
+           CALL histwrite_phy(nid_day_cosp,"parasol_refl",itau_wcosp,stlidar%parasolrefl)
+         endif
+         if (cfg%Latb532) then
+           do ii=1,Ncolumns
+            CALL histwrite_phy(nid_day_cosp,"atb532_"//chcol(ii),itau_wcosp,sglidar%beta_tot(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lbeta_mol532) then
+           CALL histwrite_phy(nid_day_cosp,"beta_mol532",itau_wcosp,sglidar%beta_mol)
+         endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%Lcfad_dbze94) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+          if (cfg%Lclisccp2) then
+            do ii=1,7
+              CALL histwrite_phy(nid_day_cosp,"clisccp2_"//chcol(ii),itau_wcosp,isccp%fq_isccp(:,ii,:))
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+             CALL histwrite_phy(nid_day_cosp,"boxtauisccp",itau_wcosp,isccp%boxtau)
+          endif
+          if (cfg%Lboxptopisccp) then
+             CALL histwrite_phy(nid_day_cosp,"boxptopisccp",itau_wcosp,isccp%boxptop)
+          endif
+          if (cfg%Ltclisccp) then
+             CALL histwrite_phy(nid_day_cosp,"tclisccp",itau_wcosp,isccp%totalcldarea)
+          endif
+          if (cfg%Lctpisccp) then
+             CALL histwrite_phy(nid_day_cosp,"ctpisccp",itau_wcosp,isccp%meanptop)
+          endif
+          if (cfg%Ltauisccp) then
+             CALL histwrite_phy(nid_day_cosp,"tauisccp",itau_wcosp,isccp%meantaucld)
+          endif
+          if (cfg%Lalbisccp) then
+             CALL histwrite_phy(nid_day_cosp,"albisccp",itau_wcosp,isccp%meanalbedocld)
+          endif
+          if (cfg%Lmeantbisccp) then
+             CALL histwrite_phy(nid_day_cosp,"meantbisccp",itau_wcosp,isccp%meantb)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+             CALL histwrite_phy(nid_day_cosp,"meantbclrisccp",itau_wcosp,isccp%meantbclr)
+          endif
+        endif ! Isccp
+
+!       if (ok_sync) then
+!$OMP MASTER
+        call histsync(nid_day_cosp)
+!$OMP END MASTER      
+!       endif
+
+      ENDIF ! if freq_COSP
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histhfCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histhfCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histhfCOSP.h	(revision 1262)
@@ -0,0 +1,122 @@
+! Ecriture des fichiers de sorties COSP
+! Sorties journalierres
+! Abderrahmane Idelkadi Septembre 2009
+
+      IF (MOD(itap,NINT(freq_COSP/dtime)).EQ.0) THEN
+
+       itau_wcosp = itau_phy + itap
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+          CALL histwrite_phy(nid_hf_cosp,"cllcalipso",itau_wcosp,stlidar%cldlayer(:,1))
+         endif
+         if (cfg%Lclhcalipso) then
+          CALL histwrite_phy(nid_hf_cosp,"clhcalipso",itau_wcosp,stlidar%cldlayer(:,3))
+         endif
+         if (cfg%Lclmcalipso) then
+          CALL histwrite_phy(nid_hf_cosp,"clmcalipso",itau_wcosp,stlidar%cldlayer(:,2))
+         endif
+         if (cfg%Lcltcalipso) then
+          CALL histwrite_phy(nid_hf_cosp,"cltcalipso",itau_wcosp,stlidar%cldlayer(:,4)) 
+         endif
+         if (cfg%Lclcalipso) then
+          CALL histwrite_phy(nid_hf_cosp,"clcalipso",itau_wcosp,stlidar%lidarcld)
+         endif
+         if (cfg%Lcfad_lidarsr532) then
+           do ii=1,SR_BINS
+            CALL histwrite_phy(nid_hf_cosp,"cfad_lidarsr532_"//chcol(ii),itau_wcosp,stlidar%cfad_sr(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lparasol_refl) then
+           CALL histwrite_phy(nid_hf_cosp,"parasol_refl",itau_wcosp,stlidar%parasolrefl)
+         endif
+         if (cfg%Latb532) then
+           do ii=1,Ncolumns
+            CALL histwrite_phy(nid_hf_cosp,"atb532_"//chcol(ii),itau_wcosp,sglidar%beta_tot(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lbeta_mol532) then
+           CALL histwrite_phy(nid_hf_cosp,"beta_mol532",itau_wcosp,sglidar%beta_mol)
+         endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%Lcfad_dbze94) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+          if (cfg%Lclisccp2) then
+            do ii=1,7
+              CALL histwrite_phy(nid_hf_cosp,"clisccp2_"//chcol(ii),itau_wcosp,isccp%fq_isccp(:,ii,:))
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"boxtauisccp",itau_wcosp,isccp%boxtau)
+          endif
+          if (cfg%Lboxptopisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"boxptopisccp",itau_wcosp,isccp%boxptop)
+          endif
+          if (cfg%Ltclisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"tclisccp",itau_wcosp,isccp%totalcldarea)
+          endif
+          if (cfg%Lctpisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"ctpisccp",itau_wcosp,isccp%meanptop)
+
+          endif
+          if (cfg%Ltauisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"tauisccp",itau_wcosp,isccp%meantaucld)
+          endif
+          if (cfg%Lalbisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"albisccp",itau_wcosp,isccp%meanalbedocld)
+          endif
+          if (cfg%Lmeantbisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"meantbisccp",itau_wcosp,isccp%meantb)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+             CALL histwrite_phy(nid_hf_cosp,"meantbclrisccp",itau_wcosp,isccp%meantbclr)
+          endif
+        endif ! Isccp
+
+!       if (ok_sync) then
+!$OMP MASTER
+        call histsync(nid_hf_cosp)
+!$OMP END MASTER      
+!       endif
+
+      ENDIF ! if freq_COSP
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histmthCOSP.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histmthCOSP.h	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/write_histmthCOSP.h	(revision 1262)
@@ -0,0 +1,121 @@
+! Ecriture des fichiers de sorties COSP
+! Sorties journalierres
+! Abderrahmane Idelkadi Septembre 2009
+
+      IF (MOD(itap,NINT(freq_COSP/dtime)).EQ.0) THEN
+
+       itau_wcosp = itau_phy + itap
+
+! Sorties LIDAR
+       if (cfg%Llidar_sim) then
+         if (cfg%Lcllcalipso) then
+          CALL histwrite_phy(nid_mth_cosp,"cllcalipso",itau_wcosp,stlidar%cldlayer(:,1))
+         endif
+         if (cfg%Lclhcalipso) then
+          CALL histwrite_phy(nid_mth_cosp,"clhcalipso",itau_wcosp,stlidar%cldlayer(:,3))
+         endif
+         if (cfg%Lclmcalipso) then
+          CALL histwrite_phy(nid_mth_cosp,"clmcalipso",itau_wcosp,stlidar%cldlayer(:,2))
+         endif
+         if (cfg%Lcltcalipso) then
+          CALL histwrite_phy(nid_mth_cosp,"cltcalipso",itau_wcosp,stlidar%cldlayer(:,4)) 
+         endif
+         if (cfg%Lclcalipso) then
+          CALL histwrite_phy(nid_mth_cosp,"clcalipso",itau_wcosp,stlidar%lidarcld)
+         endif
+         if (cfg%Lcfad_lidarsr532) then
+           do ii=1,SR_BINS
+            CALL histwrite_phy(nid_mth_cosp,"cfad_lidarsr532_"//chcol(ii),itau_wcosp,stlidar%cfad_sr(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lparasol_refl) then
+           CALL histwrite_phy(nid_mth_cosp,"parasol_refl",itau_wcosp,stlidar%parasolrefl)
+         endif
+         if (cfg%Latb532) then
+           do ii=1,Ncolumns
+            CALL histwrite_phy(nid_mth_cosp,"atb532_"//chcol(ii),itau_wcosp,sglidar%beta_tot(:,ii,:))
+           enddo
+         endif
+         if (cfg%Lbeta_mol532) then
+           CALL histwrite_phy(nid_mth_cosp,"beta_mol532",itau_wcosp,sglidar%beta_mol)
+         endif
+        endif ! Lidar
+
+! Sorties RADAR
+!Attention A FAIRE
+!        if (cfg%Lradar_sim) then
+!         print*,'Ecriture sorties Radar'
+!          if (cfg%Lcfad_dbze94) then
+!              print*,'Ecriture de cfad_dbze94.nc '
+!              A revoir l axe vertical Nlvgrid
+!               do ii=1,DBZE_BINS
+!                   dbze_ax(ii) = CFAD_ZE_MIN + CFAD_ZE_WIDTH*(ii - 0.5)
+!               enddo
+!               call write_netcdf4d('cfad_dbze94.nc',use_vgrid,nlon,nlat,Nlevout,DBZE_BINS, &
+!                                   x,y,out_levs,dbze_ax,i,ndays,time,stradar%cfad_ze)
+!          endif
+!          if (cfg%Lclcalipso2) then
+!               call write_netcdf3d('clcalipso2.nc',use_vgrid,'clcalipso2', &
+!                              nlon,nlat,Nlevout,x,y,out_levs,i,ndays,time,stradar%lidar_only_freq_cloud)
+!          endif
+!          if (cfg%Ldbze94) then
+!             do ii=1,Ncolumns
+!                xcol(ii)=float(i)
+!             enddo
+!             call write_netcdf4d('dbze94.nc',use_vgrid,nlon,nlat,Nlevout,Ncolumns, &
+!                                 x,y,out_levs,xcol,i,ndays,time,sgradar%Ze_tot)
+!          endif
+!          if (cfg%Lcltlidarradar) then
+!             call write_netcdf2d('cltlidarradar.nc','cltlidarradar', &
+!                                 nlon,nlat,x,y,i,ndays,time,stradar%radar_lidar_tcc)
+!          endif
+!        endif  ! Radar
+
+! Sorties MISR
+!Attention A FAIRE
+!        if (cfg%Lmisr_sim) then
+!         print*,'Ecriture sorties Misr'
+!            call write_netcdf4d('clMISR.nc',use_vgrid,nlon,nlat,MISR_N_CTH,7, &
+!                                x,y,MISR_CTH,ISCCP_TAU,i,ndays,time,misr%fq_MISR)
+!        endif
+
+! Sorties ISCCP
+        if (cfg%Lisccp_sim) then
+          if (cfg%Lclisccp2) then
+            do ii=1,7
+              CALL histwrite_phy(nid_mth_cosp,"clisccp2_"//chcol(ii),itau_wcosp,isccp%fq_isccp(:,ii,:))
+            enddo
+          endif
+          if (cfg%Lboxtauisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"boxtauisccp",itau_wcosp,isccp%boxtau)
+          endif
+          if (cfg%Lboxptopisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"boxptopisccp",itau_wcosp,isccp%boxptop)
+          endif
+          if (cfg%Ltclisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"tclisccp",itau_wcosp,isccp%totalcldarea)
+          endif
+          if (cfg%Lctpisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"ctpisccp",itau_wcosp,isccp%meanptop)
+          endif
+          if (cfg%Ltauisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"tauisccp",itau_wcosp,isccp%meantaucld)
+          endif
+          if (cfg%Lalbisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"albisccp",itau_wcosp,isccp%meanalbedocld)
+          endif
+          if (cfg%Lmeantbisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"meantbisccp",itau_wcosp,isccp%meantb)
+          endif
+          if (cfg%Lmeantbclrisccp) then
+             CALL histwrite_phy(nid_mth_cosp,"meantbclrisccp",itau_wcosp,isccp%meantbclr)
+          endif
+        endif ! Isccp
+
+!       if (ok_sync) then
+!$OMP MASTER
+        call histsync(nid_mth_cosp)
+!$OMP END MASTER      
+!       endif
+
+      ENDIF ! if freq_COSP
Index: LMDZ4/branches/LMDZ4-dev/libf/cosp/zeff.F90
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/cosp/zeff.F90	(revision 1262)
+++ LMDZ4/branches/LMDZ4-dev/libf/cosp/zeff.F90	(revision 1262)
@@ -0,0 +1,161 @@
+  subroutine zeff(freq,D,N,nsizes,k2,tt,ice,xr,z_eff,z_ray,kr,qe,qs,rho_e)
+  use math_lib
+  use optics_lib
+  implicit none
+  
+! Purpose:
+!   Simulates radar return of a volume given DSD of spheres
+!   Part of QuickBeam v1.03 by John Haynes
+!   http://reef.atmos.colostate.edu/haynes/radarsim
+!
+! Inputs:
+!   [freq]      radar frequency (GHz)
+!   [D]         discrete drop sizes (um)
+!   [N]         discrete concentrations (cm^-3 um^-1)
+!   [nsizes]    number of discrete drop sizes
+!   [k2]        |K|^2, -1=use frequency dependent default 
+!   [tt]        hydrometeor temperature (C)
+!   [ice]       indicates volume consists of ice
+!   [xr]        perform Rayleigh calculations?
+!   [qe]        if using a mie table, these contain ext/sca ...
+!   [qs]        ... efficiencies; otherwise set to -1
+!   [rho_e]     medium effective density (kg m^-3) (-1 = pure)
+!
+! Outputs:
+!   [z_eff]     unattenuated effective reflectivity factor (mm^6/m^3)
+!   [z_ray]     reflectivity factor, Rayleigh only (mm^6/m^3)
+!   [kr]        attenuation coefficient (db km^-1)
+!
+! Created:
+!   11/28/05  John Haynes (haynes@atmos.colostate.edu)
+
+! ----- INPUTS -----  
+  integer, intent(in) :: ice, xr
+  integer, intent(in) :: nsizes
+  real*8, intent(in) :: freq,D(nsizes),N(nsizes),tt,qe(nsizes), &
+    qs(nsizes), rho_e(nsizes)
+  real*8, intent(inout) :: k2
+  
+! ----- OUTPUTS -----
+  real*8, intent(out) :: z_eff,z_ray,kr
+    
+! ----- INTERNAL -----
+  integer :: &
+  correct_for_rho		! correct for density flag
+  real*8, dimension(nsizes) :: &
+  D0, &				! D in (m)
+  N0, &				! N in m^-3 m^-1
+  sizep, &			! size parameter
+  qext, &			! extinction efficiency
+  qbsca, &			! backscatter efficiency
+  rho_ice, &			! bulk density ice (kg m^-3)
+  f				! ice fraction
+  real*8 :: &
+  wl, &				! wavelength (m)
+  cr                            ! kr(dB/km) = cr * kr(1/km)
+  complex*16 :: &
+  m				! complex index of refraction of bulk form
+  complex*16, dimension(nsizes) :: &
+  m0				! complex index of refraction
+  
+  integer*4 :: i,one
+  real*8 :: pi
+  real*8 :: eta_sum, eta_mie, const, z0_eff, z0_ray, k_sum, &
+            n_r, n_i, dqv(1), dqxt, dqsc, dbsc, dg, dph(1)
+  integer*4 :: err
+  complex*16 :: Xs1(1), Xs2(1)
+
+  one=1
+  pi = acos(-1.0)
+  rho_ice(:) = 917
+  z0_ray = 0.0
+
+! // conversions
+  D0 = d*1E-6			! m
+  N0 = n*1E12			! 1/(m^3 m)
+  wl = 2.99792458/(freq*10)	! m
+  
+! // dielectric constant |k^2| defaults
+  if (k2 < 0) then
+    k2 = 0.933
+    if (abs(94.-freq) < 3.) k2=0.75
+    if (abs(35.-freq) < 3.) k2=0.88
+    if (abs(13.8-freq) < 3.) k2=0.925
+  endif  
+  
+  if (qe(1) < -9) then
+
+!   // get the refractive index of the bulk hydrometeors
+    if (ice == 0) then
+      call m_wat(freq,tt,n_r,n_i)
+    else
+      call m_ice(freq,tt,n_r,n_i)
+    endif
+    m = cmplx(n_r,-n_i)
+    m0(:) = m
+    
+    correct_for_rho = 0
+    if ((ice == 1) .and. (minval(rho_e) >= 0)) correct_for_rho = 1
+    
+!   :: correct refractive index for ice density if needed
+    if (correct_for_rho == 1) then
+      f = rho_e/rho_ice
+      m0 = ((2+m0**2+2*f*(m0**2-1))/(2+m0**2+f*(1-m0**2)))**(0.5)
+    endif       
+    
+!   :: Mie calculations
+    sizep = (pi*D0)/wl
+    dqv(1) = 0.
+    do i=1,nsizes
+      call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
+        dg, xs1, xs2, dph, err)
+    end do
+    
+  else
+!   // Mie table used
+    
+    qext = qe
+    qbsca = qs
+    
+  endif
+  
+! // eta_mie = 0.25*sum[qbsca*pi*D^2*N(D)*deltaD]
+!                   <--------- eta_sum --------->
+! // z0_eff = (wl^4/!pi^5)*(1./k2)*eta_mie
+  eta_sum = 0.
+  if (size(D0) == 1) then
+    eta_sum = qbsca(1)*(n(1)*1E6)*D0(1)**2
+  else
+    call avint(qbsca*N0*D0**2,D0,nsizes,D0(1),D0(size(D0,1)),eta_sum)
+  endif
+ 
+  eta_mie = eta_sum*0.25*pi
+  const = (wl**4/pi**5)*(1./k2)
+  z0_eff = const*eta_mie
+
+! // kr = 0.25*cr*sum[qext*pi*D^2*N(D)*deltaD]
+!                 <---------- k_sum --------->  
+  k_sum = 0.
+  if (size(D0) == 1) then
+    k_sum = qext(1)*(n(1)*1E6)*D0(1)**2
+  else
+    call avint(qext*N0*D0**2,D0,nsizes,D0(1),D0(size(D0,1)),k_sum)
+  endif
+  cr = 10./log(10.)
+  kr = k_sum*0.25*pi*(1000.*cr)
+	
+! // z_ray = sum[D^6*N(D)*deltaD]
+  if (xr == 1) then
+    z0_ray = 0.
+    if (size(D0) == 1) then
+      z0_ray = (n(1)*1E6)*D0(1)**6
+    else
+      call avint(N0*D0**6,D0,nsizes,D0(1),D0(size(D0)),z0_ray)
+    endif
+  endif
+  
+! // convert to mm^6/m^3
+  z_eff = z0_eff*1E18 !  10.*alog10(z0_eff*1E18)
+  z_ray = z0_ray*1E18 !  10.*alog10(z0_ray*1E18)
+  
+  end subroutine zeff
