Changeset 3537 for LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
- Timestamp:
- Jun 19, 2019, 10:29:16 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
r2764 r3537 315 315 END SUBROUTINE read2_1D_cas 316 316 317 !********************************************************************************************** 318 SUBROUTINE read_SCM_cas 319 implicit none 320 321 #include "netcdf.inc" 322 323 INTEGER nid,rid,ierr 324 INTEGER ii,jj 325 326 print*,'ON EST VRAIMENT LA' 327 fich_cas='setup/cas.nc' 328 print*,'fich_cas ',fich_cas 329 ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid) 330 print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid 331 if (ierr.NE.NF_NOERR) then 332 write(*,*) 'ERROR: GROS Pb opening forcings nc file ' 333 write(*,*) NF_STRERROR(ierr) 334 stop "" 335 endif 336 !....................................................................... 337 ierr=NF_INQ_DIMID(nid,'lat',rid) 338 IF (ierr.NE.NF_NOERR) THEN 339 print*, 'Oh probleme lecture dimension lat' 340 ENDIF 341 ierr=NF_INQ_DIMLEN(nid,rid,ii) 342 print*,'OK1 read2: nid,rid,lat',nid,rid,ii 343 !....................................................................... 344 ierr=NF_INQ_DIMID(nid,'lon',rid) 345 IF (ierr.NE.NF_NOERR) THEN 346 print*, 'Oh probleme lecture dimension lon' 347 ENDIF 348 ierr=NF_INQ_DIMLEN(nid,rid,jj) 349 print*,'OK2 read2: nid,rid,lat',nid,rid,jj 350 !....................................................................... 351 ierr=NF_INQ_DIMID(nid,'nlev',rid) 352 IF (ierr.NE.NF_NOERR) THEN 353 print*, 'Oh probleme lecture dimension nlev' 354 ENDIF 355 ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas) 356 print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas 357 !....................................................................... 358 ierr=NF_INQ_DIMID(nid,'time',rid) 359 nt_cas=0 360 IF (ierr.NE.NF_NOERR) THEN 361 stop 'Oh probleme lecture dimension time' 362 ENDIF 363 ierr=NF_INQ_DIMLEN(nid,rid,nt_cas) 364 print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas 365 366 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 367 !profils moyens: 368 allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1)) 369 allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1)) 370 allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1)) 371 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), & 372 qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 373 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)) 374 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)) 375 376 !forcing 377 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)) 378 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 379 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 380 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 381 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 382 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 383 allocate(ug_cas(nlev_cas,nt_cas)) 384 allocate(vg_cas(nlev_cas,nt_cas)) 385 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)) 386 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)) 387 388 389 390 !champs interpoles 391 allocate(plev_prof_cas(nlev_cas)) 392 allocate(t_prof_cas(nlev_cas)) 393 allocate(theta_prof_cas(nlev_cas)) 394 allocate(thl_prof_cas(nlev_cas)) 395 allocate(thv_prof_cas(nlev_cas)) 396 allocate(q_prof_cas(nlev_cas)) 397 allocate(qv_prof_cas(nlev_cas)) 398 allocate(ql_prof_cas(nlev_cas)) 399 allocate(qi_prof_cas(nlev_cas)) 400 allocate(rh_prof_cas(nlev_cas)) 401 allocate(rv_prof_cas(nlev_cas)) 402 allocate(u_prof_cas(nlev_cas)) 403 allocate(v_prof_cas(nlev_cas)) 404 allocate(vitw_prof_cas(nlev_cas)) 405 allocate(omega_prof_cas(nlev_cas)) 406 allocate(ug_prof_cas(nlev_cas)) 407 allocate(vg_prof_cas(nlev_cas)) 408 allocate(ht_prof_cas(nlev_cas)) 409 allocate(hth_prof_cas(nlev_cas)) 410 allocate(hq_prof_cas(nlev_cas)) 411 allocate(hu_prof_cas(nlev_cas)) 412 allocate(hv_prof_cas(nlev_cas)) 413 allocate(vt_prof_cas(nlev_cas)) 414 allocate(vth_prof_cas(nlev_cas)) 415 allocate(vq_prof_cas(nlev_cas)) 416 allocate(vu_prof_cas(nlev_cas)) 417 allocate(vv_prof_cas(nlev_cas)) 418 allocate(dt_prof_cas(nlev_cas)) 419 allocate(dth_prof_cas(nlev_cas)) 420 allocate(dtrad_prof_cas(nlev_cas)) 421 allocate(dq_prof_cas(nlev_cas)) 422 allocate(du_prof_cas(nlev_cas)) 423 allocate(dv_prof_cas(nlev_cas)) 424 allocate(uw_prof_cas(nlev_cas)) 425 allocate(vw_prof_cas(nlev_cas)) 426 allocate(q1_prof_cas(nlev_cas)) 427 allocate(q2_prof_cas(nlev_cas)) 428 429 print*,'Allocations OK' 430 call read_SCM (nid,nlev_cas,nt_cas, & 431 & ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, & 432 & ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas, & 433 & dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, & 434 & dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas, & 435 & uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, & 436 & o3_cas,rugos_cas,clay_cas,sand_cas) 437 print*,'Read2 cas OK' 438 do ii=1,nlev_cas 439 print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1) 440 enddo 441 442 443 END SUBROUTINE read_SCM_cas 317 444 318 445 … … 687 814 return 688 815 end subroutine read2_cas 816 817 !====================================================================== 818 subroutine read_SCM(nid,nlevel,ntime, & 819 & ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,& 820 & du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, & 821 & dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2, & 822 & orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, & 823 & heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas) 824 825 !program reading forcing of the case study 826 implicit none 827 #include "netcdf.inc" 828 829 integer ntime,nlevel,k,t 830 831 real ap(nlevel+1),bp(nlevel+1) 832 real zz(nlevel,ntime),zzh(nlevel+1) 833 real pp(nlevel,ntime),pph(nlevel+1) 834 !profils initiaux 835 real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel) 836 real pp0(nlevel) 837 real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime) 838 real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime) 839 real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime) 840 real ug(nlevel,ntime),vg(nlevel,ntime) 841 real vitw(nlevel,ntime),omega(nlevel,ntime) 842 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 843 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 844 real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 845 real dtrad(nlevel,ntime) 846 real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 847 real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime) 848 real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 849 real flat(ntime),sens(ntime),ustar(ntime) 850 real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime) 851 real ts(ntime),ps(ntime) 852 real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas 853 real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3 854 855 856 integer nid, ierr,ierr1,ierr2,rid,i 857 integer nbvar3d 858 parameter(nbvar3d=70) 859 integer var3didin(nbvar3d),missing_var(nbvar3d) 860 character*13 name_var(1:nbvar3d) 861 data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',& 862 &'temp','qv','ql','qi','u','v','tke','pressure',& 863 &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',& 864 &'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & 865 'rh',& 866 &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',& 867 &'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',& 868 &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/ 869 do i=1,nbvar3d 870 missing_var(i)=0. 871 enddo 872 873 !----------------------------------------------------------------------- 874 875 print*,'ON EST LA' 876 do i=1,nbvar3d 877 ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 878 if(ierr/=NF_NOERR) then 879 print *,'Variable manquante dans cas.nc:',i,name_var(i) 880 ierr=NF_NOERR 881 missing_var(i)=1 882 else 883 !----------------------------------------------------------------------- 884 if(i.LE.4) then ! Lecture des coord pression en (nlevelp1,lat,lon) 885 #ifdef NC_DOUBLE 886 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp) 887 #else 888 ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp) 889 #endif 890 print *,'read2_cas(apbp), on a lu ',i,name_var(i) 891 if(ierr/=NF_NOERR) then 892 print *,'Pb a la lecture de cas.nc: ',name_var(i) 893 stop "getvarup" 894 endif 895 !----------------------------------------------------------------------- 896 else if(i.gt.4.and.i.LE.12) then ! Lecture des variables en (time,nlevel,lat,lon) 897 #ifdef NC_DOUBLE 898 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1) 899 #else 900 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1) 901 #endif 902 print *,'read2_cas(resul1), on a lu ',i,name_var(i) 903 if(ierr/=NF_NOERR) then 904 print *,'Pb a la lecture de cas.nc: ',name_var(i) 905 stop "getvarup" 906 endif 907 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1) 908 !----------------------------------------------------------------------- 909 else if(i.gt.12.and.i.LE.54) then ! Lecture des variables en (time,nlevel,lat,lon) 910 #ifdef NC_DOUBLE 911 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul) 912 #else 913 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul) 914 #endif 915 print *,'read2_cas(resul), on a lu ',i,name_var(i) 916 if(ierr/=NF_NOERR) then 917 print *,'Pb a la lecture de cas.nc: ',name_var(i) 918 stop "getvarup" 919 endif 920 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul) 921 !----------------------------------------------------------------------- 922 else if (i.gt.54.and.i.LE.65) then ! Lecture des variables en (time,lat,lon) 923 #ifdef NC_DOUBLE 924 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2) 925 #else 926 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2) 927 #endif 928 print *,'read2_cas(resul2), on a lu ',i,name_var(i) 929 if(ierr/=NF_NOERR) then 930 print *,'Pb a la lecture de cas.nc: ',name_var(i) 931 stop "getvarup" 932 endif 933 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2) 934 !----------------------------------------------------------------------- 935 else ! Lecture des constantes (lat,lon) 936 #ifdef NC_DOUBLE 937 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3) 938 #else 939 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3) 940 #endif 941 print *,'read2_cas(resul3), on a lu ',i,name_var(i) 942 if(ierr/=NF_NOERR) then 943 print *,'Pb a la lecture de cas.nc: ',name_var(i) 944 stop "getvarup" 945 endif 946 print*,'Lecture de la variable #i ',i,name_var(i),resul3 947 endif 948 endif 949 !----------------------------------------------------------------------- 950 select case(i) 951 case(1) ; ap=apbp ! donnees indexees en nlevel+1 952 case(2) ; bp=apbp 953 case(3) ; zzh=apbp 954 case(4) ; pph=apbp 955 case(5) ; temp0=resul1 ! donnees initiales 956 case(6) ; qv0=resul1 957 case(7) ; ql0=resul1 958 case(8) ; qi0=resul1 959 case(9) ; u0=resul1 960 case(10) ; v0=resul1 961 case(11) ; tke0=resul1 962 case(12) ; pp0=resul1 963 case(13) ; vitw=resul ! donnees indexees en nlevel,time 964 case(14) ; omega=resul 965 case(15) ; ug=resul 966 case(16) ; vg=resul 967 case(17) ; du=resul 968 case(18) ; hu=resul 969 case(19) ; vu=resul 970 case(20) ; dv=resul 971 case(21) ; hv=resul 972 case(22) ; vv=resul 973 case(23) ; dt=resul 974 case(24) ; ht=resul 975 case(25) ; vt=resul 976 case(26) ; dq=resul 977 case(27) ; hq=resul 978 case(28) ; vq=resul 979 case(29) ; dth=resul 980 case(30) ; hth=resul 981 case(31) ; vth=resul 982 case(32) ; hthl=resul 983 case(33) ; dr=resul 984 case(34) ; hr=resul 985 case(35) ; vr=resul 986 case(36) ; dtrad=resul 987 case(37) ; q1=resul 988 case(38) ; q2=resul 989 case(39) ; uw=resul 990 case(40) ; vw=resul 991 case(41) ; rh=resul 992 case(42) ; zz=resul ! donnees en time,nlevel pour profil initial 993 case(43) ; pp=resul 994 case(44) ; temp=resul 995 case(45) ; theta=resul 996 case(46) ; thv=resul 997 case(47) ; thl=resul 998 case(48) ; qv=resul 999 case(49) ; ql=resul 1000 case(50) ; qi=resul 1001 case(51) ; rv=resul 1002 case(52) ; u=resul 1003 case(53) ; v=resul 1004 case(54) ; tke=resul 1005 case(55) ; sens=resul2 ! donnees indexees en time 1006 case(56) ; flat=resul2 1007 case(57) ; ts=resul2 1008 case(58) ; ps=resul2 1009 case(59) ; ustar=resul2 1010 case(60) ; orog_cas=resul3 ! constantes 1011 case(61) ; albedo_cas=resul3 1012 case(62) ; emiss_cas=resul3 1013 case(63) ; t_skin_cas=resul3 1014 case(64) ; q_skin_cas=resul3 1015 case(65) ; mom_rough=resul3 1016 case(66) ; heat_rough=resul3 1017 case(67) ; o3_cas=resul3 1018 case(68) ; rugos_cas=resul3 1019 case(69) ; clay_cas=resul3 1020 case(70) ; sand_cas=resul3 1021 end select 1022 resul=0. 1023 resul1=0. 1024 resul2=0. 1025 resul3=0. 1026 enddo 1027 print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens) 1028 print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat) 1029 1030 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL 1031 do t=1,ntime 1032 do k=1,nlevel 1033 temp(k,t)=temp0(k) 1034 qv(k,t)=qv0(k) 1035 ql(k,t)=ql0(k) 1036 qi(k,t)=qi0(k) 1037 u(k,t)=u0(k) 1038 v(k,t)=v0(k) 1039 tke(k,t)=tke0(k) 1040 enddo 1041 enddo 1042 !----------------------------------------------------------------------- 1043 1044 return 1045 end subroutine read_SCM 1046 !====================================================================== 1047 689 1048 !====================================================================== 690 1049 SUBROUTINE interp_case_time2(day,day1,annee_ref &
Note: See TracChangeset
for help on using the changeset viewer.