Changeset 1279 for LMDZ4/trunk/libf/phylmd/newmicro.F
- Timestamp:
- Dec 10, 2009, 10:02:56 AM (15 years ago)
- Location:
- LMDZ4/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk
- Property svn:mergeinfo changed
/LMDZ4/branches/LMDZ4-dev merged: 1150-1162,1164-1193,1195-1231,1234-1235,1237-1240,1242-1274,1276
- Property svn:mergeinfo changed
-
LMDZ4/trunk/libf/phylmd/newmicro.F
r1146 r1279 1 ! 2 ! $Header$ 3 ! 1 ! $Id$ 2 ! 4 3 SUBROUTINE newmicro (paprs, pplay,ok_newmicro, 5 4 . t, pqlwp, pclc, pcltau, pclemi, … … 7 6 s xflwp, xfiwp, xflwc, xfiwc, 8 7 e ok_aie, 9 e sulfate, sulfate_pi,8 e mass_solu_aero, mass_solu_aero_pi, 10 9 e bl95_b0, bl95_b1, 11 s cldtaupi, re, fl) 10 s cldtaupi, re, fl, reliq, reice) 11 12 12 USE dimphy 13 13 IMPLICIT none … … 22 22 c 23 23 c ok_aie--input-L-apply aerosol indirect effect or not 24 c sulfate-input-R-sulfate aerosol mass concentration [um/m^3]25 c sulfate_pi-input-R-dito, pre-industrial value24 c mass_solu_aero-----input-R-total mass concentration for all soluble aerosols[ug/m^3] 25 c mass_solu_aero_pi--input-R-dito, pre-industrial value 26 26 c bl95_b0-input-R-a parameter, may be varied for tests (s-sea, l-land) 27 27 c bl95_b1-input-R-a parameter, may be varied for tests ( -"- ) … … 94 94 LOGICAL ok_a1lwpdep ! a1 LWP dependent? 95 95 96 REAL sulfate(klon, klev) ! sulfate aerosol mass concentration [ug m-3] 96 REAL mass_solu_aero(klon, klev) ! total mass concentration for all soluble aerosols [ug m-3] 97 REAL mass_solu_aero_pi(klon, klev) ! - " - (pre-industrial value) 97 98 REAL cdnc(klon, klev) ! cloud droplet number concentration [m-3] 98 99 REAL re(klon, klev) ! cloud droplet effective radius [um] 99 REAL sulfate_pi(klon, klev) ! sulfate aerosol mass concentration [ug m-3] (pre-industrial value)100 100 REAL cdnc_pi(klon, klev) ! cloud droplet number concentration [m-3] (pi value) 101 101 REAL re_pi(klon, klev) ! cloud droplet effective radius [um] (pi value) … … 119 119 REAL diff_paprs(klon, klev), zfice1, zfice2(klon, klev) 120 120 REAL rad_chaud_tab(klon, klev), zflwp_var, zfiwp_var 121 122 ! Abderrahmane oct 2009 123 Real reliq(klon, klev), reice(klon, klev) 121 124 122 125 c … … 157 160 ! 158 161 cdnc(i,k) = 10.**(bl95_b0+bl95_b1* 159 & log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3162 & log(MAX(mass_solu_aero(i,k),1.e-4))/log(10.))*1.e6 !-m-3 160 163 ! Cloud droplet number concentration (CDNC) is restricted 161 164 ! to be within [20, 1000 cm^3] … … 165 168 ! 166 169 cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1* 167 & log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3170 & log(MAX(mass_solu_aero_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3 168 171 cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k))) 169 172 ENDDO … … 221 224 re(i,k) = rad_chaud_tab(i,k)*fl(i,k) 222 225 226 rel = 0. 227 rei = 0. 223 228 pclc(i,k) = 0.0 224 229 pcltau(i,k) = 0.0 … … 252 257 cldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius 253 258 & + zfiwp_var * (3.448e-03 + 2.431/rei) 259 254 260 ENDIF ! ok_aie 255 261 ! For output diagnostics … … 280 286 c for ice clouds, Ebert & Curry (1992)] 281 287 282 283 284 288 if (zflwp_var.eq.0.) rel = 1. 289 if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1. 290 pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel ) 285 291 & + zfiwp_var * (3.448e-03 + 2.431/rei) 286 292 c -- cloud infrared emissivity: … … 296 302 297 303 ENDIF 298 304 reliq(i,k)=rel 305 reice(i,k)=rei 306 ! if (i.eq.1) then 307 ! print*,'Dans newmicro rel, rei :',rel, rei 308 ! print*,'Dans newmicro reliq, reice :', 309 ! $ reliq(i,k),reice(i,k) 310 ! endif 311 299 312 ENDDO 300 313 ENDDO … … 400 413 DO i = 1, klon 401 414 zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i))) 402 & /(1.-MIN( zcloud(i),1.-ZEPSEC))415 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 403 416 pct(i)=1.-zclear(i) 404 417 IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN 405 418 pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloud(i))) 406 & /(1.-MIN( zcloud(i),1.-ZEPSEC))419 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 407 420 ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND. 408 421 & pplay(i,k).LE.cetamb*paprs(i,1)) THEN 409 422 pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloud(i))) 410 & /(1.-MIN( zcloud(i),1.-ZEPSEC))423 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 411 424 ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN 412 425 pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i))) 413 & /(1.-MIN( zcloud(i),1.-ZEPSEC))426 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 414 427 endif 415 428 zcloud(i)=pclc(i,k)
Note: See TracChangeset
for help on using the changeset viewer.