- Timestamp:
- May 24, 2011, 4:50:59 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4_AR5/libf/phylmd/newmicro.F
r1337 r1522 1 1 ! $Id$ 2 3 4 2 5 ! 3 6 SUBROUTINE newmicro (paprs, pplay,ok_newmicro, … … 51 54 #include "radopt.h" 52 55 c choix de l'hypothese de recouvrememnt nuageuse 53 LOGICAL RANDOM,MAXIMUM_RANDOM,MAXIMUM ,FIRST56 LOGICAL RANDOM,MAXIMUM_RANDOM,MAXIMUM 54 57 parameter (RANDOM=.FALSE., MAXIMUM_RANDOM=.TRUE., MAXIMUM=.FALSE.) 58 LOGICAL, SAVE :: FIRST=.TRUE. 59 !$OMP THREADPRIVATE(FIRST) 55 60 c Hypoyhese de recouvrement : MAXIMUM_RANDOM 56 61 INTEGER flag_max … … 76 81 LOGICAL lo 77 82 c 78 REAL cetahb, cetamb 79 PARAMETER (cetahb = 0.45, cetamb = 0.80) 83 !!Abderr modif JL mail du 19.01.2011 18:31 84 ! REAL cetahb, cetamb 85 ! PARAMETER (cetahb = 0.45, cetamb = 0.80) 86 ! Remplacer 87 !cetahb*paprs(i,1) par prmhc 88 !cetamb*paprs(i,1) par prlmc 89 REAL prmhc ! Pressure between medium and high level cloud 90 REAL prlmc ! Pressure between low and medium level cloud 91 PARAMETER (prmhc = 440.*100., prlmc = 680.*100.) 92 80 93 C 81 94 INTEGER i, k … … 129 142 REAL zclear(klon) 130 143 REAL zcloud(klon) 144 REAL zcloudh(klon) 145 REAL zcloudm(klon) 146 REAL zcloudl(klon) 147 131 148 132 149 c ************************** … … 421 438 zclear(i)=1. 422 439 zcloud(i)=0. 440 zcloudh(i)=0. 441 zcloudm(i)=0. 442 zcloudl(i)=0. 423 443 pch(i)=1.0 424 444 pcm(i) = 1.0 … … 441 461 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 442 462 pct(i)=1.-zclear(i) 443 IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN 444 pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloud(i))) 445 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 446 ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND. 447 & pplay(i,k).LE.cetamb*paprs(i,1)) THEN 448 pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloud(i))) 449 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 450 ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN 451 pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i))) 452 & /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC)) 463 IF (paprs(i,k).LT.prmhc) THEN 464 pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloudh(i))) 465 & /(1.-MIN(real(zcloudh(i), kind=8),1.-ZEPSEC)) 466 zcloudh(i)=pclc(i,k) 467 ELSE IF (paprs(i,k).GE.prmhc .AND. 468 & paprs(i,k).LT.prlmc) THEN 469 pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloudm(i))) 470 & /(1.-MIN(real(zcloudm(i), kind=8),1.-ZEPSEC)) 471 zcloudm(i)=pclc(i,k) 472 ELSE IF (paprs(i,k).GE.prlmc) THEN 473 pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloudl(i))) 474 & /(1.-MIN(real(zcloudl(i), kind=8),1.-ZEPSEC)) 475 zcloudl(i)=pclc(i,k) 453 476 endif 454 477 zcloud(i)=pclc(i,k) … … 460 483 zcloud(i)=MAX(pclc(i,k),zcloud(i)) 461 484 pct(i)=zcloud(i) 462 IF (p play(i,k).LE.cetahb*paprs(i,1)) THEN485 IF (paprs(i,k).LT.prmhc) THEN 463 486 pch(i) = MIN(pclc(i,k),pch(i)) 464 ELSE IF (p play(i,k).GT.cetahb*paprs(i,1).AND.465 & p play(i,k).LE.cetamb*paprs(i,1)) THEN487 ELSE IF (paprs(i,k).GE.prmhc .AND. 488 & paprs(i,k).LT.prlmc) THEN 466 489 pcm(i) = MIN(pclc(i,k),pcm(i)) 467 ELSE IF (p play(i,k).GT.cetamb*paprs(i,1)) THEN490 ELSE IF (paprs(i,k).GE.prlmc) THEN 468 491 pcl(i) = MIN(pclc(i,k),pcl(i)) 469 492 endif … … 475 498 zclear(i)=zclear(i)*(1.-pclc(i,k)) 476 499 pct(i)=1-zclear(i) 477 IF (p play(i,k).LE.cetahb*paprs(i,1)) THEN500 IF (paprs(i,k).LT.prmhc) THEN 478 501 pch(i) = pch(i)*(1.0-pclc(i,k)) 479 ELSE IF (p play(i,k).GT.cetahb*paprs(i,1).AND.480 & p play(i,k).LE.cetamb*paprs(i,1)) THEN502 ELSE IF (paprs(i,k).GE.prmhc .AND. 503 & paprs(i,k).LT.prlmc) THEN 481 504 pcm(i) = pcm(i)*(1.0-pclc(i,k)) 482 ELSE IF (p play(i,k).GT.cetamb*paprs(i,1)) THEN505 ELSE IF (paprs(i,k).GE.prlmc) THEN 483 506 pcl(i) = pcl(i)*(1.0-pclc(i,k)) 484 507 endif … … 526 549 ENDDO 527 550 528 FIRST=.TRUE.529 551 530 552 DO i=1,klon
Note: See TracChangeset
for help on using the changeset viewer.