source: trunk/LMDZ.MARS/libf/phymars/simpleclouds.F @ 633

Last change on this file since 633 was 633, checked in by tnavarro, 13 years ago

last scheme in commit r626 led to a wrong physical behaviour. This version uses a new subtimestep for microphysics that should be faster than the last one.

File size: 8.3 KB
Line 
1      subroutine simpleclouds(ngrid,nlay,ptimestep,
2     &             pplev,pplay,pzlay,pt,pdt,
3     &             pq,pdq,pdqcloud,pdtcloud,
4     &             nq,tau,rice)
5      implicit none
6c------------------------------------------------------------------
7c  This routine is used to form clouds when a parcel of the GCM is
8c    saturated. It is a simplified scheme, and there is almost no
9c    microphysics involved. When the air is saturated, water-ice
10c    clouds form on a fraction of the dust particles, specified by
11c    the constant called "ccn_factor". There is no supersaturation,
12c    and no nucleation rates computed. A more accurate scheme can
13c    be found in the routine called "improvedclouds.F".
14
15c  Modif de zq si saturation dans l'atmosphere
16c  si zq(ig,l)> zqsat(ig,l) ->    zq(ig,l)=zqsat(ig,l)
17c  Le test est effectue de bas en haut. L'eau condensee
18c    (si saturation) est remise dans la couche en dessous.
19c  L'eau condensee dans la couche du bas est deposee a la surface
20
21c  Authors: Franck Montmessin (water ice scheme)
22c           Francois Forget (changed nuclei density & outputs)
23c           Ehouarn Millour (sept.2008, tracers are now handled
24c                                   by name and not fixed index)
25c           J.-B. Madeleine (developed a single routine called
26c                            simpleclouds.F, and corrected calculations
27c                            of the typical CCN profile, Oct. 2011)
28c------------------------------------------------------------------
29#include "dimensions.h"
30#include "dimphys.h"
31#include "comcstfi.h"
32#include "callkeys.h"
33#include "tracer.h"
34#include "comgeomfi.h"
35#include "dimradmars.h"
36c------------------------------------------------------------------
37c     Arguments:
38c     ---------
39c     Inputs:
40      INTEGER ngrid,nlay
41      integer nq                 ! nombre de traceurs
42      REAL ptimestep             ! pas de temps physique (s)
43      REAL pplev(ngrid,nlay+1)   ! pression aux inter-couches (Pa)
44      REAL pplay(ngrid,nlay)     ! pression au milieu des couches (Pa)
45      REAL pzlay(ngrid,nlay)     ! altitude at the middle of the layers
46      REAL pt(ngrid,nlay)        ! temperature at the middle of the
47                                 !   layers (K)
48      REAL pdt(ngrid,nlay)       ! tendance temperature des autres
49                                 !   param.
50      real pq(ngrid,nlay,nq)     ! traceur (kg/kg)
51      real pdq(ngrid,nlay,nq)    ! tendance avant condensation
52                                 !   (kg/kg.s-1)
53      REAL tau(ngridmx,naerkind) ! Column dust optical depth at each point
54
55c     Output:
56      REAL rice(ngrid,nlay)      ! Ice mass mean radius (m)
57                                 ! (r_c in montmessin_2004)
58      real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation
59                                   !   H2O(kg/kg.s-1)
60      REAL pdtcloud(ngrid,nlay)    ! tendance temperature due
61                                   !   a la chaleur latente
62
63c------------------------------------------------------------------
64c     Local variables:
65
66      LOGICAL firstcall
67      DATA firstcall/.true./
68      SAVE firstcall
69
70      REAL CBRT
71      EXTERNAL CBRT
72
73      INTEGER ig,l
74
75      REAL zq(ngridmx,nlayermx,nqmx)  ! local value of tracers
76      REAL zq0(ngridmx,nlayermx,nqmx) ! local initial value of tracers
77      REAL zt(ngridmx,nlayermx)       ! local value of temperature
78      REAL zqsat(ngridmx,nlayermx)    ! saturation
79      REAL*8 dzq                      ! masse de glace echangee (kg/kg)
80      REAL lw                         !Latent heat of sublimation (J.kg-1)
81      REAL,PARAMETER :: To=273.15     ! reference temperature, T=273.15 K
82      real rdusttyp(ngridmx,nlayermx) ! Typical dust geom. mean radius (m)
83      REAL ccntyp(ngridmx,nlayermx)
84                                      ! Typical dust number density (#/kg)
85c     CCN reduction factor
86c      REAL, PARAMETER :: ccn_factor = 4.5  !! comme TESTS_JB // 1. avant
87     
88      REAL Mcon_out(ngridmx,nlayermx) ! mass to be condensed (not dMice !!)
89
90c-----------------------------------------------------------------------
91c    1. initialisation
92c    -----------------
93
94c    On "update" la valeur de q(nqmx) (water vapor) et temperature.
95c    On effectue qqes calculs preliminaires sur les couches :
96
97      do l=1,nlay
98        do ig=1,ngrid
99          zq(ig,l,igcm_h2o_vap)=
100     &      pq(ig,l,igcm_h2o_vap)+pdq(ig,l,igcm_h2o_vap)*ptimestep
101          zq(ig,l,igcm_h2o_vap)=max(zq(ig,l,igcm_h2o_vap),1.E-30) ! FF 12/2004
102          zq0(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap)
103          zt(ig,l)=pt(ig,l)+ pdt(ig,l)*ptimestep
104
105          zq(ig,l,igcm_h2o_ice)=
106     &      pq(ig,l,igcm_h2o_ice)+pdq(ig,l,igcm_h2o_ice)*ptimestep
107          zq(ig,l,igcm_h2o_ice)=max(zq(ig,l,igcm_h2o_ice),0.) ! FF 12/2004
108          zq0(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice)
109        enddo
110      enddo
111
112      do l=1,nlay
113        do ig=1,ngrid
114
115c         Typical dust radius profile:
116          rdusttyp(ig,l)= max(.8e-6*exp(-pzlay(ig,l)/18000.),1.e-9)
117
118c         Typical CCN profile:
119c         Corrected equation, following Montmessin et al. 2004
120c           (N0=2e6 m-3 has been converted into N0=1.3e8 kg-1, otherwise
121c            the equation for rice is not homogeneous...)
122          ccntyp(ig,l)=
123     &       1.3e+8*max(tau(ig,1),0.001)/0.1*exp(-pzlay(ig,l)/10000.)
124c         The previously used profile was not correct:
125c         ccntyp(ig,l)=( epaisseur(ig,l)/masse(ig,l) ) *
126c    &       2.e+6/0.1*max(tau(ig,1),0.001)*exp(-pzlay(ig,l)/10000.)
127
128c         Reduce number of nuclei
129!         TEMPORAIRE : decrease the number of CCNs FF 04/200
130!         reduction facteur 3
131!         ccntyp(ig,l) = ccntyp(ig,l) / 27.
132!         reduction facteur 2
133!         ccntyp(ig,l) = ccntyp(ig,l) / 8.
134c -----------------------------------------------------------------
135          ccntyp(ig,l) = ccntyp(ig,l) / ccn_factor
136
137        enddo ! of do ig=1,ngrid
138      enddo ! of do l=1,nlay
139
140      pdqcloud(1:ngrid,1:nlay,1:nq)=0
141      pdtcloud(1:ngrid,1:nlay)=0
142
143c     ----------------------------------------------
144c
145c
146c     Rapport de melange a saturation dans la couche l : -------
147c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148
149      call watersat(ngridmx*nlayermx,zt,pplay,zqsat)
150
151c     taux de condensation (kg/kg/s-1) dans les differentes couches
152c     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153
154      do l=1,nlay
155        do ig=1,ngrid
156
157          if (zq(ig,l,igcm_h2o_vap).ge.zqsat(ig,l))then  !  Condensation
158            dzq=zq(ig,l,igcm_h2o_vap)-zqsat(ig,l)               
159          elseif(zq(ig,l,igcm_h2o_vap).lt.zqsat(ig,l))then  ! Sublimation
160            dzq=-min(zqsat(ig,l)-zq(ig,l,igcm_h2o_vap),
161     &               zq(ig,l,igcm_h2o_ice))
162          endif
163
164c         Water Mass change
165c         ~~~~~~~~~~~~~~~~~
166          zq(ig,l,igcm_h2o_ice)=zq(ig,l,igcm_h2o_ice)+dzq
167          zq(ig,l,igcm_h2o_vap)=zq(ig,l,igcm_h2o_vap)-dzq
168         
169          Mcon_out(ig,l) = dzq
170
171c         Calcul du rayon moyen des particules de glace.
172c         Hypothese : Dans une couche, la glace presente se
173c         repartit uniformement autour du nbre de poussieres
174c         dont le rayon moyen est prescrit par rdusttyp.
175c         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
176          rice(ig,l)=max( CBRT ( (zq(ig,l,igcm_h2o_ice)/rho_ice
177     &      +ccntyp(ig,l)*(4./3.)*pi*rdusttyp(ig,l)**3.)
178     &      /(ccntyp(ig,l)*4./3.*pi) ), rdusttyp(ig,l))
179
180
181        enddo ! of do ig=1,ngrid
182      enddo ! of do l=1,nlay
183
184c     Tendance finale
185c     ~~~~~~~~~~~~~~~
186      do l=1, nlay
187        do ig=1,ngridmx
188          pdqcloud(ig,l,igcm_h2o_vap)=(zq(ig,l,igcm_h2o_vap)
189     &                            -zq0(ig,l,igcm_h2o_vap))/ptimestep
190          pdqcloud(ig,l,igcm_h2o_ice) =
191     &      (zq(ig,l,igcm_h2o_ice) - zq0(ig,l,igcm_h2o_ice))/ptimestep
192          lw=(2834.3-0.28*(zt(ig,l)-To)-0.004*(zt(ig,l)-To)**2)*1.e+3
193          pdtcloud(ig,l)=-pdqcloud(ig,l,igcm_h2o_vap)*lw/cpp
194        end do
195      end do
196
197c------------------------------------------------------------------
198c     TEST_JBM
199!      IF (ngrid.eq.1) THEN
200!         call WRITEDIAGFI(ngrid,"mcond","h2o condensed mass","kg",1,
201!     &                    Mcon_out)
202!         call WRITEDIAGFI(ngrid,"rdusttyp","rdusttyp","m",1,
203!     &                    rdusttyp)
204!         call WRITEDIAGFI(ngrid,"ccntyp","ccntyp","kg-1",1,
205!     &                    ccntyp)
206!      ENDIF
207c------------------------------------------------------------------
208      return
209      end
Note: See TracBrowser for help on using the repository browser.