Changeset 20 for trunk/src/verttransform.f90
- Timestamp:
- Dec 23, 2013, 6:23:38 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/src/verttransform.f90
r4 r20 49 49 ! Sabine Eckhardt, March 2007 50 50 ! added the variable cloud for use with scavenging - descr. in com_mod 51 ! Petra Seibert, 2011/2012: Fixing some deficiencies in this modification 52 ! note that also other subroutines are affected by the fix 51 53 !***************************************************************************** 52 54 ! * … … 70 72 71 73 integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym 72 integer :: rain_cloud_above,kz_inv 74 integer :: rain_cloud_above,kz_inv !SE 75 integer icloudtop !PS 73 76 real :: f_qvsat,pressure 74 real :: rh,lsp,convp 77 !real :: rh,lsp,convp 78 real :: rh,lsp,convp,prec,rhmin 75 79 real :: uvzlev(nuvzmax),rhoh(nuvzmax),pinmconv(nzmax) 76 80 real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi 77 81 real :: xlon,ylat,xlonr,dzdx,dzdy 78 real :: dzdx1,dzdx2,dzdy1,dzdy2 82 real :: dzdx1,dzdx2,dzdy1,dzdy2, precmin 79 83 real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy 80 84 real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax) … … 83 87 real :: wwh(0:nxmax-1,0:nymax-1,nwzmax) 84 88 real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax) 89 logical lconvectprec 85 90 real,parameter :: const=r_air/ga 91 parameter (precmin = 0.002) ! minimum prec in mm/h for cloud diagnostics 86 92 87 93 logical :: init = .true. … … 545 551 ! create a cloud and rainout/washout field, clouds occur where rh>80% 546 552 ! total cloudheight is stored at level 0 553 554 555 547 556 do jy=0,nymin1 548 557 do ix=0,nxmin1 549 rain_cloud_above=0 550 lsp=lsprec(ix,jy,1,n) 551 convp=convprec(ix,jy,1,n) 552 cloudsh(ix,jy,n)=0 553 do kz_inv=1,nz-1 554 kz=nz-kz_inv+1 555 pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n) 556 rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n)) 557 clouds(ix,jy,kz,n)=0 558 if (rh.gt.0.8) then ! in cloud 559 if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation 560 rain_cloud_above=1 561 cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+ & 562 height(kz)-height(kz-1) 563 if (lsp.ge.convp) then 564 clouds(ix,jy,kz,n)=3 ! lsp dominated rainout 565 else 566 clouds(ix,jy,kz,n)=2 ! convp dominated rainout 567 endif 568 else ! no precipitation 569 clouds(ix,jy,kz,n)=1 ! cloud 558 559 560 561 ! rain_cloud_above=0 562 ! lsp=lsprec(ix,jy,1,n) 563 ! convp=convprec(ix,jy,1,n) 564 ! cloudsh(ix,jy,n)=0 565 ! do kz_inv=1,nz-1 566 ! kz=nz-kz_inv+1 567 ! pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n) 568 ! rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n)) 569 ! clouds(ix,jy,kz,n)=0 570 ! if (rh.gt.0.8) then ! in cloud 571 ! if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation 572 ! rain_cloud_above=1 573 ! cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+ & 574 ! height(kz)-height(kz-1) 575 ! if (lsp.ge.convp) then 576 ! clouds(ix,jy,kz,n)=3 ! lsp dominated rainout 577 ! else 578 ! clouds(ix,jy,kz,n)=2 ! convp dominated rainout 579 ! endif 580 ! else ! no precipitation 581 ! clouds(ix,jy,kz,n)=1 ! cloud 582 ! endif 583 ! else ! no cloud 584 ! if (rain_cloud_above.eq.1) then ! scavenging 585 ! if (lsp.ge.convp) then 586 ! clouds(ix,jy,kz,n)=5 ! lsp dominated washout 587 ! else 588 ! clouds(ix,jy,kz,n)=4 ! convp dominated washout 589 ! endif 590 ! endif 591 ! endif 592 ! end do 593 594 595 ! PS 3012 596 597 lsp=lsprec(ix,jy,1,n) 598 convp=convprec(ix,jy,1,n) 599 prec=lsp+convp 600 if (lsp.gt.convp) then ! prectype='lsp' 601 lconvectprec = .false. 602 else ! prectype='cp ' 603 lconvectprec = .true. 604 endif 605 rhmin = 0.90 ! standard condition for presence of clouds 606 !PS note that original by Sabine Eckhart was 80% 607 !PS however, for T<-20 C we consider saturation over ice 608 !PS so I think 90% should be enough 609 icloudbot(ix,jy,n)=icmv 610 icloudtop=icmv ! this is just a local variable 611 98 do kz=1,nz 612 pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n) 613 rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n)) 614 !ps if (prec.gt.0.01) print*,'relhum',prec,kz,rh,height(kz) 615 if (rh .gt. rhmin) then 616 if (icloudbot(ix,jy,n) .eq. icmv) then 617 icloudbot(ix,jy,n)=nint(height(kz)) 618 endif 619 icloudtop=nint(height(kz)) ! use int to save memory 570 620 endif 571 else ! no cloud 572 if (rain_cloud_above.eq.1) then ! scavenging 573 if (lsp.ge.convp) then 574 clouds(ix,jy,kz,n)=5 ! lsp dominated washout 575 else 576 clouds(ix,jy,kz,n)=4 ! convp dominated washout 577 endif 621 enddo 622 623 !PS try to get a cloud thicker than 50 m 624 !PS if there is at least .01 mm/h - changed to 0.002 and put into 625 !PS parameter precpmin 626 if ((icloudbot(ix,jy,n) .eq. icmv .or. & 627 icloudtop-icloudbot(ix,jy,n) .lt. 50) .and. & 628 prec .gt. precmin) then 629 rhmin = rhmin - 0.05 630 if (rhmin .ge. 0.30) goto 98 ! give up for <= 25% rel.hum. 631 endif 632 !PS implement a rough fix for badly represented convection 633 !PS is based on looking at a limited set of comparison data 634 if (lconvectprec .and. icloudtop .lt. 6000 .and. & 635 prec .gt. precmin) then 636 637 if (convp .lt. 0.1) then 638 icloudbot(ix,jy,n) = 500 639 icloudtop = 8000 640 else 641 icloudbot(ix,jy,n) = 0 642 icloudtop = 10000 578 643 endif 579 endif 580 end do 644 endif 645 if (icloudtop .ne. icmv) then 646 icloudthck(ix,jy,n) = icloudtop-icloudbot(ix,jy,n) 647 else 648 icloudthck(ix,jy,n) = icmv 649 endif 650 !PS get rid of too thin clouds 651 if (icloudthck(ix,jy,n) .lt. 50) then 652 icloudbot(ix,jy,n)=icmv 653 icloudthck(ix,jy,n)=icmv 654 endif 655 656 581 657 end do 582 658 end do … … 605 681 !104 continue 606 682 ! close(4) 683 684 607 685 end subroutine verttransform
Note: See TracChangeset
for help on using the changeset viewer.