Changeset 3781 for LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
- Timestamp:
- Oct 26, 2020, 10:33:06 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
r3780 r3781 18 18 real, allocatable:: t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:) 19 19 real, allocatable:: th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:) 20 real, allocatable:: u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:) 20 real, allocatable:: u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:) 21 21 22 22 !forcing … … 30 30 real, allocatable:: temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:) 31 31 real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:) 32 real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke _cas(:)32 real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:) 33 33 34 34 !champs interpoles … … 48 48 real, allocatable:: vitw_prof_cas(:) 49 49 real, allocatable:: omega_prof_cas(:) 50 real, allocatable:: tke_prof_cas(:) 50 51 real, allocatable:: ug_prof_cas(:) 51 52 real, allocatable:: vg_prof_cas(:) … … 73 74 74 75 75 real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke _prof_cas76 real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas 76 77 real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas 77 78 … … 168 169 allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 169 170 allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)) 170 171 allocate(tke_cas(nlev_cas,nt_cas)) 171 172 !forcing 172 173 allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas)) … … 179 180 allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)) 180 181 allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)) 181 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke _cas(nt_cas))182 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas)) 182 183 allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)) 183 184 … … 200 201 allocate(vitw_prof_cas(nlev_cas)) 201 202 allocate(omega_prof_cas(nlev_cas)) 203 allocate(tke_prof_cas(nlev_cas)) 202 204 allocate(ug_prof_cas(nlev_cas)) 203 205 allocate(vg_prof_cas(nlev_cas)) … … 228 230 CALL read_SCM (nid,nlev_cas,nt_cas, & 229 231 & ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, & 230 & ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas, ug_cas,vg_cas, &232 & ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas, & 231 233 & temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas, & 232 234 & du_cas,hu_cas,vu_cas, & 233 235 & dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, & 234 & dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke _cas, &236 & dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tkes_cas, & 235 237 & uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, & 236 238 & o3_cas,rugos_cas,clay_cas,sand_cas) … … 254 256 deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas) 255 257 deallocate(th_cas,thl_cas,thv_cas,rv_cas) 256 deallocate(u_cas,v_cas,vitw_cas,omega_cas )258 deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas) 257 259 258 260 !forcing … … 265 267 deallocate(ug_cas) 266 268 deallocate(vg_cas) 267 deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke _cas,uw_cas,vw_cas,q1_cas,q2_cas)269 deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas) 268 270 269 271 !champs interpoles … … 283 285 deallocate(vitw_prof_cas) 284 286 deallocate(omega_prof_cas) 287 deallocate(tke_prof_cas) 285 288 deallocate(ug_prof_cas) 286 289 deallocate(vg_prof_cas) … … 312 315 !===================================================================== 313 316 SUBROUTINE read_SCM(nid,nlevel,ntime, & 314 & ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega, ug,vg,&317 & ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,& 315 318 & temp_nudg,qv_nudg,u_nudg,v_nudg, & 316 319 & du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, & 317 & dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke t,uw,vw,q1,q2, &320 & dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tkes,uw,vw,q1,q2, & 318 321 & orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, & 319 322 & heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas) … … 334 337 real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime) 335 338 real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime) 336 real u(nlevel,ntime),v(nlevel,ntime),tke t(ntime)339 real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime) 337 340 real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime) 338 341 real ug(nlevel,ntime),vg(nlevel,ntime) 339 real vitw(nlevel,ntime),omega(nlevel,ntime) 342 real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime) 340 343 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 341 344 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) … … 371 374 &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt', & ! #46-58 372 375 ! coordonnees temps #12 373 &'tke t','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&376 &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',& 374 377 &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',& 375 378 ! scalaires #4 … … 546 549 case(56) ; u=resul 547 550 case(57) ; v=resul 548 case(58) ; tke t=resul2 ! donnees indexees en time551 case(58) ; tkes=resul2 ! donnees indexees en time 549 552 case(59) ; sens=resul2 550 553 case(60) ; flat=resul2 … … 581 584 u(k,t)=u0(k) 582 585 v(k,t)=v0(k) 583 !tke(k,t)=tke0(k)586 tke(k,t)=tke0(k) 584 587 enddo 585 588 enddo … … 593 596 594 597 !====================================================================== 598 599 !********************************************************************************************** 595 600 596 601 !********************************************************************************************** … … 601 606 & ,qv_cas,ql_cas,qi_cas,u_cas,v_cas & 602 607 & ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas & 603 & ,vitw_cas,omega_cas, du_cas,hu_cas,vu_cas &608 & ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas & 604 609 & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 605 610 & ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas & 606 611 & ,lat_cas,sens_cas,ustar_cas & 607 & ,uw_cas,vw_cas,q1_cas,q2_cas,tke _cas &612 & ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas & 608 613 ! 609 614 & ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas & … … 611 616 & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 612 617 & ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & 613 & ,vitw_prof_cas,omega_prof_cas, du_prof_cas,hu_prof_cas,vu_prof_cas &618 & ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 614 619 & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 615 620 & ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 616 621 & ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas & 617 622 & ,lat_prof_cas,sens_prof_cas & 618 & ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) 619 620 621 implicit none 623 & ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas) 624 625 626 627 628 629 630 implicit none 622 631 623 632 !--------------------------------------------------------------------------------------- … … 639 648 real ts_cas(nt_cas),ps_cas(nt_cas) 640 649 real plev_cas(nlev_cas,nt_cas) 641 real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas) 650 real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas) 651 real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas) 642 652 real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas) 643 653 real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas) … … 646 656 real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas) 647 657 648 real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas) 658 real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas) 649 659 real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas) 650 660 real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas) … … 653 663 real dtrad_cas(nlev_cas,nt_cas) 654 664 real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas) 655 real lat_cas(nt_cas),sens_cas(nt_cas),tke _cas(nt_cas)665 real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas) 656 666 real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas) 657 667 real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas) … … 666 676 real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas) 667 677 668 real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas) 678 real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas) 669 679 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 670 680 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) … … 673 683 real dtrad_prof_cas(nlev_cas) 674 684 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 675 real lat_prof_cas,sens_prof_cas,tke _prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas685 real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas 676 686 real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas) 677 687 ! local: … … 757 767 sens_prof_cas = sens_cas(it_cas2) & 758 768 & -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 759 tke _prof_cas = tke_cas(it_cas2) &760 & -frac*(tke _cas(it_cas2)-tke_cas(it_cas1))769 tkes_prof_cas = tkes_cas(it_cas2) & 770 & -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1)) 761 771 ts_prof_cas = ts_cas(it_cas2) & 762 772 & -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) … … 804 814 omega_prof_cas(k) = omega_cas(k,it_cas2) & 805 815 & -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1)) 816 tke_prof_cas(k) = tke_cas(k,it_cas2) & 817 & -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1)) 806 818 du_prof_cas(k) = du_cas(k,it_cas2) & 807 819 & -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) … … 851 863 !********************************************************************************************** 852 864 !===================================================================== 853 SUBROUTINE interp2_case_vertical_std(play, nlev_cas,plev_prof_cas&865 SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas & 854 866 & ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas & 855 867 & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 856 868 & ,ug_prof_cas,vg_prof_cas & 857 869 & ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & 858 & ,vitw_prof_cas,omega_prof_cas 870 & ,vitw_prof_cas,omega_prof_cas,tke_prof_cas & 859 871 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 860 872 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & … … 865 877 & ,ug_mod_cas,vg_mod_cas & 866 878 & ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas & 867 & ,w_mod_cas,omega_mod_cas 879 & ,w_mod_cas,omega_mod_cas,tke_mod_cas & 868 880 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 869 881 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & … … 888 900 ! real hq_prof(nlevmax),vq_prof(nlevmax) 889 901 890 real play(llm), plev _prof_cas(nlev_cas)902 real play(llm), plev(llm+1), plev_prof_cas(nlev_cas) 891 903 real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas) 892 904 real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas) 893 905 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 894 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas) 906 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas) 895 907 real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas) 896 908 real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas) … … 905 917 real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm) 906 918 real u_mod_cas(llm),v_mod_cas(llm) 907 real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm) 919 real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1) 908 920 real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm) 909 921 real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm) … … 917 929 real frac,frac1,frac2,fact 918 930 919 ! do l = 1, llm 920 ! print *,'debut interp2, play=',l,play(l) 921 ! enddo 922 ! do l = 1, nlev_cas 923 ! print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l) 924 ! enddo 925 926 ! print*, 'plev_prof_cas', plev_prof_cas 927 ! print*, 'play', play 931 932 933 ! for variables defined at the middle of layers 934 928 935 do l = 1, llm 929 936 … … 951 958 enddo 952 959 endif 960 961 953 962 954 963 frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) … … 1078 1087 enddo ! l 1079 1088 1089 ! for variables defined at layer interfaces (EV): 1090 1091 1092 do l = 1, llm+1 1093 1094 if (plev(l).ge.plev_prof_cas(nlev_cas)) then 1095 1096 mxcalc=l 1097 k1=0 1098 k2=0 1099 1100 if (plev(l).le.plev_prof_cas(1)) then 1101 1102 do k = 1, nlev_cas-1 1103 if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then 1104 k1=k 1105 k2=k+1 1106 endif 1107 enddo 1108 1109 if (k1.eq.0 .or. k2.eq.0) then 1110 write(*,*) 'PB! k1, k2 = ',k1,k2 1111 write(*,*) 'l,plev(l) = ',l,plev(l)/100 1112 do k = 1, nlev_cas-1 1113 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100 1114 enddo 1115 endif 1116 1117 frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) 1118 tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1)) 1119 else !play>plev_prof_cas(1) 1120 k1=1 1121 k2=2 1122 tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2) 1123 1124 endif ! plev.le.plev_prof_cas(1) 1125 1126 else ! above max altitude of forcing file 1127 1128 tke_mod_cas(l)=0.0 1129 1130 endif ! plev 1131 1132 enddo ! l 1133 1134 1080 1135 1081 1136 return
Note: See TracChangeset
for help on using the changeset viewer.