Changeset 1494 for LMDZ5/trunk/libf/phylmd/thermcell_main.F90
- Timestamp:
- Mar 9, 2011, 11:05:02 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/thermcell_main.F90
r1403 r1494 80 80 !$OMP THREADPRIVATE(lev_out) 81 81 82 INTEGER ig,k,l,ll 82 INTEGER ig,k,l,ll,ierr 83 83 real zsortie1d(klon) 84 84 INTEGER lmax(klon),lmin(klon),lalim(klon) … … 233 233 ! write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)' 234 234 do ig=1,klon 235 if (prt_level.ge.20) then236 print*,'th_main ig f0',ig,f0(ig)237 endif238 235 f0(ig)=max(f0(ig),1.e-2) 239 236 zmax0(ig)=max(zmax0(ig),40.) … … 241 238 enddo 242 239 240 if (prt_level.ge.20) then 241 do ig=1,ngrid 242 print*,'th_main ig f0',ig,f0(ig) 243 enddo 244 endif 243 245 !----------------------------------------------------------------------- 244 246 ! Calcul de T,q,ql a partir de Tl et qT dans l environnement … … 290 292 !----------------------------------------------------------------------- 291 293 292 do l=1,nlay 293 rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l)) 294 enddo 295 296 !IM 294 rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:)) 295 297 296 if (prt_level.ge.10)write(lunout,*) & 298 297 & 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)' … … 619 618 enddo 620 619 !IM 620 ierr=0 621 621 do ig=1,ngrid 622 622 if (pcon(ig).le.pplay(ig,nlay)) then 623 623 zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100. 624 ierr=1 625 endif 626 enddo 627 if (ierr==1) then 624 628 abort_message = 'thermcellV0_main: les thermiques vont trop haut ' 625 629 CALL abort_gcm (modname,abort_message,1) 626 627 enddo 630 endif 631 628 632 if (prt_level.ge.1) print*,'14b OK convect8' 629 633 do k=nlay,1,-1 … … 655 659 zf2=zf/(1.-zf) 656 660 ! 657 if (prt_level.ge.10) print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2658 !659 if (prt_level.ge.10) print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)660 661 thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2 661 662 if(zw2(ig,l).gt.1.e-10) then … … 664 665 wth2(ig,l)=0. 665 666 endif 666 ! print*,'wth2=',wth2(ig,l)667 667 wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l)) & 668 668 & *zw2(ig,l)*zw2(ig,l)*zw2(ig,l) 669 if (prt_level.ge.10) print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)670 669 q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 671 670 !test: on calcul q2/po=ratqsc … … 682 681 enddo 683 682 ! 683 if (prt_level.ge.10) then 684 ig=igout 685 do l=1,nlay 686 print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l) 687 print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l) 688 enddo 689 endif 690 684 691 ! print*,'avant calcul ale et alp' 685 692 !calcul de ALE et ALP pour la convection … … 705 712 !initialisations 706 713 ! print*,'ponderation' 707 do ig=1,ngrid 708 fm_tot(ig)=0. 709 enddo 710 do ig=1,ngrid 711 do k=1,klev 712 wght_th(ig,k)=1. 713 enddo 714 enddo 715 do ig=1,ngrid 716 ! lalim_conv(ig)=lmix_bis(ig) 717 !la hauteur de la couche alim_conv = hauteur couche alim_therm 718 lalim_conv(ig)=lalim(ig) 719 ! zentr(ig)=zlev(ig,lalim(ig)) 720 enddo 721 do ig=1,ngrid 722 do k=1,lalim_conv(ig) 723 fm_tot(ig)=fm_tot(ig)+fm(ig,k) 724 enddo 725 enddo 726 do ig=1,ngrid 727 do k=1,lalim_conv(ig) 728 if (fm_tot(ig).gt.1.e-10) then 729 ! wght_th(ig,k)=fm(ig,k)/fm_tot(ig) 730 endif 731 !on pondere chaque couche par a* 732 if (alim_star(ig,k).gt.1.e-10) then 733 wght_th(ig,k)=alim_star(ig,k) 734 else 735 wght_th(ig,k)=1. 736 endif 737 enddo 738 enddo 714 715 fm_tot(:)=0. 716 wght_th(:,:)=1. 717 lalim_conv(:)=lalim(:) 718 719 do k=1,klev 720 do ig=1,ngrid 721 if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k) 722 enddo 723 enddo 724 725 ! assez bizarre car, si on est dans la couche d'alim et que alim_star et 726 ! plus petit que 1.e-10, on prend wght_th=1. 727 do k=1,klev 728 do ig=1,ngrid 729 if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then 730 wght_th(ig,k)=alim_star(ig,k) 731 endif 732 enddo 733 enddo 734 739 735 ! print*,'apres wght_th' 740 736 !test pour prolonger la convection … … 748 744 enddo 749 745 746 750 747 !calcul du ratqscdiff 751 748 if (prt_level.ge.1) print*,'14e OK convect8' … … 753 750 vardiff=0. 754 751 ratqsdiff(:,:)=0. 755 do ig=1,ngrid 756 do l=1,lalim(ig) 752 753 do l=1,klev 754 do ig=1,ngrid 755 if (l<=lalim(ig)) then 757 756 var=var+alim_star(ig,l)*zqta(ig,l)*1000. 758 enddo 759 enddo 757 endif 758 enddo 759 enddo 760 760 761 if (prt_level.ge.1) print*,'14f OK convect8' 761 do ig=1,ngrid 762 do l=1,lalim(ig) 763 zf=fraca(ig,l) 764 zf2=zf/(1.-zf) 765 vardiff=vardiff+alim_star(ig,l) & 766 & *(zqta(ig,l)*1000.-var)**2 767 ! ratqsdiff=ratqsdiff+alim_star(ig,l)* 768 ! s (zqta(ig,l)*1000.-po(ig,l)*1000.)**2 769 enddo 770 enddo 762 763 do l=1,klev 764 do ig=1,ngrid 765 if (l<=lalim(ig)) then 766 zf=fraca(ig,l) 767 zf2=zf/(1.-zf) 768 vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2 769 endif 770 enddo 771 enddo 772 771 773 if (prt_level.ge.1) print*,'14g OK convect8' 772 774 do l=1,nlay … … 779 781 ! 780 782 !ecriture des fichiers sortie 781 ! print*,'15 OK convect8 '783 ! print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc' 782 784 783 785 #ifdef wrgrads_thermcell
Note: See TracChangeset
for help on using the changeset viewer.