- Timestamp:
- Dec 6, 2022, 12:01:16 AM (18 months ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/thermcell_plume_6A.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/phylmd/thermcell_plume_6A.F90
r3605 r4368 2 2 ! $Id$ 3 3 ! 4 SUBROUTINE thermcell_plume_6A(itap,ngrid, klev,ptimestep,ztv,zthl,po,zl,rhobarz, &4 SUBROUTINE thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz, & 5 5 & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & 6 6 & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & … … 11 11 !thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance 12 12 !-------------------------------------------------------------------------- 13 USE IOIPSL, ONLY : getin 14 USE ioipsl_getin_p_mod, ONLY : getin_p 15 16 USE print_control_mod, ONLY: prt_level 13 14 USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG 15 USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell 16 USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power 17 USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim 18 17 19 IMPLICIT NONE 18 20 19 #include "YOMCST.h" 20 #include "YOETHF.h" 21 #include "FCTTRE.h" 22 #include "thermcell.h" 23 24 INTEGER itap 25 INTEGER lunout1,igout 26 INTEGER ngrid,klev 27 REAL ptimestep 28 REAL ztv(ngrid,klev) 29 REAL zthl(ngrid,klev) 30 REAL po(ngrid,klev) 31 REAL zl(ngrid,klev) 32 REAL rhobarz(ngrid,klev) 33 REAL zlev(ngrid,klev+1) 34 REAL pplev(ngrid,klev+1) 35 REAL pphi(ngrid,klev) 36 REAL zpspsk(ngrid,klev) 37 REAL alim_star(ngrid,klev) 38 REAL f0(ngrid) 39 INTEGER lalim(ngrid) 40 integer lev_out ! niveau pour les print 41 integer nbpb 42 43 real alim_star_tot(ngrid) 44 45 REAL ztva(ngrid,klev) 46 REAL ztla(ngrid,klev) 47 REAL zqla(ngrid,klev) 48 REAL zqta(ngrid,klev) 49 REAL zha(ngrid,klev) 50 51 REAL detr_star(ngrid,klev) 52 REAL coefc 53 REAL entr_star(ngrid,klev) 54 REAL detr(ngrid,klev) 55 REAL entr(ngrid,klev) 56 57 REAL csc(ngrid,klev) 58 59 REAL zw2(ngrid,klev+1) 60 REAL w_est(ngrid,klev+1) 61 REAL f_star(ngrid,klev+1) 62 REAL wa_moy(ngrid,klev+1) 63 64 REAL ztva_est(ngrid,klev) 65 REAL ztv_est(ngrid,klev) 66 REAL zqla_est(ngrid,klev) 67 REAL zqsatth(ngrid,klev) 68 REAL zta_est(ngrid,klev) 69 REAL ztemp(ngrid),zqsat(ngrid) 21 integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,nlay 22 real,intent(in) :: ptimestep 23 real,intent(in),dimension(ngrid,nlay) :: ztv 24 real,intent(in),dimension(ngrid,nlay) :: zthl 25 real,intent(in),dimension(ngrid,nlay) :: po 26 real,intent(in),dimension(ngrid,nlay) :: zl 27 real,intent(in),dimension(ngrid,nlay) :: rhobarz 28 real,intent(in),dimension(ngrid,nlay+1) :: zlev 29 real,intent(in),dimension(ngrid,nlay+1) :: pplev 30 real,intent(in),dimension(ngrid,nlay) :: pphi 31 real,intent(in),dimension(ngrid,nlay) :: zpspsk 32 real,intent(in),dimension(ngrid) :: f0 33 34 integer,intent(out) :: lalim(ngrid) 35 real,intent(out),dimension(ngrid,nlay) :: alim_star 36 real,intent(out),dimension(ngrid) :: alim_star_tot 37 real,intent(out),dimension(ngrid,nlay) :: detr_star 38 real,intent(out),dimension(ngrid,nlay) :: entr_star 39 real,intent(out),dimension(ngrid,nlay+1) :: f_star 40 real,intent(out),dimension(ngrid,nlay) :: csc 41 real,intent(out),dimension(ngrid,nlay) :: ztva 42 real,intent(out),dimension(ngrid,nlay) :: ztla 43 real,intent(out),dimension(ngrid,nlay) :: zqla 44 real,intent(out),dimension(ngrid,nlay) :: zqta 45 real,intent(out),dimension(ngrid,nlay) :: zha 46 real,intent(out),dimension(ngrid,nlay+1) :: zw2 47 real,intent(out),dimension(ngrid,nlay+1) :: w_est 48 real,intent(out),dimension(ngrid,nlay) :: ztva_est 49 real,intent(out),dimension(ngrid,nlay) :: zqsatth 50 integer,intent(out),dimension(ngrid) :: lmix 51 integer,intent(out),dimension(ngrid) :: lmix_bis 52 real,intent(out),dimension(ngrid) :: linter 53 70 54 REAL zdw2,zdw2bis 71 55 REAL zw2modif 72 56 REAL zw2fact,zw2factbis 73 REAL zeps(ngrid,klev) 74 75 REAL linter(ngrid) 76 INTEGER lmix(ngrid) 77 INTEGER lmix_bis(ngrid) 78 REAL wmaxa(ngrid) 57 REAL,dimension(ngrid,nlay) :: zeps 58 59 REAL, dimension(ngrid) :: wmaxa(ngrid) 79 60 80 61 INTEGER ig,l,k,lt,it,lm 81 82 real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m 83 real zbuoyjam(ngrid,klev),zdqtjam(ngrid,klev) 62 integer nbpb 63 64 real,dimension(ngrid,nlay) :: detr 65 real,dimension(ngrid,nlay) :: entr 66 real,dimension(ngrid,nlay+1) :: wa_moy 67 real,dimension(ngrid,nlay) :: ztv_est 68 real,dimension(ngrid) :: ztemp,zqsat 69 real,dimension(ngrid,nlay) :: zqla_est 70 real,dimension(ngrid,nlay) :: zta_est 71 72 real,dimension(ngrid,nlay) :: zbuoy,gamma,zdqt 73 real zdz,zalpha,zw2m 74 real,dimension(ngrid,nlay) :: zbuoyjam,zdqtjam 84 75 real zbuoybis,zdz2,zdz3,lmel,entrbis,zdzbis 85 real d_temp(ngrid)76 real, dimension(ngrid) :: d_temp 86 77 real ztv1,ztv2,factinv,zinv,zlmel 87 78 real zlmelup,zlmeldwn,zlt,zltdwn,zltup … … 91 82 real zbetalpha, coefzlmel 92 83 real eps 93 REAL REPS,RLvCp,DDT094 PARAMETER (DDT0=.01)95 84 logical Zsat 96 LOGICAL active(ngrid),activetmp(ngrid)85 LOGICAL,dimension(ngrid) :: active,activetmp 97 86 REAL fact_gamma,fact_gamma2,fact_epsilon2 98 99 REAL, SAVE :: fact_epsilon=0.002 100 REAL, SAVE :: betalpha=0.9 101 REAL, SAVE :: afact=2./3. 102 REAL, SAVE :: fact_shell=1. 103 REAL,SAVE :: detr_min=1.e-5 104 REAL,SAVE :: entr_min=1.e-5 105 REAL,SAVE :: detr_q_coef=0.012 106 REAL,SAVE :: detr_q_power=0.5 107 REAL,SAVE :: mix0=0. 108 INTEGER,SAVE :: thermals_flag_alim=0 109 110 !$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell) 111 !$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power) 112 !$OMP THREADPRIVATE( mix0, thermals_flag_alim) 113 114 LOGICAL, SAVE :: first=.true. 115 !$OMP THREADPRIVATE(first) 116 117 118 REAL c2(ngrid,klev) 87 REAL coefc 88 REAL,dimension(ngrid,nlay) :: c2 119 89 120 90 if (ngrid==1) print*,'THERMCELL PLUME MODIFIE 2014/07/11' … … 122 92 ! Initialisation 123 93 124 RLvCp = RLVTT/RCPD125 IF (first) THEN126 127 CALL getin_p('thermals_fact_epsilon',fact_epsilon)128 CALL getin_p('thermals_betalpha',betalpha)129 CALL getin_p('thermals_afact',afact)130 CALL getin_p('thermals_fact_shell',fact_shell)131 CALL getin_p('thermals_detr_min',detr_min)132 CALL getin_p('thermals_entr_min',entr_min)133 CALL getin_p('thermals_detr_q_coef',detr_q_coef)134 CALL getin_p('thermals_detr_q_power',detr_q_power)135 CALL getin_p('thermals_mix0',mix0)136 CALL getin_p('thermals_flag_alim',thermals_flag_alim)137 138 139 first=.false.140 ENDIF141 94 142 95 zbetalpha=betalpha/(1.+betalpha) … … 186 139 wmaxa(:)=0. 187 140 141 ! Initialisation a 0 en cas de sortie dans replay 142 zqsat(:)=0. 143 zta_est(:,:)=0. 144 zdqt(:,:)=0. 145 zdqtjam(:,:)=0. 146 c2(:,:)=0. 147 188 148 189 149 !------------------------------------------------------------------------- … … 196 156 ! du panache 197 157 ! Cet appel pourrait être fait avant thermcell_plume dans thermcell_main 198 CALL thermcell_alim(thermals_flag_alim,ngrid, klev,ztv,d_temp,zlev,alim_star,lalim)158 CALL thermcell_alim(thermals_flag_alim,ngrid,nlay,ztv,d_temp,zlev,alim_star,lalim) 199 159 200 160 !------------------------------------------------------------------------------ … … 225 185 !boucle de calcul de la vitesse verticale dans le thermique 226 186 !============================================================================== 227 do l=2, klev-1187 do l=2,nlay-1 228 188 !============================================================================== 229 189 … … 420 380 ! & (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)) 421 381 422 382 w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2) 423 383 424 384 ! Nouvelle version Arnaud … … 428 388 ! & (exp(-zw2factbis)*(w_est(ig,l-1)-zdw2bis)+zdw2)) 429 389 430 390 w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2) 431 391 432 392 ! w_est(ig,l+1)=Max(0.0001,(zdz/(zdzbis+zdz))*(exp(-zw2fact)* & … … 461 421 ! & (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2)) 462 422 463 423 w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2bis)+zdw2) 464 424 465 425 … … 526 486 & + detr_q_coef*(zdqt(ig,l)/zw2m)**detr_q_power)) 527 487 528 ! 529 ! & 488 ! detr_star(ig,l)=(zdz/zdzbis)*detr_star(ig,l)+ & 489 ! & ((zdzbis-zdz)/zdzbis)*detr_star(ig,l-1) 530 490 531 491 zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) … … 544 504 545 505 546 ! 547 ! & 506 ! entr_star(ig,l)=(zdz/zdzbis)*entr_star(ig,l)+ & 507 ! & ((zdzbis-zdz)/zdzbis)*entr_star(ig,l-1) 548 508 549 509 ! entr_star(ig,l)=Max(0.,f_star(ig,l)*zdz*zbetalpha* & … … 624 584 ! & (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2)) 625 585 if (iflag_thermals_ed==8) then 626 586 zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2) 627 587 else 628 588 zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2) 629 589 endif 630 590 ! zw2(ig,l+1)=Max(0.0001,(zdz/(zdz+zdzbis))*(exp(-zw2fact)* & … … 647 607 ! & (exp(-zw2factbis)*(zw2(ig,l-1)-zdw2bis)+zdw2)) 648 608 ! zw2(ig,l+1)=Max(0.0001,(zw2(ig,l)+zdw2*zw2fact)*exp(-zw2fact)) 649 609 zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2bis)+zdw2) 650 610 651 611 endif … … 720 680 #undef wrgrads_thermcell 721 681 #ifdef wrgrads_thermcell 722 call wrgradsfi(1, klev,entr_star(igout,1:klev),'esta ','esta ')723 call wrgradsfi(1, klev,detr_star(igout,1:klev),'dsta ','dsta ')724 call wrgradsfi(1, klev,zbuoy(igout,1:klev),'buoy ','buoy ')725 call wrgradsfi(1, klev,zdqt(igout,1:klev),'dqt ','dqt ')726 call wrgradsfi(1, klev,w_est(igout,1:klev),'w_est ','w_est ')727 call wrgradsfi(1, klev,w_est(igout,2:klev+1),'w_es2 ','w_es2 ')728 call wrgradsfi(1, klev,zw2(igout,1:klev),'zw2A ','zw2A ')682 call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta ','esta ') 683 call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta ','dsta ') 684 call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy ','buoy ') 685 call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt ','dqt ') 686 call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est ','w_est ') 687 call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2 ','w_es2 ') 688 call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A ','zw2A ') 729 689 #endif 730 690 731 691 732 return692 RETURN 733 693 end 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 694 763 695 … … 773 705 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 774 706 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 775 SUBROUTINE thermcell_plume_5B(itap,ngrid, klev,ptimestep,ztv,zthl,po,zl,rhobarz, &707 SUBROUTINE thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz, & 776 708 & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & 777 709 & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & … … 786 718 !-------------------------------------------------------------------------- 787 719 788 USE print_control_mod, ONLY: prt_level720 USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG 789 721 IMPLICIT NONE 790 791 #include "YOMCST.h"792 #include "YOETHF.h"793 #include "FCTTRE.h"794 #include "thermcell.h"795 722 796 723 INTEGER itap 797 724 INTEGER lunout1,igout 798 INTEGER ngrid, klev725 INTEGER ngrid,nlay 799 726 REAL ptimestep 800 REAL ztv(ngrid, klev)801 REAL zthl(ngrid, klev)802 REAL po(ngrid, klev)803 REAL zl(ngrid, klev)804 REAL rhobarz(ngrid, klev)805 REAL zlev(ngrid, klev+1)806 REAL pplev(ngrid, klev+1)807 REAL pphi(ngrid, klev)808 REAL zpspsk(ngrid, klev)809 REAL alim_star(ngrid, klev)727 REAL ztv(ngrid,nlay) 728 REAL zthl(ngrid,nlay) 729 REAL po(ngrid,nlay) 730 REAL zl(ngrid,nlay) 731 REAL rhobarz(ngrid,nlay) 732 REAL zlev(ngrid,nlay+1) 733 REAL pplev(ngrid,nlay+1) 734 REAL pphi(ngrid,nlay) 735 REAL zpspsk(ngrid,nlay) 736 REAL alim_star(ngrid,nlay) 810 737 REAL f0(ngrid) 811 738 INTEGER lalim(ngrid) … … 815 742 real alim_star_tot(ngrid) 816 743 817 REAL ztva(ngrid, klev)818 REAL ztla(ngrid, klev)819 REAL zqla(ngrid, klev)820 REAL zqta(ngrid, klev)821 REAL zha(ngrid, klev)822 823 REAL detr_star(ngrid, klev)744 REAL ztva(ngrid,nlay) 745 REAL ztla(ngrid,nlay) 746 REAL zqla(ngrid,nlay) 747 REAL zqta(ngrid,nlay) 748 REAL zha(ngrid,nlay) 749 750 REAL detr_star(ngrid,nlay) 824 751 REAL coefc 825 REAL entr_star(ngrid, klev)826 REAL detr(ngrid, klev)827 REAL entr(ngrid, klev)828 829 REAL csc(ngrid, klev)830 831 REAL zw2(ngrid, klev+1)832 REAL w_est(ngrid, klev+1)833 REAL f_star(ngrid, klev+1)834 REAL wa_moy(ngrid, klev+1)835 836 REAL ztva_est(ngrid, klev)837 REAL zqla_est(ngrid, klev)838 REAL zqsatth(ngrid, klev)839 REAL zta_est(ngrid, klev)840 REAL zbuoyjam(ngrid, klev)752 REAL entr_star(ngrid,nlay) 753 REAL detr(ngrid,nlay) 754 REAL entr(ngrid,nlay) 755 756 REAL csc(ngrid,nlay) 757 758 REAL zw2(ngrid,nlay+1) 759 REAL w_est(ngrid,nlay+1) 760 REAL f_star(ngrid,nlay+1) 761 REAL wa_moy(ngrid,nlay+1) 762 763 REAL ztva_est(ngrid,nlay) 764 REAL zqla_est(ngrid,nlay) 765 REAL zqsatth(ngrid,nlay) 766 REAL zta_est(ngrid,nlay) 767 REAL zbuoyjam(ngrid,nlay) 841 768 REAL ztemp(ngrid),zqsat(ngrid) 842 769 REAL zdw2 843 770 REAL zw2modif 844 771 REAL zw2fact 845 REAL zeps(ngrid, klev)772 REAL zeps(ngrid,nlay) 846 773 847 774 REAL linter(ngrid) … … 852 779 INTEGER ig,l,k 853 780 854 real zdz,zbuoy(ngrid, klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m781 real zdz,zbuoy(ngrid,nlay),zalpha,gamma(ngrid,nlay),zdqt(ngrid,nlay),zw2m 855 782 real zbuoybis 856 783 real zcor,zdelta,zcvm5,qlbef,zdz2 857 784 real betalpha,zbetalpha 858 785 real eps, afact 859 REAL REPS,RLvCp,DDT0860 PARAMETER (DDT0=.01)861 786 logical Zsat 862 787 LOGICAL active(ngrid),activetmp(ngrid) 863 788 REAL fact_gamma,fact_epsilon,fact_gamma2,fact_epsilon2 864 REAL c2(ngrid, klev)789 REAL c2(ngrid,nlay) 865 790 Zsat=.false. 866 791 ! Initialisation 867 792 868 RLvCp = RLVTT/RCPD869 793 fact_epsilon=0.002 870 794 betalpha=0.9 … … 923 847 924 848 !------------------------------------------------------------------------- 925 ! Definition de l'alimentation a l'origine dans thermcell_init849 ! Definition de l'alimentation 926 850 !------------------------------------------------------------------------- 927 do l=1, klev-1851 do l=1,nlay-1 928 852 do ig=1,ngrid 929 853 if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then … … 935 859 enddo 936 860 enddo 937 do l=1, klev861 do l=1,nlay 938 862 do ig=1,ngrid 939 863 if (alim_star_tot(ig) > 1.e-10 ) then … … 973 897 !boucle de calcul de la vitesse verticale dans le thermique 974 898 !============================================================================== 975 do l=2, klev-1899 do l=2,nlay-1 976 900 !============================================================================== 977 901 … … 1173 1097 #undef wrgrads_thermcell 1174 1098 #ifdef wrgrads_thermcell 1175 call wrgradsfi(1, klev,entr_star(igout,1:klev),'esta ','esta ')1176 call wrgradsfi(1, klev,detr_star(igout,1:klev),'dsta ','dsta ')1177 call wrgradsfi(1, klev,zbuoy(igout,1:klev),'buoy ','buoy ')1178 call wrgradsfi(1, klev,zdqt(igout,1:klev),'dqt ','dqt ')1179 call wrgradsfi(1, klev,w_est(igout,1:klev),'w_est ','w_est ')1180 call wrgradsfi(1, klev,w_est(igout,2:klev+1),'w_es2 ','w_es2 ')1181 call wrgradsfi(1, klev,zw2(igout,1:klev),'zw2A ','zw2A ')1099 call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta ','esta ') 1100 call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta ','dsta ') 1101 call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy ','buoy ') 1102 call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt ','dqt ') 1103 call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est ','w_est ') 1104 call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2 ','w_es2 ') 1105 call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A ','zw2A ') 1182 1106 #endif 1183 1107
Note: See TracChangeset
for help on using the changeset viewer.
