Changeset 1414 for LMDZ4/trunk/libf/cosp/cosp_utils.F90

Timestamp:

Jul 15, 2010, 5:21:22 PM (14 years ago)

Author:

idelkadi

Message:

Passage a la version cosp.v1.3 pour le Lidar et ISCCP
Corrections de bugs pour ISCCP et optimisation pour le Lidar

File:

• LMDZ4/trunk/libf/cosp/cosp_utils.F90 (modified) (1 diff)

LMDZ4/trunk/libf/cosp/cosp_utils.F90

@@ -40 +40 @@
   END INTERFACE
 CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_PRECIP_MXRATIO --------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, &
+                          n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2, &
+                          flux,mxratio)
+
+    ! Input arguments, (IN)
+    integer,intent(in) :: Npoints,Nlevels,Ncolumns
+    real,intent(in),dimension(Npoints,Nlevels) :: p,T,flux
+    real,intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac
+    real,intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,prec_type
+    ! Input arguments, (OUT)
+    real,intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio
+    ! Local variables
+    integer :: i,j,k
+    real :: sigma,one_over_xip1,xi,rho0,rho
+    
+    mxratio = 0.0
+
+    if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed
+        !gamma1  = gamma(alpha_x + b_x + d_x + 1.0)
+        !gamma2  = gamma(alpha_x + b_x + 1.0)
+        xi      = d_x/(alpha_x + b_x - n_bx + 1.0)
+        rho0    = 1.29
+        sigma   = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi
+        one_over_xip1 = 1.0/(xi + 1.0)
+        
+        do k=1,Nlevels
+            do j=1,Ncolumns
+                do i=1,Npoints
+                    if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
+                        rho = p(i,k)/(287.05*T(i,k))
+                        mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1
+                        mxratio(i,j,k)=mxratio(i,j,k)/rho
+                    endif
+                enddo
+            enddo
+        enddo
+    endif
+END SUBROUTINE COSP_PRECIP_MXRATIO