- Timestamp:
- Jan 27, 2003, 11:07:30 AM (22 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F
r433 r438 7 7 . jour, rmu0, 8 8 . ok_veget, ocean, npas, nexca, ts, 9 . soil_model,ftsoil, 10 . paprs,pplay,radsol,snow,qs ol,evap,albe,alblw,9 . soil_model,ftsoil,qsol, 10 . paprs,pplay,radsol,snow,qsurf,evap,albe,alblw, 11 11 . fluxlat, 12 12 . rain_f, snow_f, solsw, sollw, sollwdown, fder, … … 110 110 REAL d_ts(klon,nbsrf) 111 111 REAL snow(klon,nbsrf) 112 REAL qs ol(klon,nbsrf)112 REAL qsurf(klon,nbsrf) 113 113 REAL evap(klon,nbsrf) 114 114 REAL albe(klon,nbsrf) … … 133 133 REAL ftsoil(klon,nsoilmx,nbsrf) 134 134 REAL ytsoil(klon,nsoilmx) 135 REAL qsol(klon) 135 136 c====================================================================== 136 137 EXTERNAL clqh, clvent, coefkz, calbeta, cltrac … … 140 141 REAL yalblw(klon) 141 142 REAL yu1(klon), yv1(klon) 142 real ysnow(klon), yqs ol(klon), yagesno(klon)143 real ysnow(klon), yqsurf(klon), yagesno(klon), yqsol(klon) 143 144 real yrain_f(klon), ysnow_f(klon) 144 145 real ysollw(klon), ysolsw(klon), ysollwdown(klon) … … 225 226 PARAMETER(t_coup=273.15) 226 227 C 227 PRINT*,'IMclmain klon=',klon 228 character (len = 20) :: modname = 'clmain' 229 LOGICAL check 230 PARAMETER (check=.true.) 231 C 232 if (check) THEN 233 write(*,*) modname,' klon=',klon 234 call flush(6) 235 endif 228 236 IF (first_appel) THEN 229 237 first_appel=.false. … … 283 291 yts = 0.0 284 292 ysnow = 0.0 285 yqs ol= 0.0293 yqsurf = 0.0 286 294 yalb = 0.0 287 295 yalblw = 0.0 … … 377 385 ENDDO 378 386 c 379 c write(*,*)'CLMAIN, nsrf, knon =',nsrf, knon 387 if (check) THEN 388 write(*,*)'CLMAIN, nsrf, knon =',nsrf, knon 389 call flush(6) 390 endif 380 391 c 381 392 c variables pour avoir une sortie IOIPSL des INDEX … … 399 410 yts(j) = ts(i,nsrf) 400 411 ysnow(j) = snow(i,nsrf) 401 yqs ol(j) = qsol(i,nsrf)412 yqsurf(j) = qsurf(i,nsrf) 402 413 yalb(j) = albe(i,nsrf) 403 414 yalblw(j) = alblw(i,nsrf) … … 436 447 ypaprs(j,klev+1) = paprs(i,klev+1) 437 448 END DO 449 IF ( nsrf .eq. is_ter ) THEN 450 DO j = 1, knon 451 i = ni(j) 452 yqsol(j) = qsol(i) 453 END DO 454 ELSE 455 yqsol(:)=0. 456 ENDIF 438 457 c$$$ PB ajour pour soil 439 458 DO k = 1, nsoilmx … … 460 479 CALL coefkz(nsrf, knon, ypaprs, ypplay, 461 480 . yts, yrugos, yu, yv, yt, yq, 462 cIM remplace qsurf par yqsol 463 . yqsol, 481 . yqsurf, 464 482 . ycoefm, ycoefh) 465 483 CALL coefkz2(nsrf, knon, ypaprs, ypplay,yt, … … 493 511 e rlon, rlat, cufi, cvfi, 494 512 e knon, nsrf, ni, pctsrf, 495 e soil_model, ytsoil, 513 e soil_model, ytsoil,yqsol, 496 514 e ok_veget, ocean, npas, nexca, 497 515 e rmu0, yrugos, yrugoro, 498 516 e yu1, yv1, ycoefh, 499 517 e yt,yq,yts,ypaprs,ypplay, 500 e ydelp,yrads,yalb, yalblw, ysnow, yqs ol,518 e ydelp,yrads,yalb, yalblw, ysnow, yqsurf, 501 519 e yrain_f, ysnow_f, yfder, ytaux, ytauy, 502 520 c$$$ e ysollw, ysolsw, … … 548 566 alblw(:, nsrf) = 0. 549 567 snow(:, nsrf) = 0. 550 qs ol(:, nsrf) = 0.568 qsurf(:, nsrf) = 0. 551 569 rugos(:, nsrf) = 0. 552 570 fluxlat(:,nsrf) = 0. … … 557 575 alblw(i,nsrf) = yalblw(j) 558 576 snow(i,nsrf) = ysnow(j) 559 qs ol(i,nsrf) = yqsol(j)577 qsurf(i,nsrf) = yqsurf(j) 560 578 rugos(i,nsrf) = yz0_new(j) 561 579 fluxlat(i,nsrf) = yfluxlat(j) … … 572 590 zv1(i) = zv1(i) + yv1(j) 573 591 END DO 592 IF ( nsrf .eq. is_ter ) THEN 593 DO j = 1, knon 594 i = ni(j) 595 qsol(i) = yqsol(j) 596 END DO 597 END IF 574 598 c$$$ PB ajout pour soil 575 599 ftsoil(:,:,nsrf) = 0. … … 624 648 patm(j)=ypplay(j,1) 625 649 c 626 IF (nsrf.EQ.1) THEN 627 qairsol(j) = yqsol(j) 628 ELSE IF(nsrf.GT.1) THEN 629 zt = ts(i,nsrf) 630 IF (thermcep) THEN 631 zdelta = MAX(0.,SIGN(1.,RTT-zt)) 632 zqs = R2ES * FOEEW(zt,zdelta) / ypplay(j,1) 633 zqs = MIN(0.5,zqs) 634 zcor = 1./(1.-RETV*zqs) 635 zqs = zqs*zcor 636 ELSE 637 IF (zt .LT. t_coup) THEN 638 zqs = qsats(zt) / ypplay(j,1) 639 ELSE 640 zqs = qsatl(zt) / ypplay(j,1) 641 ENDIF 642 ENDIF 643 qairsol(j) = zqs 644 ENDIF 645 ENDDO 646 c 647 IF(nsrf.EQ.3) THEN 648 j=1465 649 WRITE(*,*)' INstO',klon,knon,nsrf,zxli,uzon(j),vmer(j), 650 & tair1(j),qair1(j),zgeo1(j),tairsol(j),qairsol(j),rugo1(j), 651 & psfce(j),patm(j) 650 qairsol(j) = yqsurf(j) 651 c$$$ IF (nsrf.EQ.1) THEN 652 c$$$ qairsol(j) = yqsurf(j) 653 c$$$ ELSE IF(nsrf.GT.1) THEN 654 c$$$ zt = ts(i,nsrf) 655 c$$$ IF (thermcep) THEN 656 c$$$ zdelta = MAX(0.,SIGN(1.,RTT-zt)) 657 c$$$ zqs = R2ES * FOEEW(zt,zdelta) / ypplay(j,1) 658 c$$$ zqs = MIN(0.5,zqs) 659 c$$$ zcor = 1./(1.-RETV*zqs) 660 c$$$ zqs = zqs*zcor 661 c$$$ ELSE 662 c$$$ IF (zt .LT. t_coup) THEN 663 c$$$ zqs = qsats(zt) / ypplay(j,1) 664 c$$$ ELSE 665 c$$$ zqs = qsatl(zt) / ypplay(j,1) 666 c$$$ ENDIF 667 c$$$ ENDIF 668 c$$$ qairsol(j) = zqs 669 c$$$ ENDIF 670 ENDDO 671 c 672 if (check) THEN 673 WRITE(*,*)' avant stdlevvar. nsrf=',nsrf 674 IF(nsrf.EQ.3) THEN 675 j=1465 676 WRITE(*,*)' INstO',klon,knon,nsrf,zxli,uzon(j),vmer(j), 677 & tair1(j),qair1(j),zgeo1(j),tairsol(j),qairsol(j),rugo1(j), 678 & psfce(j),patm(j) 679 ENDIF 680 WRITE(*,*)' qairsol (min, max)' 681 $ , minval(qairsol(1:knon)), maxval(qairsol(1:knon)) 682 call flush(6) 652 683 ENDIF 653 684 c … … 658 689 659 690 c 691 if (check) THEN 660 692 IF(nsrf.EQ.3) THEN 661 693 j=1465 … … 664 696 & psfce(j),patm(j) 665 697 WRITE(*,*)' tqu',yt2m(j),yq2m(j),yu10m(j) 698 call flush(6) 699 ENDIF 666 700 ENDIF 667 701 c … … 670 704 t2m(i,nsrf)=yt2m(j) 671 705 672 IF(nsrf.EQ.3) THEN673 IF(j.EQ.1465) THEN706 if (check) THEN 707 IF(nsrf.EQ.3 .and. j.EQ.1465) THEN 674 708 WRITE(*,*) 't2m APRES stdlev',j,i,tair1(j),t2m(i,nsrf), 675 709 $ tairsol(j),rlon(i),rlat(i) 676 ENDIF710 call flush(6) 677 711 ENDIF 712 ENDIF 678 713 c 679 714 q2m(i,nsrf)=yq2m(j) … … 706 741 e rlon, rlat, cufi, cvfi, 707 742 e knon, nisurf, knindex, pctsrf, 708 $ soil_model,tsoil, 743 $ soil_model,tsoil,qsol, 709 744 e ok_veget, ocean, npas, nexca, 710 745 e rmu0, rugos, rugoro, 711 746 e u1lay,v1lay,coef, 712 747 e t,q,ts,paprs,pplay, 713 e delp,radsol,albedo,alblw,snow,qs ol,748 e delp,radsol,albedo,alblw,snow,qsurf, 714 749 e precip_rain, precip_snow, fder, taux, tauy, 715 750 $ sollw, sollwdown, swnet,fluxlat, … … 753 788 REAL alblw(klon) 754 789 REAL snow(klon) ! hauteur de neige 755 REAL qs ol(klon) ! humiditede la surface790 REAL qsurf(klon) ! humidite de l'air au dessus de la surface 756 791 real precip_rain(klon), precip_snow(klon) 757 792 REAL agesno(klon) … … 822 857 LOGICAL soil_model 823 858 REAL tsoil(klon, nsoilmx) 859 REAL qsol(klon) 824 860 825 861 ! Parametres de sortie … … 830 866 c JLD 831 867 real zzpk 832 833 c 834 868 C 869 character (len = 20) :: modname = 'Debut clqh' 870 LOGICAL check 871 PARAMETER (check=.true.) 872 C 873 if (check) THEN 874 write(*,*) modname,' nisurf=',nisurf 875 call flush(6) 876 endif 877 c 878 if (check) THEN 879 WRITE(*,*)' qsurf (min, max)' 880 $ , minval(qsurf(1:knon)), maxval(qsurf(1:knon)) 881 call flush(6) 882 ENDIF 883 C 835 884 if (.not. contreg) then 836 885 do k = 2, klev … … 969 1018 e klon, iim, jjm, nisurf, knon, knindex, pctsrf, 970 1019 e rlon, rlat, cufi, cvfi, 971 e debut, lafin, ok_veget, soil_model, nsoilmx,tsoil, 1020 e debut, lafin, ok_veget, soil_model, nsoilmx,tsoil, qsol, 972 1021 e zlev1, u1lay, v1lay, temp_air, spechum, epot_air, ccanopy, 973 1022 e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, 974 1023 e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, 975 1024 e fder, taux, tauy, rugos, rugoro, 976 e albedo, snow, qs ol,1025 e albedo, snow, qsurf, 977 1026 e ts, p1lay, psref, radsol, 978 1027 e ocean, npas, nexca, zmasq, … … 1146 1195 . ts, rugos, 1147 1196 . u,v,t,q, 1148 cIM remplace qsurf par yqsol 1149 . qsol, 1197 . qsurf, 1150 1198 . pcfm, pcfh) 1151 1199 IMPLICIT none … … 1237 1285 c contre-gradient pour la chaleur sensible: Kelvin/metre 1238 1286 REAL gamt(2:klev) 1239 c essai qsurf 1240 cIM real qsurf(klon) 1241 real qsol(klon) 1287 real qsurf(klon) 1242 1288 c 1243 1289 LOGICAL appel1er … … 1277 1323 ENDDO 1278 1324 1279 cIM remplace qsurf par qsol 1280 IF(nsrf.NE.1) THEN 1281 do i = 1, knon 1282 cIM qsurf(i) = qsatl(ts(i))/paprs(i,1) 1283 qsol(i) = qsatl(ts(i))/paprs(i,1) 1284 enddo 1285 ENDIF 1325 c$$$ IF(nsrf.NE.1) THEN 1326 c$$$ do i = 1, knon 1327 c$$$ qsurf(i) = qsatl(ts(i))/paprs(i,1) 1328 c$$$ enddo 1329 c$$$ ENDIF 1286 1330 1287 1331 c
Note: See TracChangeset
for help on using the changeset viewer.
